Changeset 424 for trunk/Packages/Common/UCommon.pas
- Timestamp:
- Apr 25, 2022, 6:22:53 PM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/UCommon.pas
r423 r424 6 6 {$IFDEF WINDOWS}Windows,{$ENDIF} 7 7 {$IFDEF UNIX}baseunix,{$ENDIF} 8 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, 8 Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, Graphics, 9 9 FileUtil; //, ShFolder, ShellAPI; 10 10 11 11 type 12 12 TArrayOfByte = array of Byte; 13 TArrayOfString = array of string;14 13 TExceptionEvent = procedure(Sender: TObject; E: Exception) of object; 15 14 … … 33 32 DLLHandle1: HModule; 34 33 35 {$IFDEF WINDOWS} 36 GetUserNameEx: procedure (NameFormat: DWORD; 37 lpNameBuffer: LPSTR; nSize: PULONG); stdcall; 38 {$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); 39 43 40 44 function AddLeadingZeroes(const aNumber, Length : integer) : string; … … 49 53 function ComputerName: string; 50 54 procedure DeleteFiles(APath, AFileSpec: string); 55 function Explode(Separator: Char; Data: string): TStringArray; 51 56 procedure ExecuteProgram(Executable: string; Parameters: array of string); 52 57 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); … … 63 68 function LoadFileToStr(const FileName: TFileName): AnsiString; 64 69 function LoggedOnUserNameEx(Format: TUserNameFormat): string; 65 function MergeArray(A, B: array of string): T ArrayOfString;70 function MergeArray(A, B: array of string): TStringArray; 66 71 function OccurenceOfChar(What: Char; Where: string): Integer; 67 72 procedure OpenWebPage(URL: string); 73 procedure OpenEmail(Email: string); 68 74 procedure OpenFileInShell(FileName: string); 69 75 function PosFromIndex(SubStr: string; Text: string; … … 81 87 function SplitString(var Text: string; Count: Word): string; 82 88 function StripTags(const S: string): string; 83 function TryHexToInt(Data: string; varValue: Integer): Boolean;84 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; 85 91 procedure SortStrings(Strings: TStrings); 86 92 … … 244 250 end; 245 251 246 function TryHexToInt(Data: string; varValue: Integer): Boolean;252 function TryHexToInt(Data: string; out Value: Integer): Boolean; 247 253 var 248 254 I: Integer; … … 260 266 end; 261 267 262 function TryBinToInt(Data: string; varValue: Integer): Boolean;268 function TryBinToInt(Data: string; out Value: Integer): Boolean; 263 269 var 264 270 I: Integer; … … 288 294 end; 289 295 290 function Explode(Separator: char; Data: string): TArrayOfString; 291 begin 292 SetLength(Result, 0); 293 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 294 310 SetLength(Result, Length(Result) + 1); 295 Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1); 296 Delete(Data, 1, Pos(Separator, Data)); 297 end; 298 SetLength(Result, Length(Result) + 1); 299 Result[High(Result)] := Data; 311 Result[High(Result)] := Data; 312 end; 300 313 end; 301 314 … … 308 321 begin 309 322 L := MAX_USERNAME_LENGTH + 2; 323 Result := Default(string); 310 324 SetLength(Result, L); 311 325 if Windows.GetUserName(PChar(Result), L) and (L > 0) then begin … … 344 358 Name: UtsName; 345 359 begin 360 Name := Default(UtsName); 346 361 fpuname(Name); 347 362 Result := Name.Nodename; … … 471 486 end; 472 487 488 procedure OpenEmail(Email: string); 489 begin 490 OpenURL('mailto:' + Email); 491 end; 492 473 493 procedure OpenFileInShell(FileName: string); 474 494 begin … … 499 519 end; 500 520 501 function MergeArray(A, B: array of string): TArrayOfString; 502 var 503 I: Integer; 504 begin 521 function MergeArray(A, B: array of string): TStringArray; 522 var 523 I: Integer; 524 begin 525 Result := Default(TStringArray); 505 526 SetLength(Result, Length(A) + Length(B)); 506 527 for I := 0 to Length(A) - 1 do
Note:
See TracChangeset
for help on using the changeset viewer.