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;

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;

finally

L.Free;

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;

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;

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;

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.

https://www.cnblogs.com/lackey/p/10357331.html

推荐分享