控制台编程

开发平台：
Delphi

DirMon.pas：源码内容
							unit DirMon;
interface
uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
   // Exception's
   EDirMonError = class(Exception);
   // Changes in Files/Directories
   //TFileChangedEvent = procedure( Sender: TObject; FileName: String) of Object;
   TFileChangedEvent = procedure( StrInfo: String) of Object;
   // Files/Directory - Renamed
   //TFileRenamedEvent = procedure( Sender: TObject; fromFileName: String; toFileName: String) of Object;
   TFileRenamedEvent = procedure( StrInfo: String) of Object;
   // watch filters
   TWatchFilter = (nfFILE_NAME,
                  nfDIR_NAME,
                  nfATTRIBUTES,
                  nfSIZE,
                  nfLAST_WRITE,
                  nfLAST_ACCESS,
                  nfCREATION,
                  nfSECURITY);
   TWatchFilters = set of TWatchFilter;
   // The Directory Monitor
   TDirMon = class(TComponent)
   private
      { Private-Deklarationen }
      FDirectoryHandle: THandle;
      FNotificationBuffer: array[0..4096] of Byte;
      FWatchThread: TThread;
      FWatchFilters: TWatchFilters;
      FNotifyFilter: DWord;
      FOverlapped: TOverlapped;
      FPOverlapped: POverlapped;
      FBytesWritten: DWORD;
      FCompletionPort: THandle;
      FPath: String;
      FActive: Boolean;
      FOnCreated: TFileChangedEvent;
      FOnDeleted: TFileChangedEvent;
      FOnModified: TFileChangedEvent;
      FOnRenamed: TFileRenamedEvent;
      FWatchSubTree: Boolean;
      procedure SetActive( AActive: Boolean);
      procedure SetPath(aPath: String);
      procedure cmdCreated( Sender: TObject; FileName: String);
      procedure cmdDeleted( Sender: TObject; FileName: String);
      procedure cmdModified( Sender: TObject; FileName: String);
      procedure cmdRenamed( Sender: TObject; fromFileName: String; toFileName: String);
   protected
      procedure Start;
      procedure Stop;
   public
      { Public-Deklarationen }
      { Protected-Deklarationen }
      constructor Create(Aowner:TComponent);override;
      destructor destroy; override;
   published
      { Published-Deklarationen }
      property Active: Boolean read FActive write SetActive;
      property Path: String read FPath write SetPath;
      property OnCreated: TFileChangedEvent read FOnCreated write FOnCreated;
      property OnDeleted: TFileChangedEvent read FOnDeleted write FOnDeleted;
      property OnModified: TFileChangedEvent read FOnModified write FOnModified;
      property OnRenamed: TFileRenamedEvent read FOnRenamed write FOnRenamed;
      property WatchSubtree: Boolean read FWatchSubTree write FWatchSubtree;
      property WatchFilters: TWatchfilters read FWatchFilters write FWatchFilters;
   end;
implementation
uses
   ShlObj, ActiveX, FileCtrl;
type
   // see windows API help
   PFileNotifyInformation = ^TFileNotifyInformation;
   TFileNotifyInformation = record
      NextEntryOffset: DWORD;
      Action: DWORD;
      FileNameLength: DWORD;
      FileName: array[0..0] of WideChar;
   end;
const
   FILE_LIST_DIRECTORY   = $0001;
type
   TWaitThread = class(TThread)
   private
      FParent: TDirMon;
      FRenamedFrom: String;
      procedure HandleEvent;
   protected
      procedure Execute; override;
   public
      constructor Create(AParent: TDirMon);
   end;
///////////////////////////////////////////////////////////////////////
constructor TWaitThread.Create(AParent: TDirMon);
begin
   inherited Create(True);
   FreeOnTerminate := False;
   FParent := AParent;
end;
procedure TWaitThread.HandleEvent;
var
   FileOpNotification: PFileNotifyInformation;
   Offset: Longint;
begin
   with FParent do
   begin
      Pointer(FileOpNotification) := @FNotificationBuffer[0];
      repeat
         Offset := FileOpNotification^.NextEntryOffset;
         Case FileOpNotification^.Action of
            1: cmdCreated( FParent, WideCharToString(@(FileOpNotification^.FileName)));
            2: cmdDeleted( FParent, WideCharToString(@(FileOpNotification^.FileName)));
            3: cmdModified( FParent, WideCharToString(@(FileOpNotification^.FileName)));
            4: FRenamedFrom := WideCharToString(@(FileOpNotification^.FileName)); // Ausnahme
            5: cmdRenamed( FParent, FRenamedFrom,WideCharToString(@(FileOpNotification^.FileName)));
         end;
         PChar(FileOpNotification) := PChar(FileOpNotification)+Offset;
      until Offset=0;
   end;
end;
procedure TWaitThread.Execute;
var
   numBytes: DWORD;
   CompletionKey: DWORD;
begin
   while not Terminated do
   begin
     GetQueuedCompletionStatus( FParent.FCompletionPort, numBytes, CompletionKey, FParent.FPOverlapped, INFINITE);
     if CompletionKey <> 0 then
     begin
        Synchronize(HandleEvent);
        with FParent do
        begin
           FBytesWritten := 0;
           ZeroMemory(@FNotificationBuffer, SizeOf(FNotificationBuffer));
           ReadDirectoryChanges(FDirectoryHandle, @FNotificationBuffer, SizeOf(FNotificationBuffer), FParent.WatchSubtree , FNotifyFilter, @FBytesWritten, @FOverlapped, nil);
        end;
     end
     else
        Terminate;
  end;
end;
constructor TDirMon.Create(Aowner:TComponent);
begin
  inherited Create(Aowner);
  FCompletionPort := 0;
  FDirectoryHandle := 0;
  FPOverlapped := @FOverlapped;
  ZeroMemory(@FOverlapped, SizeOf(FOverlapped));
  FWatchFilters:=[nfFILE_NAME,nfDIR_NAME,nfLAST_WRITE,nfCREATION];
end;
destructor TDirMon.destroy;
begin
   if FActive then 
      Stop;
   inherited;
end;
procedure TDirMon.SetActive( AActive: Boolean);
begin
  if AActive Then
     Start
  else
     Stop;
end;
procedure TDirMon.Start;
begin
   if FActive then Exit; // Don't start it again
   FNotifyFilter := 0;   // Set MyFilterArray->DWord-Filter in ReadDirectoryChanges
   if (nfFILE_NAME in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_FILE_NAME;
   if (nfDIR_NAME in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_DIR_NAME;
   if (nfATTRIBUTES in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_ATTRIBUTES;
   if (nfSIZE in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_SIZE;
   if (nfLAST_WRITE in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_LAST_WRITE;
   if (nfLAST_ACCESS in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_LAST_ACCESS;
   if (nfCREATION in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_CREATION;
   if (nfSECURITY in FWatchFilters) then 
      FNotifyFilter:=FNotifyFilter or FILE_NOTIFY_CHANGE_SECURITY;
   if FNotifyFilter = 0 then
      exit;
   FDirectoryHandle := CreateFile(PChar(FPath),
      FILE_LIST_DIRECTORY,
      FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
      nil,
      OPEN_EXISTING,
      FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED,
      0);
   if FDirectoryHandle = INVALID_HANDLE_VALUE then
   begin
      FDirectoryHandle := 0;
      raise EDirMonError.Create(SysErrorMessage(GetLastError));
      exit;
   end;
   FCompletionPort := CreateIoCompletionPort(FDirectoryHandle, 0, Longint(pointer(self)), 0);
   ZeroMemory(@FNotificationBuffer, SizeOf(FNotificationBuffer));
   FBytesWritten := 0;
   if not ReadDirectoryChanges(FDirectoryHandle, @FNotificationBuffer, SizeOf(FNotificationBuffer), FWatchSubTree, FNotifyFilter, @FBytesWritten, @FOverlapped, nil) then
   begin
      CloseHandle(FDirectoryHandle);
      FDirectoryHandle := 0;
      CloseHandle(FCompletionPort);
      FCompletionPort := 0;
      raise EDirMonError.Create(SysErrorMessage(GetLastError));
      exit;
   end;
   // The Thread is the Monitorig Thread
   FWatchThread := TWaitThread.Create(self);
   TWaitThread(FWatchThread).Resume;
   FActive := True;
end;
procedure TDirMon.Stop;
begin
   if not FActive then Exit;
   if FCompletionPort = 0 then
      exit;
   PostQueuedCompletionStatus(FCompletionPort, 0, 0, nil);
   FWatchThread.WaitFor;
   FWatchThread.Free;
   CloseHandle(FDirectoryHandle);
   FDirectoryHandle := 0;
   CloseHandle(FCompletionPort);
   FCompletionPort := 0;
   FActive := False;
end;
procedure TDirMon.cmdCreated( Sender:TObject;FileName:String);
var 
   StrInfo: String;
begin
   if Assigned(FOnCreated) then
   begin
      StrInfo:='30|'
         +Self.Path+FileName;
      FOnCreated(StrInfo);
   end
end;
procedure TDirMon.cmdDeleted(  Sender:TObject;FileName:String);
var 
   StrInfo: String;
begin
   if Assigned(FOnDeleted) then
   begin
      StrInfo:='31|'
        +Self.Path+FileName;
      FOnDeleted(StrInfo);
   end;
end;
procedure TDirMon.cmdModified(  Sender:TObject;FileName:String);
var 
   StrInfo: String;
begin
   if Assigned(FOnModified) then
   begin
      StrInfo:='32|'
         +Self.Path+FileName;
      FOnModified(StrInfo);
   end;
end;
procedure TDirMon.cmdRenamed( Sender: TObject; fromFileName: String; toFileName: String);
var 
   StrInfo: String;
begin
   if Assigned(FOnRenamed) then
   begin
      StrInfo:='33|'
         +Self.Path+toFileName+'|'+fromFileName;
      FOnRenamed(StrInfo);
   end;
end;
procedure TDirMon.SetPath(aPath: String);
{$IFNDEF VER130}
function IncludeTrailingBackslash(const S: string): string;
begin
   if S[length(S)]='' then result:=S else result:=S+'';
end;
{$ENDIF}
begin
   if DirectoryExists(aPath) then
      FPath:=IncludeTrailingBackslash(aPath);
   if FActive then // When You do this at RunTime - We stop and start the Monitoring Process
   begin
      Stop;
      start;
   end;
end;
end.

						