delphi 在线程中运行控制台命令(console)
在编程开发的时候，我们时常会调用windows本身的功能，如：检测网络通断，连接无线wifi等。
虽然，用 windows api 操作可以完美地完成这些操作，但是，函数参数太难了。令人望而生畏，不是普通开发者能办到的。
但是，我们可以用一种变通的方法，来解决这个问题，就是使用控制台命令行，如 ping , netsh 等。
我在网络上，搜索到了delphi调用命令行，并返回接收返回的结果（字符串信息）代码，但这些代码仅仅只是功能实现了，离实用性还差一步。
所以做了如下改进：
1.将 cmd 运行进程放入线程中，不放入线程，界面就卡死了，阻塞的，实用性大大降低，可能只能采用运行一次命令，就创建一次cmd进程的方式来实现。
本例的CMD只创建一次，可以复用。
2.提供了明确的执行结果事件，就是命令真正执行完毕的事件，因为返回的结果字符串不是一次性全部返回的，太长的结果是分批次返回的。这一点，但其它的控制台的设备中也是一样的。如路由器的 console 下。
3.实现了 ctrl + c 这类特殊事件的触发，如果没有这个功能，运行 ping 127.0.0.1 -t 就无法正常结束。
经过工作实践中运行，觉得还不错，不敢独享，故分享给大家。也算是 delphi 线程的一个教学实例。
unit uSimpleConsole; interface uses System.Classes, WinApi.Windows, uElegantThread, uSimpleThread, uSimpleList; type TSimpleConsole = class; TConsoleStatus = (ccUnknown, ccInit, ccCmdResult); TOnConsoleStatus = procedure(Sender: TSimpleConsole; AStatus: TConsoleStatus) of object; TInnerConsoleStatus = (iccInit, iccExecCmd, iccSpecEvent, iccWait); PCmdStr = ^TCmdStr; TCmdStr = record Status: TInnerConsoleStatus; CmdStr: string; Event: integer; end; TCmdStrList = class(TSimpleList<PCmdStr>) private function AddCmdStr(ACmdStr: string): PCmdStr; function AddSpecialEvent(AEvent: integer): PCmdStr; protected procedure FreeItem(Item: PCmdStr); override; end; TSimpleConsole = class(TSimpleThread) private FInRead: THandle; // in 用于控制台输入 FInWrite: THandle; FOutRead: THandle; // out 用于控制台输出 FOutWrite: THandle; FFileName: String; FProcessInfo: TProcessInformation; FProcessCreated: Boolean; FCmdStrList: TCmdStrList; FCmdResultStrs: TStringList; FConsoleStatus: TInnerConsoleStatus; procedure Peek; procedure DoPeek; procedure DoCreateProcess; procedure DoExecCmd(ACmdStr: string); function WriteCmd(ACmdStr: string): Boolean; procedure DoOnConsoleStatus(AStatus: TConsoleStatus); procedure ClearCmdResultStrs; procedure AddCmdResultText(AText: string); function CheckCmdResultSign(AText: string): Boolean; public constructor Create(AFileName: string); reintroduce; destructor Destroy; override; procedure StartThread; override; procedure ExecCmd(ACmdStr: String); procedure ExecSpecialEvent(AEvent: integer); // 执行特殊事件，如 ctrl + c property CmdResultStrs: TStringList read FCmdResultStrs; public WorkDir: string; ShowConsoleWindow: Boolean; OnConsoleStatus: TOnConsoleStatus; end; function AttachConsole(dwprocessid: DWORD): BOOL; stdcall external kernel32; implementation uses Vcl.Forms, System.SysUtils, System.StrUtils; { TSimpleConsole } const cnSecAttrLen = sizeof(TSecurityAttributes); procedure TSimpleConsole.AddCmdResultText(AText: string); var L: TStringList; begin L := TStringList.Create; try L.Text := Trim(AText); FCmdResultStrs.AddStrings(L); finally L.Free; end; end; function TSimpleConsole.CheckCmdResultSign(AText: string): Boolean; var L: TStringList; i, n: integer; sTemp: string; begin Result := false; L := TStringList.Create; try L.Text := Trim(AText); for i := L.Count - 1 downto 0 do begin sTemp := Trim(L[i]); n := length(sTemp); if (PosEx(':\', sTemp) = 2) and (PosEx('>', sTemp, 3) >= n) then begin Result := true; exit; end; end; finally L.Free; end; end; procedure TSimpleConsole.ClearCmdResultStrs; begin FCmdResultStrs.Clear; end; constructor TSimpleConsole.Create(AFileName: string); begin inherited Create(true); FFileName := AFileName; FProcessCreated := false; ShowConsoleWindow := false; FCmdResultStrs := TStringList.Create; FCmdStrList := TCmdStrList.Create; end; destructor TSimpleConsole.Destroy; var Ret: integer; begin Ret := 0; if FProcessCreated then begin TerminateProcess(FProcessInfo.hProcess, Ret); closehandle(FInRead); closehandle(FInWrite); closehandle(FOutRead); closehandle(FOutWrite); end; FCmdResultStrs.Free; FCmdStrList.Free; inherited; end; procedure TSimpleConsole.DoCreateProcess; const cnBuffLen = 256; cnReadByteLen = cnBuffLen; cnSecAttrLen = sizeof(TSecurityAttributes); cnStartUpInfoLen = sizeof(TStartupInfo); var sWorkDir: string; LStartupInfo: TStartupInfo; LSecAttr: TSecurityAttributes; sCmd: string; v: integer; begin if length(WorkDir) > 0 then begin sWorkDir := WorkDir; end else begin sWorkDir := ExtractFileDir(Application.ExeName); WorkDir := sWorkDir; end; if ShowConsoleWindow then v := 1 else v := 0; ZeroMemory(@LSecAttr, cnSecAttrLen); LSecAttr.nLength := cnSecAttrLen; LSecAttr.bInheritHandle := true; LSecAttr.lpSecurityDescriptor := nil; CreatePipe(FInRead, FInWrite, @LSecAttr, 0); CreatePipe(FOutRead, FOutWrite, @LSecAttr, 0); ZeroMemory(@LStartupInfo, cnStartUpInfoLen); LStartupInfo.cb := cnStartUpInfoLen; LStartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; LStartupInfo.wShowWindow := v; LStartupInfo.hStdInput := FInRead; // 如果为空，则可以由键盘输入 LStartupInfo.hStdOutput := FOutWrite; // 如果为空,则显示到屏幕上 LStartupInfo.hStdError := FOutWrite; setlength(sCmd, length(FFileName)); CopyMemory(@sCmd[1], @FFileName[1], length(FFileName) * sizeof(char)); if CreateProcess(nil, PChar(sCmd), { pointer to command line string } @LSecAttr, { pointer to process security attributes } @LSecAttr, { pointer to thread security attributes } true, { handle inheritance flag } NORMAL_PRIORITY_CLASS, nil, { pointer to new environment block } PChar(sWorkDir), { pointer to current directory name, PChar } LStartupInfo, { pointer to STARTUPINFO } FProcessInfo) { pointer to PROCESS_INF } then begin // ClearCmdResultStrs; // FInnerConsoleList.AddInerStatus(iccInit); end else begin DoOnStatusMsg('进程[' + FFileName + ']创建失败'); end; end; procedure TSimpleConsole.DoExecCmd(ACmdStr: string); var sCmdStr: string; begin sCmdStr := ACmdStr + #13#10; if WriteCmd(sCmdStr) then begin // FInnerConsoleList.AddCmdStr(iccExecCmd); // Peek end else begin DoOnStatusMsg('执行:[' + ACmdStr + ']失败'); end; end; procedure TSimpleConsole.DoOnConsoleStatus(AStatus: TConsoleStatus); begin if Assigned(OnConsoleStatus) then OnConsoleStatus(self, AStatus); end; procedure TSimpleConsole.DoPeek; var strBuff: array [0 .. 255] of AnsiChar; nBytesRead: cardinal; sOutStr: string; sOut: AnsiString; nOut: cardinal; BPeek: Boolean; p: PCmdStr; begin if not FProcessCreated then begin FConsoleStatus := iccInit; DoCreateProcess; FProcessCreated := true; end; sOutStr := ''; nBytesRead := 0; nOut := 0; sOut := ''; BPeek := PeekNamedPipe(FOutRead, @strBuff, 256, @nBytesRead, nil, nil); while BPeek and (nBytesRead > 0) do begin inc(nOut, nBytesRead); setlength(sOut, nOut); CopyMemory(@sOut[nOut - nBytesRead + 1], @strBuff[0], nBytesRead); ReadFile(FOutRead, strBuff[0], nBytesRead, nBytesRead, nil); BPeek := PeekNamedPipe(FOutRead, @strBuff, 256, @nBytesRead, nil, nil); end; if length(sOut) > 0 then begin sOutStr := String(sOut); DoOnStatusMsg(sOutStr); if CheckCmdResultSign(sOutStr) then begin if FConsoleStatus = iccInit then begin DoOnConsoleStatus(ccInit) end else if FConsoleStatus = iccExecCmd then begin AddCmdResultText(sOutStr); DoOnConsoleStatus(ccCmdResult) end else DoOnConsoleStatus(ccUnknown); ClearCmdResultStrs; end; end; FCmdStrList.Lock; try p := FCmdStrList.PopFirst; if Assigned(p) then begin FConsoleStatus := iccExecCmd; if p.Status = iccExecCmd then DoExecCmd(p.CmdStr) else if p.Status = iccSpecEvent then begin AttachConsole(self.FProcessInfo.dwprocessid); SetConsoleCtrlHandler(nil, true); GenerateConsoleCtrlEvent(p.Event, 0); end; dispose(p); end; finally FCmdStrList.Unlock; end; Peek; SleepExceptStopped(200); end; procedure TSimpleConsole.ExecCmd(ACmdStr: String); begin FCmdStrList.Lock; try FCmdStrList.AddCmdStr(ACmdStr); finally FCmdStrList.Unlock; end; Peek; end; procedure TSimpleConsole.Peek; begin ExeProcInThread(DoPeek); end; procedure TSimpleConsole.ExecSpecialEvent(AEvent: integer); begin FCmdStrList.Lock; try FCmdStrList.AddSpecialEvent(AEvent); finally FCmdStrList.Unlock; end; Peek; end; procedure TSimpleConsole.StartThread; begin inherited; Peek; end; function TSimpleConsole.WriteCmd(ACmdStr: string): Boolean; var nCmdLen: cardinal; nRetBytes: cardinal; sCmdStr: AnsiString; begin nCmdLen := length(ACmdStr); sCmdStr := AnsiString(ACmdStr); Result := WriteFile(FInWrite, sCmdStr[1], (nCmdLen), nRetBytes, nil); end; { TInnerStatusList } function TCmdStrList.AddCmdStr(ACmdStr: string): PCmdStr; begin New(Result); Add(Result); Result.Status := iccExecCmd; Result.CmdStr := ACmdStr; end; function TCmdStrList.AddSpecialEvent(AEvent: integer): PCmdStr; begin New(Result); Add(Result); Result.Status := iccSpecEvent; Result.Event := AEvent; end; procedure TCmdStrList.FreeItem(Item: PCmdStr); begin inherited; dispose(Item); end; end.
