程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 監控指定文件夾

監控指定文件夾

編輯:Delphi

該功能在delphi XE + XP 下測試通過   O2DirSpy.pas    (該單元獲取自網絡) [delphi]   {====================================================================}   {   TOxygenDirectorySpy Component, v1.6 c 2000-2001 Oxygen Software  }   {--------------------------------------------------------------------}   {          Written by Oleg Fyodorov, [email protected]       }   {                  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.       調用單元 [delphi]   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.       調用窗體 [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     end     object pnl1: TPanel       Left = 0       Top = 0       Width = 485       Height = 105       Align = alTop       TabOrder = 1       object pnl2: TPanel         Left = 405         Top = 1         Width = 79         Height = 103         Align = alRight         BevelOuter = bvNone         TabOrder = 0         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         object lstDirectoriesListBox: TListBox           Left = 0           Top = 29           Width = 404           Height = 74           Align = alClient           ItemHeight = 14           TabOrder = 0         end         object pnl5: TPanel           Left = 0           Top = 0           Width = 404           Height = 29           Align = alTop           BevelOuter = bvNone           TabOrder = 1           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  www.2cto.com           Caption = 'Watch subdirectories'             Checked = True             State = cbChecked             TabOrder = 0             OnClick = chkWatchSubTreeClick           end         end       end     end   end    

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved