diff options
author | k-m_schindler <k-m_schindler@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-08-27 13:28:57 +0000 |
---|---|---|
committer | k-m_schindler <k-m_schindler@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-08-27 13:28:57 +0000 |
commit | 1ba91d5a0e1df7419a561f6dcf16a0839509a5e7 (patch) | |
tree | 3f76e96fc5a3f5b738dabce28642ff2415748ccb /Game/Code/lib/other | |
parent | e9fd8ce40b4cbf006695fd6e56f84071407843c9 (diff) | |
download | usdx-1ba91d5a0e1df7419a561f6dcf16a0839509a5e7.tar.gz usdx-1ba91d5a0e1df7419a561f6dcf16a0839509a5e7.tar.xz usdx-1ba91d5a0e1df7419a561f6dcf16a0839509a5e7.zip |
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
Diffstat (limited to 'Game/Code/lib/other')
-rw-r--r-- | Game/Code/lib/other/DirWatch.pas | 345 | ||||
-rw-r--r-- | Game/Code/lib/other/WinAllocation.pas | 97 |
2 files changed, 0 insertions, 442 deletions
diff --git a/Game/Code/lib/other/DirWatch.pas b/Game/Code/lib/other/DirWatch.pas deleted file mode 100644 index 9d395840..00000000 --- a/Game/Code/lib/other/DirWatch.pas +++ /dev/null @@ -1,345 +0,0 @@ -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/Game/Code/lib/other/WinAllocation.pas b/Game/Code/lib/other/WinAllocation.pas deleted file mode 100644 index 7c26a0e5..00000000 --- a/Game/Code/lib/other/WinAllocation.pas +++ /dev/null @@ -1,97 +0,0 @@ -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. |