1

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:

3 3 3 ÃÄÄÄ

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:

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

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?

asked Feb 20, 2023 at 18:41
8
  • Please edit your question to improve your minimal reproducible example. In particular, share a sample input (what you expect) and corrupted output (what you get). Commented Feb 20, 2023 at 19:05
  • When you use pipes, you need to use /U, too. Commented Feb 20, 2023 at 19:33
  • That sounded like a solution, but adding /U to the createprocess cmd.exe commandline did not make any difference. Commented Feb 20, 2023 at 19:36
  • You face a mojibake case (example in Python for its universal intelligibility): the 1st example '│ ├───'.encode( 'cp850').decode( 'cp1252') returns ³ ÃÄÄÄ and the 2nd (truncated) '‱楦敬猨 潭敶⹤਍††††‱楦敬猨'.encode( 'utf-16-le'). decode( 'utf-8') returns 1 file(s) moved.\r\n 1 file(s Commented Feb 20, 2023 at 19:49
  • Since you program doesn't crash you effectively call CreateProcessA() and not CreateProcessW() - the latter needs a writeable second parameter instead of a literal only. Run Unicode, get Unicode. Commented Feb 20, 2023 at 19:49

1 Answer 1

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

Screenshot of Unicode console output

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:= '';
 pCmd:= nil;
 // 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
 if pCmd<> nil then FreeMem( pCmd );
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.


Update: The above only works on console commands (such as dir) - it doesn't turn a program (an .exe) into magically outputting Unicode instead of Ansi. If you want to perform this on a console program instead of one of cmd.exe's commands you will most likely still get Ansi output, no matter what. How to write such a console program is a different topic - and then it also doesn't need cmd.exe as shell to be started in.

answered Feb 20, 2023 at 21:37
Sign up to request clarification or add additional context in comments.

12 Comments

No go in latest Delphi. Also tried string and pchar, rather then widestring and pwidechar. It also needs to update the memo as it goes like the original code, not all at the end. If anyone else can get the original code working with unicode please do.
Do you still want to keep your Windows and Delphi versions a secret? Because both differ a lot - you might use A() but with UTF-8 as codepage - then the bytes are neither ANSI nor WIDE (UTF-16), making both AnsiString and String the wrong choice.
Windows any version 10 and up 64 bit only. Delphi 11. Copying your exact code gave this sort of mojibake output in the memo. 潆摬牥倠呁?!楬瑳湩൧潖畬敭猠牥慩畮扭牥椠⁳㠷㘰㠭䙂ര䌊尺偁卐਍쓃 I do appreciate your thorough attempted answer. And I realise DOS is long dead, just the name of the original procedure I found all those years ago.
Yes, it's most likely your ACP set to UTF-8, because "潆摬牥倠呁?!" again is UTF-8 treated as UTF-16. I've updated my answer.
And you're sure your launched Console encodes in UTF-8? Otherwise it wouldn't make sense to force TRUE.
|

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.