捕获 Unicode 命令行输出

Question

我有一个程序可以捕获隐藏的命令提示符窗口并在

TMemo

中显示输出。这是在互联网和 Stack Overflow 上发布的相同/相似的代码：

var
  Form1: TForm1;
  commandline,workdir:string;

implementation

{$R *.dfm}

procedure GetDosOutput;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255000] of AnsiChar;
  BytesRead: Cardinal;
  Handle: Boolean;
  thisline,tmpline,lastline:string;
  commandstartms:int64;
  p1,p2:integer;
begin
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    lastline:='';

    Handle := CreateProcess(nil, PWideChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PWideChar(WorkDir), SI, PI);

    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255000, BytesRead, nil);
          if BytesRead>0 then
          begin
            Buffer[BytesRead]:=#0;
            Form1.CommandMemo.Lines.BeginUpdate;
            thisline:=string(buffer);

            Form1.CommandMemo.text:=Form1.CommandMemo.text+thisline;

            //auto-scroll to end of memo
            SendMessage(Form1.CommandMemo.Handle, EM_LINESCROLL, 0,Form1.CommandMemo.Lines.Count-1);
            Form1.CommandMemo.Lines.EndUpdate;
          end;
        until not WasOK or (BytesRead = 0);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     commandline:='tree c:';
     workdir:='c:\';
     GetDosOutput;
end;

对于任何 ASCII 输出都可以按预期工作，但不支持 Unicode 字符。

当

tree

命令运行时，它通常会显示如下字符：

│   │   │   │   │   ├───

...但备忘录显示：

³   ³           ³   ÃÄÄÄ

我尝试将缓冲区从

AnsiChar

更改为

Char

，这确实会在备忘录中显示 Unicode，但这些只是损坏的 Unicode 字符，而不是命令行显示的内容：

††††‱楦敬猨
潭敶⹤਍††††‱楦敬猨
潭敶⹤਍䕈䑁椠⁳潮⁷瑡〠捣攰ㅥ⁢敍杲⁥異汬爠煥敵瑳⌠㤷㔴映潲⵷ⵥ⽷楦⵸浩条ⵥ潤湷捳污੥汁敲摡⁹灵琠慤整ਮㅥ⁢敍杲⁥異汬爠煥敵††††‱楦敬猨
潭敶⹤਍††††‱楦敬猨
潭敶⹤਍⵷ⵥ⽷楦⵸浩条ⵥ潤湷捳污੥

任何人都可以帮助调整该代码以支持命令行使用 Unicode 字符的时间吗？我已经搞砸了几个小时了，现在正在尝试下面的建议，但没有一个能够在备忘录中正确显示树输出。任何人都可以在此处修复我的示例代码或发布适用于 D11 的代码吗？

对于遇到此问题的其他人，解决方法是选中“使用 Unicode UTF-8 获得全球语言支持”复选框，如此处所示。在命令提示符/Windows Powershell (Windows 10) 中使用 UTF-8 编码 (CHCP 65001) 无需更改代码。上面的代码现在可以从捕获的命令提示符输出中正确显示 unicode 字符。

Answer 1

它适用于我在 Windows 7 中使用 Delphi 7，给出以下输出：

...
El día de la bestia (1995)
Jo Nesbø's Headhunters - Hodejegerne (2011)
Léon (Directors Cut) (1994)
Sånger från andra våningen - Songs from the Second Floor (2000)
دختری در شب تنها به خانه می‌رود - A Girl Walks Home Alone at Night (2014)
アウトレイジ ビヨンド - Outrage - Beyond (2012)
アキレスと亀 - Achilles and the Tortoise (2008)
葉問3 - Ip Man 3 (2015)
賽德克•巴萊 - Warriors of the Rainbow - Seediq Bale (2011)
살인의 추억 - Memories of Murder (2003)
신세계 - New World (2013)
...

我的主要区别是：

• Delphi 7 仍然默认为 ANSI 而不是 WIDE，因此我必须使用

  Widestring

  和

  PWideChar

  。现在的 Delphi 版本默认为 Unicode，所以这将是

  String

  和

  PChar

• 出于同样的原因，必须调用 WIDE 函数（以

  W

  结尾）。
• 我执行

  cmd.exe /U

  ，因为按照其手册启用 Unicode 管道。
• 也制作了

  WideChar

  的缓冲区，而不是仅将其放入字节（

  AnsiChar

  ）。对于现在的 Delphi 版本，您应该将其简单地声明为

  Char

  。 这很可能是你的错。
• 实际寻找可能出现的错误。

function StringToWideString
( p: PAnsiChar  // Source to convert
; iLenSrc: Integer  // Source's length
; iSrcCodePage: DWord= CP_UTF8  // Source codepage
): WideString;  // Target is UTF-16
var
  iLenDest: Integer;
begin
  iLenDest:= MultiByteToWideChar( iSrcCodePage, 0, p, iLenSrc, nil, 0 );
  SetLength( result, iLenDest );
  if iLenDest> 0 then  // Otherwise we get ERROR_INVALID_PARAMETER
  if MultiByteToWideChar( iSrcCodePage, 0, p, iLenSrc, PWideChar(result), iLenDest )= 0 then begin
    result:= '';
  end;
end;

function GetCmdOutput
( sCmd: Widestring  // Command line for process creation
; out sOut: Widestring  // Expected console output
; bExpectUtf8: Boolean  // Does the text make no sense? Then set this to TRUE.
): Word;  // Flag wise error indicator
const
  BUFLEN= $50000;  // 50* 1024= 51200
var
  vSA: TSecurityAttributes;  // For pipe creation
  vSI: TStartupInfo;  // To indicate pipe usage
  vPI: TProcessInformation;  // To later close handles
  hRead, hWrite: THandle;  // Pipe
  bRead: Boolean;  // Was ReadFile() successful?
  iRead: Cardinal;  // How many bytes were read by ReadFile()?
  pWide, pCmd: PWideChar;  // Read buffer in UTF-16; Command line for process creation
  pAnsi: PAnsiChar;  // Read buffer in UTF-8
  pBuf: Pointer;  // Read buffer in general, either ANSI or WIDE
label
  Finish;
begin
  // No error occurred yet, no output so far
  result:= 0;
  sOut:= '';

  // Creating 1 pipe with 2 handles: one for reading, other for writing
  vSA.nLength:= SizeOf( vSA );
  vSA.bInheritHandle:= TRUE;
  vSA.lpSecurityDescriptor:= nil;
  if not CreatePipe( hRead, hWrite, @vSA, 0 ) then begin
    result:= $01;  // GetLastError() for more details
    exit;
  end;

  // Prepare pipe usage when creating process
  FillChar( vSI, SizeOf( vSI ), 0 );
  vSI.cb:= SizeOf( vSI );
  vSI.dwFlags:= STARTF_USESTDHANDLES;
  vSI.hStdInput:= GetStdHandle( STD_INPUT_HANDLE );
  if vSI.hStdInput= INVALID_HANDLE_VALUE then begin
    result:= $02;  // GetLastError() for more details
    goto Finish;
  end;
  vSI.hStdOutput:= hWrite;
  vSI.hStdError:= hWrite;

  // Create process via command line only
  sCmd:= sCmd+ #0;  // PWideChar must be NULL terminated
  GetMem( pCmd, 32000 );  // CreateProcessW() expects a writable parameter
  CopyMemory( @pCmd[0], @sCmd[1], Length( sCmd )* 2 );  // Copy bytes from Widestring to PWideChar
  if not CreateProcessW( nil, pCmd, nil, nil, TRUE, 0, nil, nil, vSI, vPI ) then begin
    result:= $04;  // GetLastError() for more details
    goto Finish;
  end;

  // Closing write handle of pipe, otherwise reading will block
  if not CloseHandle( hWrite ) then result:= result or $10;  // GetLastError() for more details
  hWrite:= 0;

  // Read all console output
  GetMem( pBuf, BUFLEN );
  try
    repeat
      bRead:= ReadFile( hRead, pBuf^, BUFLEN- 1, iRead, nil );  // Leave 2 bytes for NULL terminating WideChar
      if (bRead) and (iRead> 0) then begin
        if bExpectUtf8 then begin
          pAnsi:= pBuf;
          pAnsi[iRead]:= #0;
          sOut:= sOut+ StringToWideString( pAnsi, iRead );  // Convert UTF-8 into UTF-16
        end else begin
          pWide:= pBuf;
          pWide[iRead div 2]:= #0;  // Last character is NULL
          sOut:= sOut+ pWide;  // Add to overall output
        end;
      end;
    until (not bRead) or (iRead= 0);
  finally
    // Release process handles
    if not CloseHandle( vPI.hThread ) then result:= result or $20;  // GetLastError() for more details
    if not CloseHandle( vPI.hProcess ) then result:= result or $40;  // GetLastError() for more details;
  end;
  FreeMem( pBuf );

Finish:
  // Pipe must always be released
  if hWrite<> 0 then begin
    if not CloseHandle( hWrite ) then result:= result or $80;  // GetLastError() for more details
  end;
  if not CloseHandle( hRead ) then result:= result or $100;  // GetLastError() for more details
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sOut: Widestring;
  bUtf8: Boolean;
begin
  // In theory this should turn TRUE for you and FALSE for me.
  // If it doesn't work, of course, try setting it hardcoded to either TRUE or FALSE.
  bUtf8:= GetACP()= CP_UTF8;

  if GetCmdOutput
  ( 'cmd.exe /U /C dir /B M:\IN\*'  // What should be executed?
  , sOut  // Retrieving the output
  , bUtf8  // Will the output be UTF-16 or UTF-8?
  )<> 0 then Caption:= 'Error(s) occurred!';
  TntMemo1.Text:= sOut;
end;

它还应该针对较新的 Delphi 版本进行编译。但是，如果 您的 Windows 系统的默认代码页 或 您的进程 设置为在 API 调用中始终使用 UTF-8，则您必须使用

TRUE

而不是

FALSE

作为第三个参数来调用我的函数 - 这就是为什么我必须首先检查活动代码页 (ACP)。

Windows NT 中从来不存在 DOS，“黑色”窗口不是 DOS。