Changeset 578
- Timestamp:
- Aug 23, 2024, 7:14:23 PM (2 months ago)
- Location:
- Common
- Files:
-
- 2 added
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/Common.pas
r577 r578 55 55 function EndsWith(Text, What: string): Boolean; 56 56 function Explode(Separator: Char; Data: string): TStringArray; 57 procedure ExecuteProgram(Executable: string; Parameters: array of string); 57 procedure ExecuteProgram(Executable: string; Parameters: array of string; 58 Environment: array of string; CurrentDirectory: string = ''); 59 procedure ExecuteProgramOutput(Executable: string; Parameters: array of string; 60 Environment: array of string; out Output, Error: string; 61 out ExitCode: Integer; CurrentDirectory: string = ''); 58 62 procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog); 59 63 procedure FreeThenNil(var Obj); … … 63 67 function GetBit(Variable: QWord; Index: Byte): Boolean; 64 68 function GetStringPart(var Text: string; Separator: string): string; 69 function GetEnvironmentVariables: TStringArray; 65 70 function GenerateNewName(OldName: string): string; 66 71 function GetFileFilterItemExt(Filter: string; Index: Integer): string; 67 72 function IntToBin(Data: Int64; Count: Byte): string; 68 function Implode(Separator: string; List: TList<string>): string; 69 function Implode(Separator: string; List: TStringList; Around: string = ''): string; 73 function Implode(Separator: string; List: TList<string>): string; overload; 74 function Implode(Separator: string; List: array of string): string; overload; 75 function Implode(Separator: string; List: TStringList; Around: string = ''): string; overload; 70 76 function LastPos(const SubStr: String; const S: String): Integer; 71 77 function LoadFileToStr(const FileName: TFileName): AnsiString; … … 98 104 implementation 99 105 106 resourcestring 107 SExecutionError = 'Excution error: %s (exit code: %d)'; 108 100 109 function StartsWith(Text, What: string): Boolean; 101 110 begin … … 108 117 end; 109 118 110 function BinToInt(BinStr : string): Int64;111 var 112 i : byte;113 RetVar 119 function BinToInt(BinStr: string): Int64; 120 var 121 I: Byte; 122 RetVar: Int64; 114 123 begin 115 124 BinStr := UpperCase(BinStr); 116 if BinStr[length(BinStr)] = 'B' then Delete(BinStr, length(BinStr),1);125 if BinStr[length(BinStr)] = 'B' then Delete(BinStr, Length(BinStr), 1); 117 126 RetVar := 0; 118 for i := 1 to length(BinStr) do begin119 if not (BinStr[ i] in ['0','1']) then begin127 for I := 1 to Length(BinStr) do begin 128 if not (BinStr[I] in ['0','1']) then begin 120 129 RetVar := 0; 121 130 Break; 122 131 end; 123 RetVar := (RetVar shl 1) + ( byte(BinStr[i]) and 1);132 RetVar := (RetVar shl 1) + (Byte(BinStr[I]) and 1); 124 133 end; 125 134 … … 136 145 end; 137 146 end; 138 139 147 140 148 procedure DeleteFiles(APath, AFileSpec: string); … … 154 162 FindClose(SearchRec); 155 163 end; 156 157 164 158 165 function GetFileFilterItemExt(Filter: string; Index: Integer): string; … … 177 184 if FileExt <> '.*' then 178 185 FileDialog.FileName := ChangeFileExt(FileDialog.FileName, FileExt) 186 end; 187 188 function GetEnvironmentVariables: TStringArray; 189 var 190 I: Integer; 191 begin 192 SetLength(Result, GetEnvironmentVariableCount); 193 for I := 0 to GetEnvironmentVariableCount - 1 do 194 Result[I] := GetEnvironmentString(I); 179 195 end; 180 196 … … 219 235 end;*) 220 236 237 function Implode(Separator: string; List: array of string): string; 238 var 239 I: Integer; 240 begin 241 Result := ''; 242 for I := 0 to Length(List) - 1 do begin 243 Result := Result + List[I]; 244 if I < Length(List) - 1 then Result := Result + Separator; 245 end; 246 end; 247 221 248 function Implode(Separator: string; List: TStringList; Around: string = ''): string; 222 249 var … … 494 521 end; 495 522 496 procedure ExecuteProgram(Executable: string; Parameters: array of string); 523 procedure ExecuteProgram(Executable: string; Parameters: array of string; 524 Environment: array of string; CurrentDirectory: string = ''); 497 525 var 498 526 Process: TProcess; 499 527 I: Integer; 500 528 begin 529 Process := TProcess.Create(nil); 501 530 try 502 Process := TProcess.Create(nil);503 531 Process.Executable := Executable; 504 532 for I := 0 to Length(Parameters) - 1 do 505 533 Process.Parameters.Add(Parameters[I]); 534 for I := 0 to Length(Environment) - 1 do 535 Process.Environment.Add(Environment[I]); 536 Process.CurrentDirectory := CurrentDirectory; 537 Process.ShowWindow := swoHIDE; 506 538 Process.Options := [poNoConsole]; 507 539 Process.Execute; … … 511 543 end; 512 544 545 procedure ExecuteProgramOutput(Executable: string; Parameters: array of string; 546 Environment: array of string; out Output, Error: string; out ExitCode: Integer; 547 CurrentDirectory: string); 548 var 549 Process: TProcess; 550 I: Integer; 551 ReadCount: Integer; 552 Buffer: string; 553 const 554 BufferSize = 1000; 555 begin 556 Process := TProcess.Create(nil); 557 try 558 Process.Executable := Executable; 559 for I := 0 to Length(Parameters) - 1 do 560 Process.Parameters.Add(Parameters[I]); 561 for I := 0 to Length(Environment) - 1 do 562 Process.Environment.Add(Environment[I]); 563 Process.CurrentDirectory := CurrentDirectory; 564 Process.ShowWindow := swoHIDE; 565 Process.Options := [poNoConsole, poUsePipes]; 566 Process.Execute; 567 568 Output := ''; 569 Error := ''; 570 Buffer := ''; 571 SetLength(Buffer, BufferSize); 572 while Process.Running do begin 573 if Process.Output.NumBytesAvailable > 0 then begin 574 ReadCount := Process.Output.Read(Buffer[1], Length(Buffer)); 575 Output := Output + Copy(Buffer, 1, ReadCount); 576 end; 577 578 if Process.Stderr.NumBytesAvailable > 0 then begin 579 ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer)); 580 Error := Error + Copy(Buffer, 1, ReadCount) 581 end; 582 583 Sleep(10); 584 end; 585 586 if Process.Output.NumBytesAvailable > 0 then begin 587 ReadCount := Process.Output.Read(Buffer[1], Length(Buffer)); 588 Output := Output + Copy(Buffer, 1, ReadCount); 589 end; 590 591 if Process.Stderr.NumBytesAvailable > 0 then begin 592 ReadCount := Process.Stderr.Read(Buffer[1], Length(Buffer)); 593 Error := Error + Copy(Buffer, 1, ReadCount); 594 end; 595 596 ExitCode := Process.ExitCode; 597 598 if (ExitCode <> 0) or (Error <> '') then 599 raise Exception.Create(Format(SExecutionError, [Output + Error, ExitCode])); 600 finally 601 Process.Free; 602 end; 603 end; 604 513 605 procedure FreeThenNil(var Obj); 514 606 begin … … 529 621 procedure OpenFileInShell(FileName: string); 530 622 begin 531 ExecuteProgram('cmd.exe', ['/c', 'start', FileName] );623 ExecuteProgram('cmd.exe', ['/c', 'start', FileName], []); 532 624 end; 533 625 -
Common/PersistentForm.pas
r577 r578 336 336 end; 337 337 Form.OnWindowStateChange := OldHandler; 338 FormFullScreen := True; 338 339 {$ENDIF} 339 340 end else begin
Note:
See TracChangeset
for help on using the changeset viewer.