一个可以不断执行命令、能读取命令输出而且隐藏的DELPHI CONSOLE类

 

  1 unit uConsole;
  2  
  3 interface
  4  
  5 uses
  6   System.Classes;
  7  
  8 type
  9   IConsole = interface['{3151E6A8-FCDC-474A-8403-794BF25826BF}']
 10     function GetOutputText: TStringList;
 11     function GetErrorText : TStringList;
 12     function ExecCmd(Cmd: String; WaitFinished: Boolean = True): Boolean;
 13     property OutputText: TStringList read GetOutputText;
 14     property ErrorText : TStringList read GetErrorText;
 15   end;
 16  
 17   TiConsole = class
 18     class function Create: IConsole;
 19   end;
 20  
 21 implementation
 22  
 23 uses
 24   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
 25   Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
 26   Vcl.ExtCtrls, Vcl.ComCtrls, System.SyncObjs;
 27  
 28 type
 29   TConsoleThread = class(TThread)  //Cmd控制台输入输出监控线程
 30   private
 31     Creator: TObject;
 32   protected
 33     procedure Execute; override;
 34   public
 35     constructor Create(aCreator: TObject); overload;
 36   end;
 37  
 38   TConsole = class(TInterfacedObject, IConsole) //cmd控制台
 39   private
 40     FinishEvent: TSimpleEvent;
 41     ConsoleThread: TConsoleThread;
 42     ProcessInfo: TProcessInformation;
 43     InputPipeRead , InputPipeWrite : THandle;
 44     OutputPipeRead, OutputPipeWrite: THandle;
 45     ErrorPipeRead , ErrorPipeWrite : THandle;
 46     procedure WritePipe(Pipe: THandle; Cmd: String);
 47     function  ReadPipe(Pipe: THandle; var BytesRemain: Integer): AnsiString;
 48   protected
 49     FOutputText, FErrorText: TStringList;
 50     function GetOutputText: TStringList;
 51     function GetErrorText : TStringList;
 52   public
 53     constructor Create;
 54     destructor Destroy; override;
 55     property OutputText: TStringList read GetOutputText;
 56     property ErrorText : TStringList read GetErrorText;
 57     function ExecCmd(Cmd: String; WaitFinished: Boolean = False): Boolean;
 58   end;
 59  
 60 class function TiConsole.Create: IConsole;
 61 begin
 62   Result := TConsole.Create;
 63 end;
 64  
 65 constructor TConsole.Create;
 66 var
 67   CmdApp  : String;
 68   CmdSize : Integer;
 69   Security: TSecurityAttributes;
 70   Start   : TStartUpInfo;
 71 begin
 72   inherited Create;
 73  
 74   // 取Cmd控制台的COMSPEC环境变量的路径
 75   SetLength(CmdApp, 255);
 76   CmdSize := GetEnvironmentVariable('COMSPEC', @CmdApp[1], 255);
 77   SetLength(CmdApp, CmdSize);
 78  
 79   //建立管道
 80   with Security do
 81   begin
 82     nLength := SizeOf(TSecurityAttributes) ;
 83     bInheritHandle := True;
 84     lpSecurityDescriptor := nil;
 85   end;
 86   CreatePipe(InputPipeRead , InputPipeWrite , @Security, 0);
 87   CreatePipe(OutputPipeRead, OutputPipeWrite, @Security, 0);
 88   CreatePipe(ErrorPipeRead , ErrorPipeWrite , @Security, 0);
 89  
 90   //启动一个隐藏的、输入输出被重定向的Cmd控制台
 91   FillChar(Start, Sizeof(Start), #0) ;
 92   Start.cb := SizeOf(Start) ;
 93   Start.hStdInput := InputPipeRead;
 94   Start.hStdOutput:= OutputPipeWrite;
 95   Start.hStdError := ErrorPipeWrite;
 96   Start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
 97   Start.wShowWindow := SW_HIDE;
 98   CreateProcess(nil, PChar(CmdApp), @Security, @Security, True,
 99       CREATE_NEW_CONSOLE or SYNCHRONIZE, nil, nil, Start, ProcessInfo);
100  
101   //OutputText和ErrorText是屏幕输出或错误信息输出
102   FOutputText := TStringList.Create;
103   FErrorText  := TStringList.Create;
104  
105   FinishEvent := TSimpleEvent.Create; //生成简单同步事件
106   FinishEvent.ResetEvent;
107  
108   ConsoleThread := TConsoleThread.Create(Self); //生成线程、并自动启动
109   while FinishEvent.WaitFor(40) = wrTimeout do  //等待cmd控制台准备完毕
110     Application.ProcessMessages;
111 end;
112  
113 destructor TConsole.Destroy;
114 begin
115   ConsoleThread.Terminate;
116   WritePipe(InputPipeWrite, 'EXIT'); // 关闭Cmd控制台
117   CloseHandle(ProcessInfo.hProcess);
118   CloseHandle(ProcessInfo.hThread );
119   CloseHandle(InputPipeRead  );
120   CloseHandle(InputPipeWrite );
121   CloseHandle(OutputPipeRead );
122   CloseHandle(OutputPipeWrite);
123   CloseHandle(ErrorPipeRead  );
124   CloseHandle(ErrorPipeWrite );
125   FinishEvent.Free;
126   OutputText.Free;
127   ErrorText.Free;
128   inherited Destroy;
129 end;
130  
131 function TConsole.ExecCmd(Cmd: String; WaitFinished: Boolean = False): Boolean;
132 begin
133   FOutputText.Clear;
134   FErrorText.Clear;
135   if (UpperCase(Trim(Cmd)) <> 'EXIT') then
136   begin
137     FinishEvent.ResetEvent;
138     WritePipe(InputPipeWrite, Cmd); //运行命令CmdStr
139  
140     if WaitFinished then  //等待Cmd控制台命令运行完毕
141       FinishEvent.WaitFor(INFINITE)
142     else
143     begin
144       while FinishEvent.WaitFor(40) = wrTimeout do
145         Application.ProcessMessages; //非阻塞式
146     end;
147   end;
148  
149   if FErrorText.Count = 0 then
150     Result := True
151   else
152     Result := False;
153 end;
154  
155 function TConsole.GetOutputText: TStringList;
156 begin
157   Result := FOutputText;
158 end;
159  
160 function TConsole.GetErrorText : TStringList;
161 begin
162   Result := FErrorText;
163 end;
164  
165 procedure TConsole.WritePipe(Pipe: THandle; Cmd: String);
166 var  //将命令写入到输入管道
167   BytesWritten: DWord;
168   AnsiBuf: AnsiString;
169 begin
170 //命令字符串是Ansi字符串，Cmd输入需要回车符CR/LF；
171   AnsiBuf := AnsiString(Cmd + #13#10);
172   WriteFile(Pipe, AnsiBuf[1], Length(AnsiBuf), BytesWritten, nil);
173 end;
174  
175 function TConsole.ReadPipe(Pipe: THandle; var BytesRemain: Integer): AnsiString;
176   //通过管道读取Cmd控制台的输出，BytesRemain为未读的字节数
177 var
178   TextBuffer: array[1..32767] of AnsiChar;
179   BytesRead : LongWord;
180   PipeSize  : Cardinal;
181 begin
182   Result := '';
183   PipeSize := Sizeof(TextBuffer);
184   //检查管道是否有东西可读
185   PeekNamedPipe(Pipe, nil, PipeSize, @BytesRead, @PipeSize, @BytesRemain);
186   if BytesRead > 0 then
187   begin
188     ReadFile(Pipe, TextBuffer, PipeSize, BytesRead, nil);
189     Result := AnsiString(TextBuffer); //TextBuffer内含的是AnsiString字符串
190     SetLength(Result, BytesRead);
191   end;
192 end;
193  
194  
195 //-------------------------读屏幕输出的线程-------------------------------------
196  
197 constructor TConsoleThread.Create(aCreator: TObject);
198 begin
199   Creator := aCreator;
200   inherited Create(False);  //生成线程、并自动启动线程
201   FreeOnTerminate := True; //线程结束后自动释放线程对象
202   Priority := tpHigher;
203 end;
204  
205 procedure TConsoleThread.Execute;
206 {监视Cmd控制台的输出：每40毫秒读出一次错误管道和输出管道的信息}
207 var
208   Console: TConsole;
209   I, Len, BeginPos, BytesRemain: Integer;
210   LastStr, OutputStr, ErrorStr: AnsiString;
211 begin
212   Console := TConsole(Creator);
213   while not Terminated do
214   begin
215     //读入错误管道和正常管道的信息.
216     OutputStr := OutputStr + Console.ReadPipe(Console.OutputPipeRead, BytesRemain);
217     ErrorStr  := ErrorStr  + Console.ReadPipe(Console.ErrorPipeRead , BytesRemain);
218     if (OutputStr <> '') then
219     begin
220       BeginPos := 0;
221       for I := 1 to Length(OutputStr)-1 do
222         if (OutputStr[I] = #13) and (OutputStr[I+1] = #10) then BeginPos := I+2;
223       if (BeginPos = 0) then
224         LastStr := OutputStr
225       else
226         LastStr := Copy(OutputStr, BeginPos, Length(OutputStr)-BeginPos+1);
227  
228       Len := Length(LastStr);
229       if (Len >= 4) and (LastStr[1] in ['A'..'Z']) and
230          (LastStr[2] = ':') and (LastStr[3] = '\') and (LastStr[Len] = '>') then
231       begin  //控制台命令运行结束后，最后一行显示的都是类似于C:\folder>的字符串
232         Console.FOutputText.Text := String(OutputStr);
233         Console.FErrorText.Text  := String(ErrorStr );
234         OutputStr := '';
235         ErrorStr  := '';
236         Console.FinishEvent.SetEvent; //设置Cmd控制台命令运行完毕的事件
237       end;
238     end;
239     Sleep(40); //每40毫秒读一次
240   end;
241 end;
242  
243 end.

示例

 1 unit Unit1;
 2  
 3 interface
 4  
 5 uses
 6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
 7   System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
 8   Vcl.StdCtrls, uConsole;
 9  
10 type
11   TForm1 = class(TForm)
12     Edit1: TEdit;
13     Memo1: TMemo;
14     Label1: TLabel;
15     Label2: TLabel;
16     Button1: TButton;
17     procedure FormCreate(Sender: TObject);
18     procedure Button1Click(Sender: TObject);
19   private
20     Console: IConsole;
21   public
22     { Public declarations }
23   end;
24  
25 var
26   Form1: TForm1;
27  
28 implementation
29  
30 {$R *.dfm}
31  
32 procedure TForm1.FormCreate(Sender: TObject);
33 begin
34   Console := TiConsole.Create;
35   Button1.OnClick := Button1Click;
36 end;
37  
38 procedure TForm1.Button1Click(Sender: TObject);
39 begin
40   Console.ExecCmd(Edit1.Text);
41   Memo1.Lines.Text := Console.OutputText.Text;
42 end;
43  
44 end.

 

posted @ 2021-04-19 02:48  一梦五千年  阅读(284)  评论(0)    收藏  举报