OXygen DirectorySpy delphi版文件监控

页面导航:首页 > 软件编程 > Delphi > OXygen DirectorySpy delphi版文件监控

OXygen DirectorySpy delphi版文件监控

来源: 作者: 时间:2016-01-18 15:42 【

上代码:O2DirSpy.pas[delphi]{====================================================================} { TOxygenDirectorySpy Component, v1.6 c 2000-2001 Oxygen Software } {-----------------...
上代码:
O2DirSpy.pas
[] 
{====================================================================}  
{   TOxygenDirectorySpy Component, v1.6 c 2000-2001 Oxygen Software  }  
{--------------------------------------------------------------------}  
{          Written by Oleg Fyodorov,       }  
{                  http://www.oxygensoftware.com                     }  
{====================================================================}  
  
unit O2DirSpy;  
  
interface  
  
  uses Classes, Controls, Windows, SysUtils, ShellApi, Dialogs, Messages, FileCtrl;  
  
  type  
    TDirectoryChangeType = (ctNone, ctAttributes, ctSize, ctCreationTime, ctLastModificationTime, ctLastAccessTime, ctLastTime, ctCreate, ctRemove);  
  
    TOxygenDirectorySpy = class;  
  
    TDirectoryChangeRecord = record  
      Directory : String;  
      FileFlag : Boolean; // When True, ChangeType applies to a file; False - ChangeType applies to Directory  
      Name : String; // Name of changed file/directory  
      OldTime, NewTime : TDateTime;  // Significant only when ChangeType is one of ctCreationTime, ctLastModificationTime, ctLastAccessTime, ctLastTime  
      OldAttributes, NewAttributes : DWord; // Significant only when ChangeType is ctAttributes  
      OldSize, NewSize : DWord; // Significant only when ChangeType is ctSize  
      ChangeType : TDirectoryChangeType; // Describes a change type (creation, removing etc.)  
    end;  
  
    TSpySearchRec = record  
      Time: Integer;  
      Size: Integer;  
      Attr: Integer;  
      dwFileAttributes: DWORD;  
      ftCreationTime: TFileTime;  
      ftLastAccessTime: TFileTime;  
      ftLastWriteTime: TFileTime;  
      nFileSizeHigh: DWORD;  
      nFileSizeLow: DWORD;  
    end;  
  
    TFileData = class  
      private  
        FSearchRec : TSpySearchRec;  
        Name: TFileName;  
        FFound : Boolean;  
      public  
        constructor Create;  
        procedure Free;  
    end;  
  
    TFileDataList = class(TStringList)  
      private  
        function NewFileData(const FileName : String; sr : TSearchRec) : TFileData;  
        function GetFoundCount : Integer;  
      public  
        property FoundCount : Integer read GetFoundCount;  
  
        destructor Destroy; override;  
        function AddFileData(FileData : TFileData) : Integer;  
        function AddSearchRec(const Directory : String; sr : TSearchRec) : Integer;  
        procedure Delete(Index : Integer); override;  
        procedure Clear; override;  
        procedure SetFound(Value : Boolean);  
    end;  
  
    TReadDirChangesThread = class(TThread)  
    private  
      FOwner           : TOxygenDirectorySpy;  
      FDirectories     : TStringList;  
      FHandles         : TList;  
      FChangeRecord    : TDirectoryChangeRecord;  
      FFilesData,  
      FTempFilesData   : TFileDataList;  
      pHandles         : PWOHandleArray;  
      procedure ReleaseHandle;  
      procedure AllocateHandle;  
      procedure ReadDirectories(DestData : TFileDataList);  
      procedure CompareSearchRec(var srOld, srNew : TSpySearchRec);  
    protected  
      procedure Execute; override;  
      procedure Notify;  
    public  
      constructor Create(Owner : TOxygenDirectorySpy);  
      destructor Destroy; override;  
      procedure Reset;  
    end;  
  
    TChangeDirectoryEvent = procedure (Sender : TObject; ChangeRecord : TDirectoryChangeRecord) of object;  
  
    TOxygenDirectorySpy = class(TComponent)  
      private  
        FThread : TReadDirChangesThread;  
        FEnabled,  
        FWatchSubTree : Boolean;  
        FDirectories : TStrings;  
        FOnChangeDirectory : TChangeDirectoryEvent;  
  
        procedure SetEnabled(const Value : Boolean);  
        procedure CheckDirectories;  
        procedure SetDirectories(const Value : TStrings);  
        procedure SetWatchSubTree(const Value : Boolean);  
      protected  
        procedure DoChangeDirectory(ChangeRecord : TDirectoryChangeRecord);  
      published  
        property Enabled : Boolean read FEnabled write SetEnabled;  
        property Directories : TStrings read FDirectories write SetDirectories;  
        property WatchSubTree : Boolean read FWatchSubTree write SetWatchSubTree;  
        property OnChangeDirectory : TChangeDirectoryEvent read FOnChangeDirectory write FOnChangeDirectory;  
      public  
        constructor Create(AOwner : TComponent); override;  
        destructor Destroy; override;  
    end;  
  
    function ChangeRecord2String(ChangeRecord : TDirectoryChangeRecord) : String;  
  
    procedure Register;  
  
implementation  
  
function ChangeRecord2String(ChangeRecord : TDirectoryChangeRecord) : String;  
  var s : String;  
begin  
  Result := 'No changes';  
  if ChangeRecord.FileFlag then s := 'File ' else s := 'Directory ';  
  s := s + '"' + ChangeRecord.Name + '"';  
  case ChangeRecord.ChangeType of  
    ctAttributes           : Result := s + ' attributes are changed. Old: ' + IntToHex(ChangeRecord.OldAttributes,8) + ', New: ' + IntToHex(ChangeRecord.NewAttributes,8);  
    ctSize                 : Result := s + ' size is changed. Old: ' + IntToStr(ChangeRecord.OldSize) + ', New: ' + IntToStr(ChangeRecord.NewSize);  
    ctCreationTime         : Result := s + ' creation time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);  
    ctLastModificationTime : Result := s + ' last modification time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);  
    ctLastAccessTime       : Result := s + ' last access time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);  
    ctLastTime             : Result := s + ' time is changed. Old: ' + DateTimeToStr(ChangeRecord.OldTime) + ', New: ' + DateTimeToStr(ChangeRecord.NewTime);  
    ctCreate               : Result := s + ' is created';  
    ctRemove               : Result := s + ' is deleted';  
  end;  
end;  
  
function  SameSystemTime(Time1, Time2 : TSystemTime) : Boolean;  
begin  
  Result := ((Time1.wYear = Time2.wYear) and (Time1.wMonth = Time2.wMonth) and (Time1.wDay = Time2.wDay) and (Time1.wHour = Time2.wHour) and (Time1.wMinute = Time2.wMinute) and (Time1.wSecond = Time2.wSecond) and (Time1.wMilliseconds = Time2.wMilliseconds));  
end;  
  
function ReplaceText(s, SourceText, DestText: String):String;  
  var st,res:string;  
      i:Integer;  
begin  
  ReplaceText:='';  
  if ((s='') or (SourceText='')) then Exit;  
  st:=s;  
  res:='';  
  i:=Pos(SourceText,s);  
  while (i>0) do  
  begin  
    res:=res+Copy(st,1,i-1)+DestText;  
    Delete(st,1,(i+Length(SourceText)-1));  
    i:=Pos(SourceText,st);  
  end;  
  res:=res+st;  
  ReplaceText:=res;  
end;  
  
  
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
// TFileData  
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
constructor TFileData.Create;  
begin  
  inherited Create;  
  Name := '';  
  FillChar(FSearchRec,SizeOf(FSearchRec),0);  
  FFound := False;  
end;  
  
procedure TFileData.Free;  
begin  
  Name := '';  
  //Finalize(FSearchRec);  
  inherited Free;  
end;  
  
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
//  TFileDataList  
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
destructor TFileDataList.Destroy;  
begin  
  Clear;  
  inherited Destroy;;  
end;  
  
function TFileDataList.NewFileData(const FileName : String; sr : TSearchRec) : TFileData;  
begin  
  Result := TFileData.Create;  
  Result.Name := FileName;  
  with Result.FSearchRec do begin  
    Time := sr.Time;  
    Size := sr.Size;  
    Attr := sr.Attr;  
    dwFileAttributes := sr.FindData.dwFileAttributes;  
    ftCreationTime := sr.FindData.ftCreationTime;  
    ftLastAccessTime := sr.FindData.ftLastAccessTime;  
    ftLastWriteTime := sr.FindData.ftLastWriteTime;  
    nFileSizeHigh := sr.FindData.nFileSizeHigh;  
    nFileSizeLow := sr.FindData.nFileSizeLow;  
  end;  
end;  
  
function TFileDataList.GetFoundCount : Integer;  
  var i : Integer;  
begin  
  Result := 0;  
  for i := 1 to Count do if TFileData(Objects[i-1]).FFound then Inc(Result);  
end;  
  
function TFileDataList.AddFileData(FileData : TFileData) : Integer;  
  var fd : TFileData;  
begin  
  fd := TFileData.Create;  
  fd.Name := FileData.Name;  
  fd.FSearchRec := FileData.FSearchRec;  
  Result := AddObject(fd.Name, fd);  
end;  
  
function TFileDataList.AddSearchRec(const Directory : String; sr : TSearchRec) : Integer;  
  var FileName : String;  
begin  
  if (Directory <> '') then FileName := ReplaceText(Directory + '\' + sr.Name,'\\','\') else FileName := sr.Name;  
  Result := AddObject(FileName, NewFileData(FileName, sr));  
end;  
  
procedure TFileDataList.Delete(Index : Integer);  
begin  
  TFileData(Objects[Index]).Free;  
  inherited Delete(Index);  
end;  
  
procedure TFileDataList.Clear;  
begin  
  while (Count > 0) do Delete(0);  
  inherited Clear;  
end;  
  
procedure TFileDataList.SetFound(Value : Boolean);  
  var i : Integer;  
begin  
  for i := 1 to Count do TFileData(Objects[i-1]).FFound := Value;  
end;  
  
function CompareMem(fpBlock1, fpBlock2: Pointer; Size: Cardinal): Boolean; assembler;  
asm  
        PUSH    ESI  
        PUSH    EDI  
        MOV     ESI,fpBlock1  
        MOV     EDI,fpBlock2  
        MOV     ECX,Size  
        MOV     EDX,ECX  
        XOR     EAX,EAX  
        AND     EDX,3  
        SHR     ECX,2  
        REPE    CMPSD  
        JNE     @@2  
        MOV     ECX,EDX  
        REPE    CMPSB  
        JNE     @@2  
@@1:    INC     EAX  
@@2:    POP     EDI  
        POP     ESI  
end;  
  
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
//       TReadDirChangesThread  
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
procedure TReadDirChangesThread.CompareSearchRec(var srOld, srNew : TSpySearchRec);  
  var tt,nt,ot : TSystemTime;  
      //sro,srn : TSpySearchRec;  
begin  
  FChangeRecord.ChangeType := ctNone;  
  if CompareMem(@srOld,@srNew, SizeOf(TSpySearchRec)) then Exit;  
  if (srOld.Time <> srNew.Time) then begin  
    FChangeRecord.ChangeType := ctLastTime;  
    FChangeRecord.OldTime := FileDateToDateTime(srOld.Time);  
    FChangeRecord.NewTime := FileDateToDateTime(srNew.Time);  
    srOld.Time := srNew.Time;  
    Exit;  
  end  
  else if (srOld.Size <> srNew.Size) then begin  
    FChangeRecord.ChangeType := ctSize;  
    FChangeRecord.OldSize := srOld.Size;  
    FChangeRecord.NewSize := srNew.Size;  
    srOld.Size := srNew.Size;  
    Exit;  
  end  
  else if (srOld.Attr <> srNew.Attr) or (srOld.dwFileAttributes <> srNew.dwFileAttributes) then begin  
    FChangeRecord.ChangeType := ctAttributes;  
    FChangeRecord.OldAttributes := srOld.dwFileAttributes;  
    FChangeRecord.NewAttributes := srNew.dwFileAttributes;  
    srOld.dwFileAttributes := srNew.dwFileAttributes;  
    srOld.Attr := srNew.Attr;  
    Exit;  
  end  
  else begin  
    FileTimeToSystemTime(srNew.ftCreationTime,nt);  
    SystemTimeToTzSpecificLocalTime(nil,nt,tt);  
    nt := tt;  
    FileTimeToSystemTime(srOld.ftCreationTime,ot);  
    SystemTimeToTzSpecificLocalTime(nil,ot,tt);  
    ot := tt;  
    if not SameSystemTime(nt,ot) then begin  
      FChangeRecord.ChangeType := ctCreationTime;  
      FChangeRecord.OldTime := SystemTimeToDateTime(ot);  
      FChangeRecord.NewTime := SystemTimeToDateTime(nt);  
      srOld.ftCreationTime := srNew.ftCreationTime;  
      Exit;  
    end  
    else begin  
      FileTimeToSystemTime(srNew.ftLastAccessTime,nt);  
      SystemTimeToTzSpecificLocalTime(nil,nt,tt);  
      nt := tt;  
      FileTimeToSystemTime(srOld.ftLastAccessTime,ot);  
      SystemTimeToTzSpecificLocalTime(nil,ot,tt);  
      ot := tt;  
      if not SameSystemTime(nt,ot) then begin  
        FChangeRecord.ChangeType := ctLastAccessTime;  
        FChangeRecord.OldTime := SystemTimeToDateTime(ot);  
        FChangeRecord.NewTime := SystemTimeToDateTime(nt);  
        srOld.ftLastAccessTime := srNew.ftLastAccessTime;  
        Exit;  
      end  
      else begin  
        FileTimeToSystemTime(srNew.ftLastWriteTime,nt);  
        SystemTimeToTzSpecificLocalTime(nil,nt,tt);  
        nt := tt;  
        FileTimeToSystemTime(srOld.ftLastWriteTime,ot);  
        SystemTimeToTzSpecificLocalTime(nil,ot,tt);  
        ot := tt;  
        if not SameSystemTime(nt,ot) then begin  
          FChangeRecord.ChangeType := ctLastModificationTime;  
          FChangeRecord.OldTime := SystemTimeToDateTime(ot);  
          FChangeRecord.NewTime := SystemTimeToDateTime(nt);  
          srOld.ftLastWriteTime := srNew.ftLastWriteTime;  
          Exit;  
        end;  
      end;  
    end;  
  end;  
end;  
  
procedure TReadDirChangesThread.Execute;  
  var i, Index : Integer;  
      R : DWord;  
      fd : TFileData;  
begin  
  while not Terminated do try  
    if (FDirectories.Count = 0) or (not FOwner.Enabled) then Sleep(0)  
    else begin  
      R := WaitForMultipleObjects(FHandles.Count,pHandles,False,200);  
      if (R < (WAIT_OBJECT_0 + DWord(FHandles.Count))) then begin  
        FillChar(FChangeRecord,SizeOf(FChangeRecord),0);  
        FFilesData.SetFound(False);  
        FTempFilesData.Clear;  
        ReadDirectories(FTempFilesData);  
        while (FTempFilesData.Count > 0) do begin  
          fd := TFileData(FTempFilesData.Objects[0]);  
          // New file/directory is created  
          if not FFilesData.Find(fd.Name,Index) then begin  
            Index := FFilesData.AddFileData(fd);  
            TFileData(FFilesData.Objects[Index]).FFound := True;  
            FChangeRecord.ChangeType := ctCreate;  
            FChangeRecord.Name := fd.Name;  
            FChangeRecord.FileFlag := ((fd.FSearchRec.Attr and faDirectory) = 0);  
            FChangeRecord.Directory := FDirectories[R - WAIT_OBJECT_0];  
            Synchronize(Notify);  
          end  
          else begin  
            // file/directory is modified  
            TFileData(FFilesData.Objects[Index]).FFound := True;  
            CompareSearchRec(TFileData(FFilesData.Objects[Index]).FSearchRec, fd.FSearchRec);  
            while (FChangeRecord.ChangeType <> ctNone) do begin  
              FChangeRecord.Name := fd.Name;  
              FChangeRecord.FileFlag := ((fd.FSearchRec.Attr and faDirectory) = 0);  
              FChangeRecord.Directory := FDirectories[R - WAIT_OBJECT_0];  
              Synchronize(Notify);  
              CompareSearchRec(TFileData(FFilesData.Objects[Index]).FSearchRec, fd.FSearchRec);  
            end;  
          end;  
          FTempFilesData.Delete(0);  
        end;  
        for i := FFilesData.Count downto 1 do if not TFileData(FFilesData.Objects[i-1]).FFound then begin  
          // file/directory is deleted  
          fd := TFileData(FFilesData.Objects[i-1]);  
          FChangeRecord.ChangeType := ctRemove;  
          FChangeRecord.Name := fd.Name;  
          FChangeRecord.FileFlag := ((fd.FSearchRec.Attr and faDirectory) = 0);  
          FChangeRecord.Directory := FDirectories[R - WAIT_OBJECT_0];  
          FFilesData.Delete(i-1);  
          Synchronize(Notify);  
        end;  
        FindNextChangeNotification(THandle(FHandles[R - WAIT_OBJECT_0]));  
      end;  
    end;  
  except end;  
end;  
  
  
procedure TReadDirChangesThread.Notify;  
  var cr : TDirectoryChangeRecord;  
begin  
  cr := FChangeRecord;  
  if (cr.ChangeType <> ctNone) then FOwner.DoChangeDirectory(cr);  
end;  
  
constructor TReadDirChangesThread.Create(Owner : TOxygenDirectorySpy);  
begin  
  inherited Create(True);  
  FOwner := Owner;  
  FHandles := TList.Create;  
  pHandles := nil;  
  FDirectories := TStringList.Create;  
  FDirectories.Sorted := True;  
  FDirectories.Duplicates := dupIgnore;  
  FreeOnTerminate := True;  
  FFilesData := TFileDataList.Create;  
  FFilesData.Sorted := True;  
  FFilesData.Duplicates := dupIgnore;  
  FTempFilesData := TFileDataList.Create;  
  FTempFilesData.Sorted := True;  
  FTempFilesData.Duplicates := dupIgnore;  
  //Reset;  
end;  
  
procedure TReadDirChangesThread.ReleaseHandle;  
  var i : Integer;  
begin  
  if (pHandles <> nil) then FreeMem(pHandles,FHandles.Count * SizeOf(THandle));  
  pHandles := nil;  
  for i := 1 to FHandles.Count do if (THandle(FHandles[i-1]) <> INVALID_HANDLE_VALUE) then FindCloseChangeNotification(THandle(FHandles[i-1]));//CloseHandle(FHandle);  
  FHandles.Clear;  
end;  
  
destructor TReadDirChangesThread.Destroy;  
begin  
  ReleaseHandle;  
  FHandles.Free;  
  FDirectories.Free;  
  FFilesData.Clear;  
  FFilesData.Free;  
  FTempFilesData.Clear;  
  FTempFilesData.Free;  
  inherited Destroy;  
end;  
  
procedure TReadDirChangesThread.AllocateHandle;  
  var i : Integer;  
      h : THandle;  
begin  
  if (FOwner <> nil) then for i := 1 to FDirectories.Count do begin  
    h := FindFirstChangeNotification(PChar(FDirectories[i-1]), FOwner.WatchSubTree, FILE_NOTIFY_CHANGE_FILE_NAME +  
                                           FILE_NOTIFY_CHANGE_DIR_NAME + FILE_NOTIFY_CHANGE_ATTRIBUTES +  
                                           FILE_NOTIFY_CHANGE_SIZE + FILE_NOTIFY_CHANGE_LAST_WRITE);  
    {h := FindFirstChangeNotification(PChar(FDirectories[i-1]), FALSE, FILE_NOTIFY_CHANGE_FILE_NAME + 
                                           FILE_NOTIFY_CHANGE_DIR_NAME + FILE_NOTIFY_CHANGE_ATTRIBUTES + 
                                           FILE_NOTIFY_CHANGE_SIZE + FILE_NOTIFY_CHANGE_LAST_WRITE);}  
    if (h <> INVALID_HANDLE_VALUE) then FHandles.Add(Pointer(h)) else raise Exception.Create('Error allocating handle: #'+IntToStr(GetLastError));  
  end;  
  GetMem(pHandles,FHandles.Count * SizeOf(THandle));  
  for i := 1 to FHandles.Count do pHandles^[i-1] := THandle(FHandles[i-1]);  
  ReadDirectories(FFilesData);  
end;  
  
procedure TReadDirChangesThread.ReadDirectories(DestData : TFileDataList);  
  var i : Integer;  
  
  procedure AppendDirContents(const Directory : String);  
    var sr : TSearchRec;  
        s : String;  
  begin  
    if (Directory[Length(Directory)] <> '\') then s := Directory + '\*.*' else s := Directory + '*.*';  
    if (FindFirst(s,faAnyFile,sr) = 0) then begin  
      if (sr.Name <> '.') and (sr.Name <> '..') then begin  
        DestData.AddSearchRec(Directory,sr);  
        if ((sr.Attr and faDirectory) <> 0) and FOwner.WatchSubTree then AppendDirContents(Directory + '\' + sr.Name);  
      end;  
      while (FindNext(sr) = 0) do if (sr.Name <> '.') and (sr.Name <> '..') then begin  
        DestData.AddSearchRec(Directory,sr);  
        if ((sr.Attr and faDirectory) <> 0) and FOwner.WatchSubTree then AppendDirContents(Directory + '\' + sr.Name);  
      end;  
      FindClose(sr);  
    end;  
  end;  
  
begin  
  for i := 1 to FDirectories.Count do AppendDirContents(FDirectories[i-1]);  
end;  
  
procedure TReadDirChangesThread.Reset;  
begin  
  ReleaseHandle;  
  if (FDirectories.Count = 0) then Exit;  
  AllocateHandle;  
  if (FHandles.Count > 0) then Resume;  
end;  
  
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
//       TOxygenDirectorySpy  
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////  
constructor TOxygenDirectorySpy.Create(AOwner : TComponent);  
begin  
  inherited Create(AOwner);  
  FEnabled := False;  
  FWatchSubTree := False;  
  FDirectories := TStringList.Create;  
  TStringList(FDirectories).Sorted := True;  
  TStringList(FDirectories).Duplicates := dupIgnore;  
  FOnChangeDirectory := nil;  
  FThread := nil;  
{$IFDEF O2_SW}  
  if (MessageDlg('This version of TOxygenDirectorySpy is NOT REGISTERED. '+#13#10+  
                 'Press Ok to visit http://www.oxygensoftware.com and register.',  
                 mtWarning,[mbOk,mbCancel],0) = mrOk) then ShellExecute(0,'open','http://www.oxygensoftware.com',nil,nil,SW_SHOWNORMAL);  
{$ENDIF}  
end;  
  
procedure TOxygenDirectorySpy.SetEnabled(const Value : Boolean);  
begin  
  if (csDesigning in ComponentState) then Exit;  
  if (Value = FEnabled) then Exit;  
  CheckDirectories;  
  if (FDirectories.Count = 0) then FEnabled := False else FEnabled := Value;  
  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then FWatchSubTree := False;  
  if FEnabled then begin  
    FThread := TReadDirChangesThread.Create(Self);  
    FThread.FDirectories.Clear;  
    FThread.FDirectories.AddStrings(FDirectories);  
    FThread.Reset;  
  end  
  else if (FThread <> nil) then begin  
    FThread.Terminate;  
    FThread.WaitFor;  
    //TerminateThread(FThread.Handle,0);  
    FThread := nil;  
  end;  
end;  
  
procedure TOxygenDirectorySpy.CheckDirectories;  
  var i : Integer;  
      s : String;  
begin  
  for i := FDirectories.Count downto 1 do begin  
    s := Trim(FDirectories[i-1]);  
    if (s = '') or (not DirectoryExists(s)) then FDirectories.Delete(i-1);  
  end;  
  while (FDirectories.Count > MAXIMUM_WAIT_OBJECTS) do FDirectories.Delete(FDirectories.Count - 1);  
end;  
  
procedure TOxygenDirectorySpy.SetDirectories(const Value : TStrings);  
begin  
  FDirectories.Clear;  
  FDirectories.AddStrings(Value);  
  CheckDirectories;  
  if FEnabled then begin  
    SetEnabled(False);  
    SetEnabled(True);  
  end;  
end;  
  
procedure TOxygenDirectorySpy.SetWatchSubTree(const Value : Boolean);  
begin  
  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then begin  
    FWatchSubTree := False;  
    Exit;  
  end;  
  if (FWatchSubTree = Value) then Exit;  
  FWatchSubTree := Value;  
  if FEnabled then begin  
    SetEnabled(False);  
    SetEnabled(True);  
  end;  
end;  
  
procedure TOxygenDirectorySpy.DoChangeDirectory(ChangeRecord : TDirectoryChangeRecord);  
begin  
  if Assigned(FOnChangeDirectory) then FOnChangeDirectory(Self, ChangeRecord);  
end;  
  
destructor TOxygenDirectorySpy.Destroy;  
begin  
  if (FThread <> nil) then begin  
    FThread.Terminate;  
    FThread.WaitFor;  
    //TerminateThread(FThread.Handle,0);  
    //FThread.Free;  
    FThread := nil;  
  end;  
  inherited Destroy;  
end;  
  
procedure Register;  
begin  
  RegisterComponents('Oxygen', [TOxygenDirectorySpy]);  
end;  
  
  
end.  
 
 
utMain.pas
[delphi] view plaincopy
unit utMain;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls, ExtCtrls, O2DirSpy, FileCtrl;  
  
type  
  TMainForm = class(TForm)  
    lstChanges: TListBox;  
    pnl1: TPanel;  
    pnl2: TPanel;  
    pnl3: TPanel;  
    btnAdd: TButton;  
    btnRemove: TButton;  
    pnl4: TPanel;  
    lstDirectoriesListBox: TListBox;  
    pnl5: TPanel;  
    lbl1: TLabel;  
    chkWatchSubTree: TCheckBox;  
    procedure btnAddClick(Sender: TObject);  
    procedure btnRemoveClick(Sender: TObject);  
    procedure FormCreate(Sender: TObject);  
    procedure chkWatchSubTreeClick(Sender: TObject);  
    procedure FormDestroy(Sender: TObject);  
  private  
    OxygenDirectorySpy1: TOxygenDirectorySpy;  
    procedure OxygenDirectorySpy1ChangeDirectory(Sender: TObject;  
      ChangeRecord: TDirectoryChangeRecord);  
    { Private declarations }  
  public  
    { Public declarations }  
  end;  
  
var  
  MainForm: TMainForm;  
  
implementation  
  
{$R *.dfm}  
  
procedure TMainForm.btnAddClick(Sender: TObject);  
  var s : String;  
begin  
  if not SelectDirectory(s, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then Exit;  
  with OxygenDirectorySpy1 do begin  
    Enabled := False;  
    Directories.Add(s);  
    Enabled := True;  
  end;  
  
  with lstDirectoriesListBox do try  
    Items.Clear;  
    Items.AddStrings(OxygenDirectorySpy1.Directories);  
    ItemIndex := 0;  
  except end;  
  btnRemove.Enabled := True;  
  
end;  
  
procedure TMainForm.btnRemoveClick(Sender: TObject);  
var  
  i : Integer;  
begin  
  if (lstDirectoriesListBox.Items.Count = 0) then Exit;  
  i := lstDirectoriesListBox.ItemIndex;  
  if (i = -1) then Exit;  
  lstDirectoriesListBox.Items.Delete(i);  
  with OxygenDirectorySpy1 do begin  
    Enabled := False;  
    Directories.Delete(i);  
    if (Directories.Count > 0) then begin  
      Enabled := True;  
      lstDirectoriesListBox.ItemIndex := 0;  
    end;  
  end;  
  btnRemove.Enabled := (lstDirectoriesListBox.Items.Count > 0);  
end;  
  
procedure TMainForm.chkWatchSubTreeClick(Sender: TObject);  
begin  
  OxygenDirectorySpy1.WatchSubTree := chkWatchSubTree.Checked;  
end;  
  
procedure TMainForm.FormCreate(Sender: TObject);  
begin  
  OxygenDirectorySpy1 := TOxygenDirectorySpy.Create(Self);  
  OxygenDirectorySpy1.OnChangeDirectory := OxygenDirectorySpy1ChangeDirectory;  
  SendMessage(lstChanges.Handle,LB_SETHORIZONTALEXTENT,1000,0);  
end;  
  
procedure TMainForm.FormDestroy(Sender: TObject);  
begin  
  OxygenDirectorySpy1.Free;  
end;  
  
procedure TMainForm.OxygenDirectorySpy1ChangeDirectory(Sender: TObject; ChangeRecord: TDirectoryChangeRecord);  
begin  
  lstChanges.Items.Add(DateTimeToStr(SysUtils.Now) + '  ' + ChangeRecord2String(ChangeRecord));  
  with lstChanges do if (Items.Count > 0) then ItemIndex := Items.Count - 1;  
end;  
  
end.  
 
 
 
MainForm  (utMain.pas窗体文件)
[delphi] 
object MainForm: TMainForm  
  Left = 0  
  Top = 0  
  Caption = 'MainForm'  
  ClientHeight = 388  
  ClientWidth = 485  
  Color = clBtnFace  
  Font.Charset = DEFAULT_CHARSET  
  Font.Color = clWindowText  
  Font.Height = -12  
  Font.Name = 'Tahoma'  
  Font.Style = []  
  OldCreateOrder = False  
  OnCreate = FormCreate  
  OnDestroy = FormDestroy  
  PixelsPerInch = 106  
  TextHeight = 14  
  object lstChanges: TListBox  
    Left = 0  
    Top = 105  
    Width = 485  
    Height = 283  
    Align = alClient  
    ItemHeight = 14  
    TabOrder = 0  
    ExplicitLeft = -63  
    ExplicitWidth = 548  
    ExplicitHeight = 254  
  end  
  object pnl1: TPanel  
    Left = 0  
    Top = 0  
    Width = 485  
    Height = 105  
    Align = alTop  
    TabOrder = 1  
    ExplicitLeft = -63  
    ExplicitWidth = 548  
    object pnl2: TPanel  
      Left = 405  
      Top = 1  
      Width = 79  
      Height = 103  
      Align = alRight  
      BevelOuter = bvNone  
      TabOrder = 0  
      ExplicitLeft = 468  
      object pnl3: TPanel  
        Left = 4  
        Top = 0  
        Width = 75  
        Height = 103  
        Align = alRight  
        BevelOuter = bvNone  
        TabOrder = 0  
        object btnAdd: TButton  
          Left = 4  
          Top = 24  
          Width = 69  
          Height = 21  
          Caption = 'Add'  
          TabOrder = 0  
          OnClick = btnAddClick  
        end  
        object btnRemove: TButton  
          Left = 4  
          Top = 52  
          Width = 69  
          Height = 21  
          Caption = 'Remove'  
          Enabled = False  
          TabOrder = 1  
          OnClick = btnRemoveClick  
        end  
      end  
    end  
    object pnl4: TPanel  
      Left = 1  
      Top = 1  
      Width = 404  
      Height = 103  
      Align = alClient  
      BevelOuter = bvNone  
      TabOrder = 1  
      ExplicitWidth = 467  
      object lstDirectoriesListBox: TListBox  
        Left = 0  
        Top = 29  
        Width = 404  
        Height = 74  
        Align = alClient  
        ItemHeight = 14  
        TabOrder = 0  
        ExplicitWidth = 467  
      end  
      object pnl5: TPanel  
        Left = 0  
        Top = 0  
        Width = 404  
        Height = 29  
        Align = alTop  
        BevelOuter = bvNone  
        TabOrder = 1  
        ExplicitWidth = 467  
        object lbl1: TLabel  
          Left = 5  
          Top = 8  
          Width = 115  
          Height = 14  
          Caption = 'Directories to watch:'  
        end  
        object chkWatchSubTree: TCheckBox  
          Left = 220  
          Top = 4  
          Width = 125  
          Height = 17  
          Caption = 'Watch subdirectories'  
          Checked = True  
          State = cbChecked  
          TabOrder = 0  
          OnClick = chkWatchSubTreeClick  
        end  
      end  
    end  
  end  
end  
 
Tags:

文章评论

最 近 更 新
热 点 排 行
Js与CSS工具
代码转换工具

<