Capture Unicode command line output

Question

I have a procedure to capture a hidden Command Prompt window and display the output in a TMemo. This is the same/similar code that is posted all over the internet and 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;

That works as expected for any ASCII output but does not support Unicode characters.

When the tree command runs it normally displays characters like:

│   │   │   │   │   ├───

...but the Memo displays:

³   ³           ³   ÃÄÄÄ

I tried changing the buffer from AnsiChar to Char and that does get Unicode displaying in the Memo, but those are just corrupted Unicode characters and not what the command line is showing:

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

Can anyone help tweak that code to support times when the command line uses Unicode characters? I have been messing around with this for hours now trying the suggestions below, but none of them get the tree output displaying correctly in the memo. Can anyone can fix my example code here or post code that works with D11?

Answer 1

It works for me using Delphi 7 in Windows 7, giving the following output:

...
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)
...

My major differences are:

• Delphi 7 still defaults to ANSI instead of WIDE, hence I have to use Widestring and PWideChar. Nowaday Delphi versions default to Unicode, so this would be String and PChar
• For the same reason the WIDE functions (ending with W) must be called.
• I execute cmd.exe /U because as per its manual to enable Unicode pipes.
• Made the buffer of WideChars, too, instead of putting that to bytes only (AnsiChar). For nowadays Delphi versions you should have declared it simply as Char. Most likely this is your fault.
• Actually looking for errors that may occur.

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;

It should also compile for newer Delphi versions. However, if your Windows system's default codepage or your process is set to always use UTF-8 in API calls, you have to call my function with TRUE instead of FALSE as third parameter - that's why I must check the active codepage (ACP) first.

DOS never existed in Windows NT, the "black" window is not DOS.