Changeset 86 for trunk/Packages/Common/UCommon.pas
- Timestamp:
- Jun 21, 2022, 5:04:48 PM (23 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/UCommon.pas
r83 r86 1 1 unit UCommon; 2 2 3 {$mode delphi}4 5 3 interface 6 4 7 5 uses 8 {$ ifdef Windows}Windows,{$endif}9 {$ ifdef Linux}baseunix,{$endif}10 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 6 {$IFDEF WINDOWS}Windows,{$ENDIF} 7 {$IFDEF UNIX}baseunix,{$ENDIF} 8 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, Graphics, 11 9 FileUtil; //, ShFolder, ShellAPI; 12 10 13 11 type 14 12 TArrayOfByte = array of Byte; 15 TArrayOfString = array of string;16 13 TExceptionEvent = procedure(Sender: TObject; E: Exception) of object; 17 14 … … 35 32 DLLHandle1: HModule; 36 33 37 {$IFDEF Windows} 38 GetUserNameEx: procedure (NameFormat: DWORD; 39 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 40 {$ENDIF} 34 {$IFDEF WINDOWS} 35 GetUserNameEx: procedure (NameFormat: DWORD; 36 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 37 {$ENDIF} 38 39 const 40 clLightBlue = TColor($FF8080); 41 clLightGreen = TColor($80FF80); 42 clLightRed = TColor($8080FF); 41 43 42 44 function AddLeadingZeroes(const aNumber, Length : integer) : string; … … 51 53 function ComputerName: string; 52 54 procedure DeleteFiles(APath, AFileSpec: string); 55 function Explode(Separator: Char; Data: string): TStringArray; 53 56 procedure ExecuteProgram(Executable: string; Parameters: array of string); 54 57 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); … … 65 68 function LoadFileToStr(const FileName: TFileName): AnsiString; 66 69 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 67 function MergeArray(A, B: array of string): T ArrayOfString;70 function MergeArray(A, B: array of string): TStringArray; 68 71 function OccurenceOfChar(What: Char; Where: string): Integer; 69 72 procedure OpenWebPage(URL: string); 73 procedure OpenEmail(Email: string); 70 74 procedure OpenFileInShell(FileName: string); 71 75 function PosFromIndex(SubStr: string; Text: string; … … 83 87 function SplitString(var Text: string; Count: Word): string; 84 88 function StripTags(const S: string): string; 85 function TryHexToInt(Data: string; varValue: Integer): Boolean;86 function TryBinToInt(Data: string; varValue: Integer): Boolean;89 function TryHexToInt(Data: string; out Value: Integer): Boolean; 90 function TryBinToInt(Data: string; out Value: Integer): Boolean; 87 91 procedure SortStrings(Strings: TStrings); 88 92 … … 246 250 end; 247 251 248 function TryHexToInt(Data: string; varValue: Integer): Boolean;252 function TryHexToInt(Data: string; out Value: Integer): Boolean; 249 253 var 250 254 I: Integer; … … 262 266 end; 263 267 264 function TryBinToInt(Data: string; varValue: Integer): Boolean;268 function TryBinToInt(Data: string; out Value: Integer): Boolean; 265 269 var 266 270 I: Integer; … … 290 294 end; 291 295 292 function Explode(Separator: char; Data: string): TArrayOfString; 293 begin 294 SetLength(Result, 0); 295 while Pos(Separator, Data) > 0 do begin 296 function Explode(Separator: Char; Data: string): TStringArray; 297 var 298 Index: Integer; 299 begin 300 Result := Default(TStringArray); 301 repeat 302 Index := Pos(Separator, Data); 303 if Index > 0 then begin 304 SetLength(Result, Length(Result) + 1); 305 Result[High(Result)] := Copy(Data, 1, Index - 1); 306 Delete(Data, 1, Index); 307 end else Break; 308 until False; 309 if Data <> '' then begin 296 310 SetLength(Result, Length(Result) + 1); 297 Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1); 298 Delete(Data, 1, Pos(Separator, Data)); 299 end; 300 SetLength(Result, Length(Result) + 1); 301 Result[High(Result)] := Data; 302 end; 303 304 {$IFDEF Windows} 311 Result[High(Result)] := Data; 312 end; 313 end; 314 315 {$IFDEF WINDOWS} 305 316 function GetUserName: string; 306 317 const … … 310 321 begin 311 322 L := MAX_USERNAME_LENGTH + 2; 323 Result := Default(string); 312 324 SetLength(Result, L); 313 325 if Windows.GetUserName(PChar(Result), L) and (L > 0) then begin … … 323 335 end; 324 336 end; 325 {$ endif}337 {$ENDIF} 326 338 327 339 function ComputerName: string; 328 {$ ifdef mswindows}340 {$IFDEF WINDOWS} 329 341 const 330 342 INFO_BUFFER_SIZE = 32767; … … 341 353 end; 342 354 end; 343 {$ endif}344 {$ ifdef unix}355 {$ENDIF} 356 {$IFDEF UNIX} 345 357 var 346 358 Name: UtsName; 347 359 begin 360 Name := Default(UtsName); 348 361 fpuname(Name); 349 362 Result := Name.Nodename; 350 363 end; 351 {$ endif}352 353 {$ ifdef windows}364 {$ENDIF} 365 366 {$IFDEF WINDOWS} 354 367 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 355 368 const … … 429 442 procedure LoadLibraries; 430 443 begin 431 {$IFDEF W indows}444 {$IFDEF WINDOWS} 432 445 DLLHandle1 := LoadLibrary('secur32.dll'); 433 446 if DLLHandle1 <> 0 then … … 440 453 procedure FreeLibraries; 441 454 begin 442 {$IFDEF W indows}455 {$IFDEF WINDOWS} 443 456 if DLLHandle1 <> 0 then FreeLibrary(DLLHandle1); 444 457 {$ENDIF} … … 473 486 end; 474 487 488 procedure OpenEmail(Email: string); 489 begin 490 OpenURL('mailto:' + Email); 491 end; 492 475 493 procedure OpenFileInShell(FileName: string); 476 494 begin … … 501 519 end; 502 520 503 function MergeArray(A, B: array of string): TArrayOfString; 504 var 505 I: Integer; 506 begin 521 function MergeArray(A, B: array of string): TStringArray; 522 var 523 I: Integer; 524 begin 525 Result := Default(TStringArray); 507 526 SetLength(Result, Length(A) + Length(B)); 508 527 for I := 0 to Length(A) - 1 do
Note:
See TracChangeset
for help on using the changeset viewer.