Changeset 332 for trunk/Packages/Common/Common.pas

Timestamp:

Aug 27, 2024, 3:48:44 PM (2 months ago)

Author:

chronos

Message:

• Modified: Updated Common package.

File:

• trunk/Packages/Common/Common.pas (modified) (11 diffs)

trunk/Packages/Common/Common.pas

@@ -55 +55 @@
 function EndsWith(Text, What: string): Boolean;
 function Explode(Separator: Char; Data: string): TStringArray;
-procedure ExecuteProgram(Executable: string; Parameters: array of string);
+procedure ExecuteProgram(Executable: string; Parameters: array of string;
+  Environment: array of string; CurrentDirectory: string = '');
+procedure ExecuteProgramOutput(Executable: string; Parameters: array of string;
+  Environment: array of string; out Output, Error: string;
+  out ExitCode: Integer; CurrentDirectory: string = '');
 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
 procedure FreeThenNil(var Obj);
@@ -63 +67 @@
 function GetBit(Variable: QWord; Index: Byte): Boolean;
 function GetStringPart(var Text: string; Separator: string): string;
+function GetEnvironmentVariables: TStringArray;
 function GenerateNewName(OldName: string): string;
 function GetFileFilterItemExt(Filter: string; Index: Integer): string;
 function IntToBin(Data: Int64; Count: Byte): string;
-function Implode(Separator: string; List: TList<string>): string;
-function Implode(Separator: string; List: TStringList; Around: string = ''): string;
+function Implode(Separator: string; List: TList<string>): string; overload;
+function Implode(Separator: string; List: array of string): string; overload;
+function Implode(Separator: string; List: TStringList; Around: string = ''): string; overload;
 function LastPos(const SubStr: String; const S: String): Integer;
 function LoadFileToStr(const FileName: TFileName): AnsiString;
@@ -98 +104 @@
 implementation
 
+resourcestring
+  SExecutionError = 'Excution error: %s (exit code: %d)';
+
 function StartsWith(Text, What: string): Boolean;
 begin
@@ -108 +117 @@
 end;
 
-function BinToInt(BinStr : string) : Int64;
-var
-  i : byte;
-  RetVar : Int64;
+function BinToInt(BinStr: string): Int64;
+var
+  I: Byte;
+  RetVar: Int64;
 begin
   BinStr := UpperCase(BinStr);
-  if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
+  if BinStr[length(BinStr)] = 'B' then Delete(BinStr, Length(BinStr), 1);
   RetVar := 0;
-  for i := 1 to length(BinStr) do begin
-    if not (BinStr[i] in ['0','1']) then begin
+  for I := 1 to Length(BinStr) do begin
+    if not (BinStr[I] in ['0','1']) then begin
       RetVar := 0;
       Break;
     end;
-    RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
+    RetVar := (RetVar shl 1) + (Byte(BinStr[I]) and 1);
   end;
 
@@ -136 +145 @@
   end;
 end;
-
 
 procedure DeleteFiles(APath, AFileSpec: string);
@@ -154 +162 @@
   FindClose(SearchRec);
 end;
-
 
 function GetFileFilterItemExt(Filter: string; Index: Integer): string;
@@ -177 +184 @@
   if FileExt <> '.*' then
     FileDialog.FileName := ChangeFileExt(FileDialog.FileName, FileExt)
+end;
+
+function GetEnvironmentVariables: TStringArray;
+var
+  I: Integer;
+begin
+  Result := Default(TStringArray);
+  SetLength(Result, GetEnvironmentVariableCount);
+  for I := 0 to GetEnvironmentVariableCount - 1 do
+    Result[I] := GetEnvironmentString(I);
 end;
 
@@ -219 +236 @@
 end;*)
 
+function Implode(Separator: string; List: array of string): string;
+var
+  I: Integer;
+begin
+  Result := '';
+  for I := 0 to Length(List) - 1 do begin
+    Result := Result + List[I];
+    if I < Length(List) - 1 then Result := Result + Separator;
+  end;
+end;
+
 function Implode(Separator: string; List: TStringList; Around: string = ''): string;
 var
@@ -494 +522 @@
 end;
 
-procedure ExecuteProgram(Executable: string; Parameters: array of string);
+procedure ExecuteProgram(Executable: string; Parameters: array of string;
+  Environment: array of string; CurrentDirectory: string = '');
 var
   Process: TProcess;
   I: Integer;
 begin
+  Process := TProcess.Create(nil);
   try
-    Process := TProcess.Create(nil);
     Process.Executable := Executable;
     for I := 0 to Length(Parameters) - 1 do
       Process.Parameters.Add(Parameters[I]);
+    for I := 0 to Length(Environment) - 1 do
+      Process.Environment.Add(Environment[I]);
+    Process.CurrentDirectory := CurrentDirectory;
+    Process.ShowWindow := swoHIDE;
     Process.Options := [poNoConsole];
     Process.Execute;
@@ -511 +544 @@
 end;
 
+procedure ExecuteProgramOutput(Executable: string; Parameters: array of string;
+  Environment: array of string; out Output, Error: string; out ExitCode: Integer;
+  CurrentDirectory: string);
+var
+  Process: TProcess;
+  I: Integer;
+  ReadCount: Integer;
+  Buffer: string;
+const
+  BufferSize = 1000;
+begin
+  Process := TProcess.Create(nil);
+  try
+    Process.Executable := Executable;
+    for I := 0 to Length(Parameters) - 1 do
+      Process.Parameters.Add(Parameters[I]);
+    for I := 0 to Length(Environment) - 1 do
+      Process.Environment.Add(Environment[I]);
+    Process.CurrentDirectory := CurrentDirectory;
+    Process.ShowWindow := swoHIDE;
+    Process.Options := [poNoConsole, poUsePipes];
+    Process.Execute;
+
+    Output := '';
+    Error := '';
+    Buffer := '';
+    SetLength(Buffer, BufferSize);
+    while Process.Running do begin
+      if Process.Output.NumBytesAvailable > 0 then begin
+        ReadCount := Process.Output.Read(Buffer[1], Length(Buffer));
+        Output := Output + Copy(Buffer, 1, ReadCount);
+      end;
+
+      if Process.Stderr.NumBytesAvailable > 0 then begin
+        ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer));
+        Error := Error + Copy(Buffer, 1, ReadCount)
+      end;
+
+      Sleep(10);
+    end;
+
+    if Process.Output.NumBytesAvailable > 0 then begin
+      ReadCount := Process.Output.Read(Buffer[1], Length(Buffer));
+      Output := Output + Copy(Buffer, 1, ReadCount);
+    end;
+
+    if Process.Stderr.NumBytesAvailable > 0 then begin
+      ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer));
+      Error := Error + Copy(Buffer, 1, ReadCount);
+    end;
+
+    ExitCode := Process.ExitCode;
+
+    if (ExitCode <> 0) or (Error <> '') then
+      raise Exception.Create(Format(SExecutionError, [Output + Error, ExitCode]));
+  finally
+    Process.Free;
+  end;
+end;
+
 procedure FreeThenNil(var Obj);
 begin
@@ -529 +622 @@
 procedure OpenFileInShell(FileName: string);
 begin
-  ExecuteProgram('cmd.exe', ['/c', 'start', FileName]);
+  ExecuteProgram('cmd.exe', ['/c', 'start', FileName], []);
 end;