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?
1 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) ...Screenshot of Unicode console output
My major differences are:
- Delphi 7 still defaults to ANSI instead of WIDE, hence I have to use
WidestringandPWideChar. Nowaday Delphi versions default to Unicode, so this would beStringandPChar - For the same reason the WIDE functions (ending with
W) must be called. - I execute
cmd.exe /Ubecause 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 asChar. 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.
12 Comments
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.TRUE.Explore related questions
See similar questions with these tags.
/U, too.'│ ├───'.encode( 'cp850').decode( 'cp1252')returns³ ÃÄÄÄand the 2nd (truncated)'‱楦敬猨 潭敶††††‱楦敬猨'.encode( 'utf-16-le'). decode( 'utf-8')returns1 file(s) moved.\r\n 1 file(sCreateProcessA()and notCreateProcessW()- the latter needs a writeable second parameter instead of a literal only. Run Unicode, get Unicode.