Ignore:
Timestamp:
Dec 24, 2022, 7:17:24 PM (23 months ago)
Author:
chronos
Message:
  • Modified: Updated Common package to latest version.
  • Modified: Build with Lazarus 2.2.4.
Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        66Tunneler.dbg
        77tunneler.lps
         8*.res
        89heaptrclog.trc
        910Components/Common/Languages/*.mo
        10 Components/CoolTranslator/Demo/lib
         11

  • trunk/Packages/Common/UCommon.pas

    r51 r54  
    11unit UCommon;
    22
    3 {$mode delphi}
    4 
    53interface
    64
    75uses
    8   {$ifdef Windows}Windows,{$endif}
    9   {$ifdef Linux}baseunix,{$endif}
    10   Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
    11   FileUtil; //, ShFolder, ShellAPI;
     6  {$IFDEF WINDOWS}Windows,{$ENDIF}
     7  {$IFDEF UNIX}baseunix,{$ENDIF}
     8  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, Graphics,
     9  FileUtil, Generics.Collections; //, ShFolder, ShellAPI;
    1210
    1311type
    1412  TArrayOfByte = array of Byte;
    15   TArrayOfString = array of string;
    1613  TExceptionEvent = procedure(Sender: TObject; E: Exception) of object;
    1714
    … …  
    3532  DLLHandle1: HModule;
    3633
    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
     39const
     40  clLightBlue = TColor($FF8080);
     41  clLightGreen = TColor($80FF80);
     42  clLightRed = TColor($8080FF);
    4143
    4244function AddLeadingZeroes(const aNumber, Length : integer) : string;
    … …  
    5153function ComputerName: string;
    5254procedure DeleteFiles(APath, AFileSpec: string);
     55function Explode(Separator: Char; Data: string): TStringArray;
    5356procedure ExecuteProgram(Executable: string; Parameters: array of string);
    5457procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
    … …  
    6265function GetFileFilterItemExt(Filter: string; Index: Integer): string;
    6366function IntToBin(Data: Int64; Count: Byte): string;
     67function Implode(Separator: Char; List: TList<string>): string;
    6468function LastPos(const SubStr: String; const S: String): Integer;
    6569function LoadFileToStr(const FileName: TFileName): AnsiString;
    6670function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    67 function MergeArray(A, B: array of string): TArrayOfString;
     71function MergeArray(A, B: array of string): TStringArray;
    6872function OccurenceOfChar(What: Char; Where: string): Integer;
    6973procedure OpenWebPage(URL: string);
     74procedure OpenEmail(Email: string);
    7075procedure OpenFileInShell(FileName: string);
    7176function PosFromIndex(SubStr: string; Text: string;
    … …  
    8388function SplitString(var Text: string; Count: Word): string;
    8489function StripTags(const S: string): string;
    85 function TryHexToInt(Data: string; var Value: Integer): Boolean;
    86 function TryBinToInt(Data: string; var Value: Integer): Boolean;
     90function TryHexToInt(Data: string; out Value: Integer): Boolean;
     91function TryBinToInt(Data: string; out Value: Integer): Boolean;
    8792procedure SortStrings(Strings: TStrings);
    8893
    … …  
    246251end;
    247252
    248 function TryHexToInt(Data: string; var Value: Integer): Boolean;
     253function TryHexToInt(Data: string; out Value: Integer): Boolean;
    249254var
    250255  I: Integer;
    … …  
    262267end;
    263268
    264 function TryBinToInt(Data: string; var Value: Integer): Boolean;
     269function TryBinToInt(Data: string; out Value: Integer): Boolean;
    265270var
    266271  I: Integer;
    … …  
    290295end;
    291296
    292 function Explode(Separator: char; Data: string): TArrayOfString;
    293 begin
    294   SetLength(Result, 0);
    295   while Pos(Separator, Data) > 0 do begin
     297function Explode(Separator: Char; Data: string): TStringArray;
     298var
     299  Index: Integer;
     300begin
     301  Result := Default(TStringArray);
     302  repeat
     303    Index := Pos(Separator, Data);
     304    if Index > 0 then begin
     305      SetLength(Result, Length(Result) + 1);
     306      Result[High(Result)] := Copy(Data, 1, Index - 1);
     307      Delete(Data, 1, Index);
     308    end else Break;
     309  until False;
     310  if Data <> '' then begin
    296311    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}
     312    Result[High(Result)] := Data;
     313  end;
     314end;
     315
     316function Implode(Separator: Char; List: TList<string>): string;
     317var
     318  I: Integer;
     319begin
     320  Result := '';
     321  for I := 0 to List.Count - 1 do begin
     322    Result := Result + List[I];
     323    if I < List.Count - 1 then Result := Result + Separator;
     324  end;
     325end;
     326
     327{$IFDEF WINDOWS}
    305328function GetUserName: string;
    306329const
    … …  
    310333begin
    311334  L := MAX_USERNAME_LENGTH + 2;
     335  Result := Default(string);
    312336  SetLength(Result, L);
    313337  if Windows.GetUserName(PChar(Result), L) and (L > 0) then begin
    … …  
    323347  end;
    324348end;
    325 {$endif}
     349{$ENDIF}
    326350
    327351function ComputerName: string;
    328 {$ifdef mswindows}
     352{$IFDEF WINDOWS}
    329353const
    330354 INFO_BUFFER_SIZE = 32767;
    … …  
    341365  end;
    342366end;
    343 {$endif}
    344 {$ifdef unix}
     367{$ENDIF}
     368{$IFDEF UNIX}
    345369var
    346370  Name: UtsName;
    347371begin
     372  Name := Default(UtsName);
    348373  fpuname(Name);
    349374  Result := Name.Nodename;
    350375end;
    351 {$endif}
    352 
    353 {$ifdef windows}
     376{$ENDIF}
     377
     378{$IFDEF WINDOWS}
    354379function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    355380const
    … …  
    429454procedure LoadLibraries;
    430455begin
    431   {$IFDEF Windows}
     456  {$IFDEF WINDOWS}
    432457  DLLHandle1 := LoadLibrary('secur32.dll');
    433458  if DLLHandle1 <> 0 then
    … …  
    440465procedure FreeLibraries;
    441466begin
    442   {$IFDEF Windows}
     467  {$IFDEF WINDOWS}
    443468  if DLLHandle1 <> 0 then FreeLibrary(DLLHandle1);
    444469  {$ENDIF}
    … …  
    473498end;
    474499
     500procedure OpenEmail(Email: string);
     501begin
     502  OpenURL('mailto:' + Email);
     503end;
     504
    475505procedure OpenFileInShell(FileName: string);
    476506begin
    … …  
    501531end;
    502532
    503 function MergeArray(A, B: array of string): TArrayOfString;
    504 var
    505   I: Integer;
    506 begin
     533function MergeArray(A, B: array of string): TStringArray;
     534var
     535  I: Integer;
     536begin
     537  Result := Default(TStringArray);
    507538  SetLength(Result, Length(A) + Length(B));
    508539  for I := 0 to Length(A) - 1 do
Note: See TracChangeset for help on using the changeset viewer.