oops

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@554 b956fd51-792f-4845-bead-9b4dfca2ff2c

2 files changed, 334 insertions, 0 deletions

diff --git a/Game/Code/lib/other/DirWatch.dcu b/Game/Code/lib/other/DirWatch.dcu
new file mode 100644
index 00000000..e82e738b
--- /dev/null
+++ b/Game/Code/lib/other/DirWatch.dcu
diff --git a/Game/Code/lib/other/DirWatch.pas b/Game/Code/lib/other/DirWatch.pas
new file mode 100644
index 00000000..88c3489e
--- /dev/null
+++ b/Game/Code/lib/other/DirWatch.pas
@@ -0,0 +1,334 @@
+unit DirWatch;

+

+// -----------------------------------------------------------------------------

+// Component Name:  TDirectoryWatch                                            .

+// Module:          DirWatch                                                   .

+// Description:     Implements watching for file changes in a designated       .

+//                  directory (or directories).                                .

+// Version:         1.4                                                        .

+// Date:            10-MAR-2003                                                .

+// Target:          Win32, Delphi 3 - Delphi 7                                 .

+// Author:          Angus Johnson, angusj-AT-myrealbox-DOT-com                 .

+//                  A portion of code has been copied from the Drag & Drop     .

+//                  Component Suite which I co-authored with Anders Melander.  .

+// Copyright:       © 2003 Angus Johnson                                       .

+//                                                                             .

+// Usage:           1. Add a TDirectoryWatch component to your form.           .

+//                  2. Set its Directory property                              .

+//                  3. If you wish to watch its subdirectories too then set    .

+//                  the WatchSubDir property to true                           .

+//                  4. Assign the OnChange event                               .

+//                  5. Set Active to true                                      .

+// -----------------------------------------------------------------------------

+

+interface

+

+uses

+  Windows, Messages, SysUtils, Forms, Classes;

+

+type

+  TNotifyFilters = set of (nfFilename, nfDirname, nfAttrib,

+    nfSize, nfLastWrite, nfSecurity);

+

+  TWatchThread = class;             //forward declaration

+

+  TDirectoryWatch = class(TComponent)

+  private

+    fWindowHandle: THandle;

+    fWatchThread: TWatchThread;

+    fWatchSubDirs: boolean;

+    fDirectory: string;

+    fActive: boolean;

+    fNotifyFilters: TNotifyFilters; //see FindFirstChangeNotification in winAPI

+    fOnChangeEvent: TNotifyEvent;

+    procedure SetActive(aActive: boolean);

+    procedure SetDirectory(aDir: string);

+    procedure SetWatchSubDirs(aWatchSubDirs: boolean);

+    procedure SetNotifyFilters(aNotifyFilters: TNotifyFilters);

+    procedure WndProc(var aMsg: TMessage);

+  public

+    constructor Create(aOwner: TComponent); override;

+    destructor Destroy; override;

+  published

+    property Directory: string read fDirectory write SetDirectory;

+    property NotifyFilters: TNotifyFilters

+      read fNotifyFilters write SetNotifyFilters;

+    property WatchSubDirs: boolean read fWatchSubDirs write SetWatchSubDirs;

+    property Active: boolean read fActive write SetActive;

+    property OnChange: TNotifyEvent read fOnChangeEvent write fOnChangeEvent;

+  end;

+

+  TWatchThread = class(TThread)

+  private

+    fOwnerHdl: Thandle;

+    fChangeNotify : THandle; //Signals whenever Windows detects a change in    .

+                             //the watched directory                           .

+    fBreakEvent: THandle;    //Signals when either the Directory property      .

+                             //changes or when the thread terminates           .

+    fDirectory: string;

+    fWatchSubDirs: longbool;

+    fNotifyFilters: dword;

+    fFinished: boolean;    

+  protected

+    procedure SetDirectory(const Value: string);

+    procedure ProcessFilenameChanges;

+    procedure Execute; override;

+  public

+    constructor Create( OwnerHdl: THandle;

+      const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);

+    destructor Destroy; override;

+    procedure Terminate;

+    property Directory: string write SetDirectory;

+  end;

+

+procedure Register;

+

+implementation

+

+const

+  NOTIFYCHANGE_MESSAGE = WM_USER + 1;

+

+resourcestring

+  sInvalidDir = 'Invalid Directory: ';

+

+//----------------------------------------------------------------------------

+// Miscellaneous functions ...

+//----------------------------------------------------------------------------

+

+procedure Register;

+begin

+  RegisterComponents('Samples', [TDirectoryWatch]);

+end;

+//----------------------------------------------------------------------------

+

+function DirectoryExists(const Name: string): Boolean;

+var

+  Code: Integer;

+begin

+  Code := GetFileAttributes(PChar(Name));

+  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);

+end;

+

+//----------------------------------------------------------------------------

+// TDirectoryWatch methods ...

+//----------------------------------------------------------------------------

+

+constructor TDirectoryWatch.Create(aOwner: TComponent);

+begin

+  inherited Create(aOwner);

+  //default Notify values - notify if either a file name or a directory name

+  //changes or if a file is modified ...

+  fNotifyFilters := [nfFilename, nfDirname, nfLastWrite];

+  fDirectory := 'C:\';

+  //this non-visual control needs to handle messages, so ...

+  if not (csDesigning in ComponentState) then

+    fWindowHandle := AllocateHWnd(WndProc);

+end;

+//----------------------------------------------------------------------------

+

+destructor TDirectoryWatch.Destroy;

+begin

+  Active := false;

+  if not (csDesigning in ComponentState) then

+    DeallocateHWnd(fWindowHandle);

+  inherited Destroy;

+end;

+//----------------------------------------------------------------------------

+

+procedure TDirectoryWatch.WndProc(var aMsg: TMessage);

+begin

+  with aMsg do

+    if Msg = NOTIFYCHANGE_MESSAGE then

+    begin

+      if assigned(OnChange) then OnChange(self);

+    end else

+      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);

+end;

+//------------------------------------------------------------------------------

+

+procedure TDirectoryWatch.SetNotifyFilters(aNotifyFilters: TNotifyFilters);

+begin

+  if aNotifyFilters = fNotifyFilters then exit;

+  fNotifyFilters := aNotifyFilters;

+  if assigned(fWatchThread) then

+  begin

+    Active := false;

+    Active := true;

+  end;

+end;

+//------------------------------------------------------------------------------

+

+procedure TDirectoryWatch.SetWatchSubDirs(aWatchSubDirs: boolean);

+begin

+  if aWatchSubDirs = fWatchSubDirs then exit;

+  fWatchSubDirs := aWatchSubDirs;

+  if assigned(fWatchThread) then

+  begin

+    Active := false;

+    Active := true;

+  end;

+end;

+//------------------------------------------------------------------------------

+

+procedure TDirectoryWatch.SetDirectory(aDir: string);

+begin

+  if aDir = '' then

+  begin

+    Active := false;

+    fDirectory := '';

+    exit;

+  end;

+  if (aDir[length(aDir)] <> '\') then aDir := aDir + '\';

+  if aDir = fDirectory then exit;

+  if not (csDesigning in ComponentState) and not DirectoryExists(aDir) then

+    raise Exception.Create( sInvalidDir + aDir);

+  fDirectory := aDir;

+  if assigned(fWatchThread) then

+    fWatchThread.Directory := fDirectory;

+end;

+//------------------------------------------------------------------------------

+

+procedure TDirectoryWatch.SetActive(aActive: boolean);

+var

+  nf: dword;

+begin

+  if aActive = fActive then exit;

+  fActive := aActive;

+  if csDesigning in ComponentState then exit;

+  if fActive then

+  begin

+    if not DirectoryExists(fDirectory) then

+    begin

+      fActive := false;

+      raise Exception.Create(sInvalidDir + fDirectory);

+    end;

+    nf := 0;

+    if nfFilename in fNotifyFilters then

+      nf := nf or FILE_NOTIFY_CHANGE_FILE_NAME;

+    if nfDirname in fNotifyFilters then

+      nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME;

+    if nfAttrib in fNotifyFilters then

+      nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES;

+    if nfSize in fNotifyFilters then

+      nf := nf or FILE_NOTIFY_CHANGE_SIZE;

+    if nfLastWrite in fNotifyFilters then

+      nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE;

+    if nfSecurity in fNotifyFilters then

+      nf := nf or FILE_NOTIFY_CHANGE_SECURITY;

+    fWatchThread := TWatchThread.Create(

+      fWindowHandle, fDirectory, fWatchSubDirs, nf);

+  end else

+  begin

+    fWatchThread.Terminate;

+    fWatchThread := nil;

+  end;

+end;

+

+//----------------------------------------------------------------------------

+// TWatchThread methods ...

+//----------------------------------------------------------------------------

+

+constructor TWatchThread.Create(OwnerHdl: THandle;

+  const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);

+begin

+  inherited Create(True);       

+  fOwnerHdl := OwnerHdl;

+  if WatchSubDirs then

+    cardinal(fWatchSubDirs) := 1 //workaround a Win9x OS issue

+  else

+    fWatchSubDirs := false;

+  FreeOnTerminate := true;

+  Priority := tpLowest;

+  fDirectory := InitialDir;

+  fNotifyFilters := NotifyFilters;

+  fBreakEvent := windows.CreateEvent(nil, False, False, nil);

+  Resume;

+end;

+//------------------------------------------------------------------------------

+

+destructor TWatchThread.Destroy;

+begin

+  CloseHandle(fBreakEvent);

+  inherited Destroy;

+end;

+//------------------------------------------------------------------------------

+

+procedure TWatchThread.SetDirectory(const Value: string);

+begin

+  if (Value = FDirectory) then exit;

+  FDirectory := Value;

+  SetEvent(fBreakEvent);

+end;

+//------------------------------------------------------------------------------

+

+procedure TWatchThread.Terminate;

+begin

+  inherited Terminate;

+  SetEvent(fBreakEvent);

+  while not fFinished do sleep(10); //avoids a reported resource leak

+                                    //if called while closing the application.

+end;

+//------------------------------------------------------------------------------

+

+procedure TWatchThread.Execute;

+begin

+  //OUTER LOOP - manages Directory property reassignments

+  while (not Terminated) do

+  begin

+    fChangeNotify := FindFirstChangeNotification(pchar(fDirectory),

+      fWatchSubDirs, fNotifyFilters);

+    if (fChangeNotify = INVALID_HANDLE_VALUE) then

+      //Can't monitor the specified directory so we'll just wait for

+      //a new Directory assignment or the thread terminating ...

+      WaitForSingleObject(fBreakEvent, INFINITE)

+    else

+      try

+        //Now do the INNER loop...

+        ProcessFilenameChanges;

+      finally

+        FindCloseChangeNotification(fChangeNotify);

+      end;

+  end;

+  fFinished := true;

+end;

+//------------------------------------------------------------------------------

+

+procedure TWatchThread.ProcessFilenameChanges;

+var

+  WaitResult : DWORD;

+  HandleArray : array[0..1] of THandle;

+const

+  TEN_MSECS = 10;

+  HUNDRED_MSECS = 100;

+begin

+  HandleArray[0] := fBreakEvent;

+  HandleArray[1] := fChangeNotify;

+  //INNER LOOP - exits only when fBreakEvent signaled

+  while (not Terminated) do

+  begin

+    //waits for either fChangeNotify or fBreakEvent ...

+    WaitResult := WaitForMultipleObjects(2, @HandleArray, False, INFINITE);

+    if (WaitResult = WAIT_OBJECT_0 + 1) then //fChangeNotify

+    begin

+      repeat //ie: if a number of files are changing in a block

+             //just post the one notification message ...

+        FindNextChangeNotification(fChangeNotify);

+      until Terminated or

+        (WaitForSingleObject(fChangeNotify, TEN_MSECS) <> WAIT_OBJECT_0);

+      if Terminated then break;

+      //OK, now notify the main thread (before restarting inner loop)...

+      PostMessage(fOwnerHdl, NOTIFYCHANGE_MESSAGE, 0, 0);

+    end else //fBreakEvent ...

+    begin

+      //If the Directory property is undergoing multiple rapid reassignments

+      //wait 'til this stops before restarting monitoring of a new directory ...

+      while (not Terminated) and

+        (WaitForSingleObject(fBreakEvent, HUNDRED_MSECS) = WAIT_OBJECT_0) do;

+      break; //EXIT LOOP HERE

+    end;

+  end;

+end;

+//------------------------------------------------------------------------------

+//------------------------------------------------------------------------------

+

+end.
\ No newline at end of file