delphi 捕获Unicode命令行输出

drnojrws  于 2023-02-22  发布在  其他
关注(0)|答案(1)|浏览(230)

我有一个过程来捕获隐藏的命令提示符窗口并在TMemo中显示输出。这是相同/相似的代码,张贴在互联网上和堆栈溢出:

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的代码吗?

fivyi3re

fivyi3re1#

我在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,因此我必须使用WidestringPWideChar。现在的Delphi版本默认为Unicode,因此这将是StringPChar
  • 出于同样的原因,必须调用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;

但是,如果your Windows system's default codepageyour process被设置为在API调用中总是使用UTF-8,那么您必须使用TRUE而不是FALSE作为第三个参数来调用我的函数-这就是为什么我必须首先检查活动代码页(ACP)。
DOS从未在Windows NT中存在过,the "black" window is not DOS

相关问题