delphi 在线程中运行控制台命令(console)

转载自：https://www.cnblogs.com/lackey/p/10357331.html

在编程开发的时候，我们时常会调用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.

uSimpleConsole

本例程XE8源码下载