From 1ba91d5a0e1df7419a561f6dcf16a0839509a5e7 Mon Sep 17 00:00:00 2001
From: k-m_schindler <k-m_schindler@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Wed, 27 Aug 2008 13:28:57 +0000
Subject: Reordering of the directories[1]: moving Game/Code to src
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1302 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
src/lib/other/DirWatch.pas | 345 ++++++++++++++++++++++++++++++++++++++++
src/lib/other/WinAllocation.pas | 97 +++++++++++
2 files changed, 442 insertions(+)
create mode 100644 src/lib/other/DirWatch.pas
create mode 100644 src/lib/other/WinAllocation.pas
(limited to 'src/lib/other')
diff --git a/src/lib/other/DirWatch.pas b/src/lib/other/DirWatch.pas
new file mode 100644
index 00000000..9d395840
--- /dev/null
+++ b/src/lib/other/DirWatch.pas
@@ -0,0 +1,345 @@
+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
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+ {$H+} // use AnsiString
+{$ENDIF}
+
+uses
+ Windows,
+ Messages,
+ Classes,
+ {$IFDEF FPC}
+ WinAllocation,
+ {$ENDIF}
+ SysUtils;
+
+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
diff --git a/src/lib/other/WinAllocation.pas b/src/lib/other/WinAllocation.pas
new file mode 100644
index 00000000..7c26a0e5
--- /dev/null
+++ b/src/lib/other/WinAllocation.pas
@@ -0,0 +1,97 @@
+unit WinAllocation;
+
+// FPC misses AllocateHWnd and DeallocateHWnd which is used by several
+// libraries such as Midi... or DirWatch.
+// Since FPC 2.2.2 there are dummies in Classes that just raise RunTime exceptions.
+// To avoid those exceptions, include this unit AFTER Classes.
+// Maybe the dummies will be replaced by functional routines in the future.WinAllocation
+//
+// THESE FUNCTIONS ARE ONLY FOR COMPATIBILITY WITH SOME EXTERNAL WIN32 LIBS.
+// DO NOT USE THEM IN USDX CODE.
+//
+
+interface
+
+uses
+ Classes,
+ Windows;
+
+function AllocateHWnd(Method: TWndMethod): HWND;
+procedure DeallocateHWnd(hWnd: HWND);
+
+implementation
+
+function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+var
+ Msg: TMessage;
+ MethodPtr: ^TWndMethod;
+begin
+ FillChar(Msg, SizeOf(Msg), 0);
+ Msg.msg := uMsg;
+ Msg.wParam := wParam;
+ Msg.lParam := lParam;
+
+ MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA));
+ if Assigned(MethodPtr) then
+ MethodPtr^(Msg);
+
+ Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
+end;
+
+function AllocateHWnd(Method: TWndMethod): HWND;
+var
+ ClassExists: Boolean;
+ WndClass, OldClass: TWndClass;
+ MethodPtr: ^TMethod;
+begin
+ Result := 0;
+
+ // setup class-info
+ FillChar(WndClass, SizeOf(TWndClass), 0);
+ WndClass.hInstance := HInstance;
+ // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned,
+ // otherwise race-conditions might occur
+ WndClass.lpfnWndProc := @DefWindowProc;
+ WndClass.lpszClassName:= 'USDXUtilWindowClass';
+
+ // check if class is already registered
+ ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass);
+ // create window-class shared by all windows created by AllocateHWnd()
+ if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then
+ begin
+ if ClassExists then
+ UnregisterClass(WndClass.lpszClassName, HInstance);
+ if (RegisterClass(WndClass) = 0) then
+ Exit;
+ end;
+ // create window
+ Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '',
+ DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil);
+ if (Result = 0) then
+ Exit;
+ // assign individual callback procedure to the window
+ if Assigned(Method) then
+ begin
+ // TMethod contains two pointers but we can pass just one as USERDATA
+ GetMem(MethodPtr, SizeOf(TMethod));
+ MethodPtr^ := TMethod(Method);
+ SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr));
+ end;
+ // now enable AllocateHWndCallback for this window
+ SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback));
+end;
+
+procedure DeallocateHWnd(hWnd: HWND);
+var
+ MethodPtr: ^TMethod;
+begin
+ if (hWnd <> 0) then
+ begin
+ MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA));
+ DestroyWindow(hWnd);
+ if Assigned(MethodPtr) then
+ FreeMem(MethodPtr);
+ end;
+end;
+
+end.
--
cgit v1.2.3