- Timestamp:
- May 23, 2011, 10:59:04 AM (13 years ago)
- Location:
- Common
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/UCommon.pas
r240 r245 1 1 unit UCommon; 2 2 3 {$mode delphi} 4 3 5 interface 4 6 5 7 uses 6 Windows, Classes, SysUtils, SpecializedList, StrUtils, Dialogs; //, ShFolder, ShellAPI; 8 Windows, Classes, SysUtils, SpecializedList, StrUtils, Dialogs, 9 FileUtil; //, ShFolder, ShellAPI; 7 10 8 11 type … … 25 28 var 26 29 ExceptionHandler: TExceptionEvent; 30 DLLHandle1: HModule; 31 GetUserNameEx: procedure (NameFormat: DWORD; 32 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 33 27 34 28 35 function IntToBin(Data: Cardinal; Count: Byte): string; … … 45 52 function GetFileFilterItemExt(Filter: string; Index: Integer): string; 46 53 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); 54 procedure DeleteFiles(APath, AFileSpec: string); 47 55 48 56 49 57 implementation 58 59 procedure DeleteFiles(APath, AFileSpec: string); 60 var 61 SearchRec: TSearchRec; 62 Find: Integer; 63 Path: string; 64 begin 65 Path := IncludeTrailingPathDelimiter(APath); 66 67 Find := FindFirst(Path + AFileSpec, faAnyFile xor faDirectory, SearchRec); 68 while Find = 0 do begin 69 DeleteFile(Path + SearchRec.Name); 70 71 Find := SysUtils.FindNext(SearchRec); 72 end; 73 FindClose(SearchRec); 74 end; 75 50 76 51 77 function GetFileFilterItemExt(Filter: string; Index: Integer): string; … … 226 252 end; 227 253 228 procedure GetUserNameEx(NameFormat: DWORD; 229 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 230 external 'secur32.dll' Name 'GetUserNameExA'; 231 254 function GetVersionInfo: TOSVersionInfo; 255 begin 256 Result.dwOSVersionInfoSize := SizeOf(Result); 257 if GetVersionEx(Result) then begin 258 end; 259 end; 232 260 233 261 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 234 262 var 235 263 UserName: array[0..250] of Char; 264 VersionInfo: TOSVersionInfo; 236 265 Size: DWORD; 237 266 begin 238 Size := 250; 239 GetUserNameEx(Integer(Format), @UserName, @Size); 240 Result := UTF8Encode(UserName); 267 VersionInfo := GetVersionInfo; 268 if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then begin 269 Size := 250; 270 GetUserNameEx(Integer(Format), @UserName, @Size); 271 Result := UTF8Encode(UserName); 272 end else Result := GetUserName; 241 273 end; 242 274 … … 272 304 end; 273 305 306 procedure LoadLibraries; 307 begin 308 DLLHandle1 := LoadLibrary('secur32.dll'); 309 if DLLHandle1 <> 0 then 310 begin 311 @GetUserNameEx := GetProcAddress(DLLHandle1, 'GetUserNameExA'); 312 end; 313 end; 314 315 procedure FreeLibraries; 316 begin 317 if DLLHandle1 <> 0 then FreeLibrary(DLLHandle1); 318 end; 319 320 321 initialization 322 323 LoadLibraries; 324 325 326 finalization 327 328 FreeLibraries; 329 274 330 end. -
Common/UThreading.pas
r230 r245 6 6 7 7 uses 8 Classes, SysUtils, Forms, Contnrs ;8 Classes, SysUtils, Forms, Contnrs, SyncObjs; 9 9 10 10 type 11 11 TExceptionEvent = procedure (Sender: TObject; E: Exception) of object; 12 12 TMethodCall = procedure of object; 13 14 { TTermThread }15 16 TTermThread = class(TThread)17 Finished: Boolean;18 Method: TMethodCall;19 procedure Execute; override;20 end;21 13 22 14 { TListedThread } … … 28 20 destructor Destroy; override; 29 21 procedure Sleep(Delay: Integer); 22 property Terminated; 23 end; 24 25 { TTermThread } 26 27 TTermThread = class(TListedThread) 28 private 29 public 30 Finished: Boolean; 31 Method: TMethodCall; 32 procedure Execute; override; 30 33 end; 31 34 32 35 var 33 ThreadList: TObjectList; // TListedThread 36 ThreadList: TObjectList; // TList<TListedThread> 37 ThreadListLock: TCriticalSection; 38 OnException: TExceptionEvent; 34 39 35 40 procedure RunInThread(Method: TMethodCall); 36 41 procedure Synchronize(Method: TMethodCall); 42 43 resourcestring 44 SCurrentThreadNotFound = 'Current thread ID %d not found in list.'; 37 45 38 46 … … 49 57 Thread.Method := Method; 50 58 while not Thread.Finished do begin 51 Application.ProcessMessages;59 if MainThreadID = ThreadID then Application.ProcessMessages; 52 60 Sleep(1); 53 61 end; … … 70 78 Thread := TListedThread(ThreadList[I]); 71 79 TThread.Synchronize(Thread, Method); 72 end else raise Exception.Create(Format( 'Current thread ID %d not found in list.', [ThreadID]));80 end else raise Exception.Create(Format(SCurrentThreadNotFound, [ThreadID])); 73 81 end; 74 82 end; … … 80 88 begin 81 89 inherited; 82 ThreadList.Add(Self); 90 try 91 ThreadListLock.Acquire; 92 ThreadList.Add(Self); 93 finally 94 ThreadListLock.Release; 95 end; 83 96 end; 84 97 85 98 destructor TListedThread.Destroy; 86 99 begin 87 ThreadList.Delete(ThreadList.IndexOf(Self)); 100 if not Suspended then 101 begin 102 Terminate; 103 WaitFor; 104 end; 105 try 106 ThreadListLock.Acquire; 107 ThreadList.Delete(ThreadList.IndexOf(Self)); 108 finally 109 ThreadListLock.Release; 110 end; 88 111 inherited Destroy; 89 112 end; … … 106 129 procedure TTermThread.Execute; 107 130 begin 108 Method; 109 Finished := True; 131 try 132 Method; 133 Finished := True; 134 except 135 on E: Exception do 136 if Assigned(OnException) then 137 OnException(Self, E); 138 end; 110 139 end; 111 140 112 141 initialization 113 142 143 ThreadListLock := TCriticalSection.Create; 114 144 ThreadList := TObjectList.Create; 115 145 ThreadList.OwnsObjects := False; … … 118 148 119 149 ThreadList.Free; 150 ThreadListLock.Free; 120 151 121 152 end.
Note:
See TracChangeset
for help on using the changeset viewer.