source: trunk/Forms/FormConsole.pas

Last change on this file was 24, checked in by chronos, 12 days ago
  • Fixed: Test cases executed with FormTests form from Common package.
File size: 3.8 KB
Line 
1unit FormConsole;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
7 ExtCtrls, Process;
8
9type
10
11 { TFormConsole }
12
13 TFormConsole = class(TForm)
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 EnvironmentVariables.Free;
53 Log.Free;
54 Parameters.Free;
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 Text := '';
92 try
93 Process := TProcess.Create(nil);
94 Aborted := False;
95 ButtonAbort.Enabled := True;
96 Log.Clear;
97 Memo1.Clear;
98 if WorkingDir <> '' then
99 Process.CurrentDirectory := WorkingDir;
100 Process.Environment.Assign(EnvironmentVariables);
101 Process.Parameters.Assign(Parameters);
102 Process.Executable := Executable;
103 CommandLine := Executable + ' ' + StringReplace(Parameters.Text, LineEnding, ' ', [rfReplaceAll]);
104 if CommandLine[Length(CommandLine)] = LineEnding then
105 SetLength(CommandLine, Length(CommandLine) - 1);
106 EditCommand.Text := CommandLine;
107 Process.Options := [poUsePipes, poNoConsole];
108 Process.Execute;
109 Application.ProcessMessages;
110 while Process.Running or (Process.Output.NumBytesAvailable > 0) or
111 (Process.Stderr.NumBytesAvailable > 0) do
112 begin
113 if Process.Output.NumBytesAvailable > 0 then begin
114 SetLength(Buffer, 1000);
115 Count := Process.Output.Read(Buffer[1], Length(Buffer));
116 SetLength(Buffer, Count);
117 Text := Text + Buffer;
118 while Pos(LineEnding, Text) > 0 do begin
119 Line := Copy(Text, 1, Pos(LineEnding, Text) - 1);
120 Delete(Text, 1, Length(Line) + Length(LineEnding));
121 if Visible then Memo1.Lines.Add(Line);
122 Log.Add(Line);
123 end;
124 end;
125
126 if Process.Stderr.NumBytesAvailable > 0 then begin
127 SetLength(Buffer, 1000);
128 Count := Process.Stderr.Read(Buffer[1], Length(Buffer));
129 SetLength(Buffer, Count);
130 Text := Text + Buffer;
131 while Pos(LineEnding, Text) > 0 do begin
132 Line := Copy(Text, 1, Pos(LineEnding, Text) - 1);
133 Delete(Text, 1, Length(Line) + Length(LineEnding));
134 if Visible then Memo1.Lines.Add(Line);
135 Log.Add(Line);
136 end;
137 end;
138 Sleep(10);
139 Application.ProcessMessages;
140 end;
141 finally
142 if Visible then Memo1.Lines.Add(Text);
143 Log.Add(Text);
144 FreeAndNil(Process);
145 end;
146 ButtonAbort.Enabled := False;
147 //ModalResult := mrOK;
148 //Close;
149end;
150
151end.
152
Note: See TracBrowser for help on using the repository browser.