source: trunk/Forms/FormConsole.pas

Last change on this file was 158, checked in by chronos, 3 months ago
  • Fixed: New lines symbols were not recognized on Windows in Console form.
File size: 4.0 KB
Line 
1unit FormConsole;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
7 ExtCtrls, Process, FormEx;
8
9type
10
11 { TFormConsole }
12
13 TFormConsole = class(TFormEx)
14 ButtonAbort: TButton;
15 EditCommand: TEdit;
16 Memo1: TMemo;
17 Timer1: TTimer;
18 procedure ButtonAbortClick(Sender: TObject);
19 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
20 procedure FormCreate(Sender: TObject);
21 procedure FormDestroy(Sender: TObject);
22 procedure FormShow(Sender: TObject);
23 procedure Timer1Timer(Sender: TObject);
24 private
25 Process: TProcess;
26 public
27 Executable: string;
28 Parameters: TStringList;
29 WorkingDir: string;
30 EnvironmentVariables: TStringList;
31 Aborted: Boolean;
32 Log: TStringList;
33 procedure Perform;
34 end;
35
36
37implementation
38
39{$R *.lfm}
40
41{ TFormConsole }
42
43procedure TFormConsole.FormCreate(Sender: TObject);
44begin
45 Parameters := TStringList.Create;
46 Log := TStringList.Create;
47 EnvironmentVariables := TStringList.Create;
48end;
49
50procedure TFormConsole.FormDestroy(Sender: TObject);
51begin
52 FreeAndNil(EnvironmentVariables);
53 FreeAndNil(Log);
54 FreeAndNil(Parameters);
55end;
56
57procedure TFormConsole.FormShow(Sender: TObject);
58begin
59 ButtonAbort.Enabled := False;
60 Timer1.Enabled := True;
61end;
62
63procedure TFormConsole.Timer1Timer(Sender: TObject);
64begin
65 Timer1.Enabled := False;
66 Perform;
67end;
68
69procedure TFormConsole.ButtonAbortClick(Sender: TObject);
70begin
71 if Assigned(Process) then begin
72 Aborted := True;
73 Process.Terminate(0);
74 end;
75end;
76
77procedure TFormConsole.FormClose(Sender: TObject; var CloseAction: TCloseAction
78 );
79begin
80 ButtonAbort.Click;
81end;
82
83procedure TFormConsole.Perform;
84var
85 Buffer: string;
86 Count: Integer;
87 Text: string;
88 Line: string;
89 CommandLine: string;
90begin
91 Buffer := '';
92 Text := '';
93 try
94 Process := TProcess.Create(nil);
95 Aborted := False;
96 ButtonAbort.Enabled := True;
97 Log.Clear;
98 Memo1.Clear;
99 if WorkingDir <> '' then
100 Process.CurrentDirectory := WorkingDir;
101 Process.Environment.Assign(EnvironmentVariables);
102 Process.Parameters.Assign(Parameters);
103 Process.Executable := Executable;
104 CommandLine := Executable + ' ' + StringReplace(Parameters.Text, LineEnding,
105 ' ', [rfReplaceAll]);
106 if CommandLine[Length(CommandLine)] = LineEnding then
107 SetLength(CommandLine, Length(CommandLine) - 1);
108 EditCommand.Text := CommandLine;
109 Process.Options := [poUsePipes, poNoConsole];
110 Process.Execute;
111 Application.ProcessMessages;
112 while Process.Running or (Process.Output.NumBytesAvailable > 0) or
113 (Process.Stderr.NumBytesAvailable > 0) do
114 begin
115 if Process.Output.NumBytesAvailable > 0 then begin
116 SetLength(Buffer, 1000);
117 Count := Process.Output.Read(Buffer[1], Length(Buffer));
118 SetLength(Buffer, Count);
119 Text := Text + Buffer;
120 Text := StringReplace(Text, #10#13, LineEnding, [rfReplaceAll]);
121 while Pos(LineEnding, Text) > 0 do begin
122 Line := Copy(Text, 1, Pos(LineEnding, Text) - 1);
123 Delete(Text, 1, Length(Line) + Length(LineEnding));
124 if Visible then Memo1.Lines.Add(Line);
125 Log.Add(Line);
126 end;
127 end;
128
129 if Process.Stderr.NumBytesAvailable > 0 then begin
130 SetLength(Buffer, 1000);
131 Count := Process.Stderr.Read(Buffer[1], Length(Buffer));
132 SetLength(Buffer, Count);
133 Text := Text + Buffer;
134 Text := StringReplace(Text, #10#13, LineEnding, [rfReplaceAll]);
135 while Pos(LineEnding, Text) > 0 do begin
136 Line := Copy(Text, 1, Pos(LineEnding, Text) - 1);
137 Delete(Text, 1, Length(Line) + Length(LineEnding));
138 if Visible then Memo1.Lines.Add(Line);
139 Log.Add(Line);
140 end;
141 end;
142 Sleep(10);
143 Application.ProcessMessages;
144 end;
145 finally
146 if Visible then Memo1.Lines.Add(Text);
147 Log.Add(Text);
148 FreeAndNil(Process);
149 end;
150 ButtonAbort.Enabled := False;
151 //ModalResult := mrOK;
152 //Close;
153end;
154
155end.
156
Note: See TracBrowser for help on using the repository browser.