Solved

Delphi2010: Display DOS output into Memo with Unicode support

Posted on 2010-11-15
12
1,342 Views
Last Modified: 2012-05-10
hi all,

by using the codes attached i could let DOS output be displayed into Memo. But the problem here is that these codes don't support Unicode. if the output contains chinese, russian etc, the output in Memo are question marks like ????.  How do i change the codes to support unicode?

i don't want to config the language setting in operatingsystem to support any of these language, because this is not the way to support all language.

thanks,

wantime
function RunDosInMemo(DosApp: String; Memo1: TMemo): LongWord;
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PAnsiChar;
  BytesRead: DWord;
  Apprunning: DWord;
  isExisted: Boolean;
  s: String;
begin

  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;

  if CreatePipe(ReadPipe, WritePipe, @Security, ReadBuffer) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(start, SizeOf(TStartUpInfo), 0);
    start.cb := SizeOf(TStartUpInfo);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
      NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;

        repeat
          BytesRead := 0;
          isExisted := PeekNamedPipe
            (ReadPipe, nil, ReadBuffer, nil, @BytesRead, nil);

          if (isExisted and (BytesRead > 0)) then
          begin
            ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
            Buffer[BytesRead] := #0;
            OemToAnsi(Buffer, Buffer);
            s := String(Buffer);
            Memo1.Text := Memo1.Text + s;
            Memo1.Update;
            Application.ProcessMessages;
          end;
        until (BytesRead < ReadBuffer);
      until (Apprunning <> WAIT_TIMEOUT);
    end;

    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

Open in new window

0
Comment
Question by:wantime
  • 6
  • 5
12 Comments
 
LVL 32

Accepted Solution

by:
ewangoya earned 167 total points
ID: 34142330
The biggest problem would be if the output can either be AnsiString or Unicode. If thats the case, you neede to detect whether the bytes in buffer are unicode or ansistring then call SetString with the correct cast.


function RunDosInMemo(DosApp: String; Memo1: TMemo): LongWord;
const
  ReadBuffer = 8192;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: TByteArray;
  BytesRead: DWord;
  Apprunning: DWord;
  isExisted: Boolean;
  S: RawByteString;
begin
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;

  if CreatePipe(ReadPipe, WritePipe, @Security, ReadBuffer) then
  begin
    FillChar(Buffer, SizeOf(Buffer), #0);
    FillChar(start, SizeOf(TStartUpInfo), #0);
    start.cb := SizeOf(TStartUpInfo);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
      NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;

        repeat
          BytesRead := 0;
          isExisted := PeekNamedPipe
            (ReadPipe, nil, ReadBuffer, nil, @BytesRead, nil);

          if (isExisted and (BytesRead > 0)) then
          begin
            ReadFile(ReadPipe, Buffer, ReadBuffer, BytesRead, nil);

            //if output is unicode
            SetString(S, PWideChar(@Buffer[0]), Length(Buffer) div 2);

            //if output ansi
            //SetString(S, PAnsiChar(@Buffer[0]), Length(Buffer));

            Memo1.Text := Memo1.Text + s;
            Memo1.Update;
            Application.ProcessMessages;
          end;
        until (BytesRead < ReadBuffer);
      until (Apprunning <> WAIT_TIMEOUT);
    end;

    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

0
 
LVL 24

Expert Comment

by:jimyX
ID: 34142368
First of all set the memo font to "Arial Unicode MS".

Try your own code first if did not work then try the following code.

function RunDosInMemo(DosApp: WideString; Memo1: TMemo): LongWord;
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PAnsiChar;
  BytesRead: DWord;
  Apprunning: DWord;
  isExisted: Boolean;
  s: String;
begin

  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;

  if CreatePipe(ReadPipe, WritePipe, @Security, ReadBuffer) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(start, SizeOf(TStartUpInfo), 0);
    start.cb := SizeOf(TStartUpInfo);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PWIDEChar(DosApp), @Security, @Security, true,
      NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;

        repeat
          BytesRead := 0;
          isExisted := PeekNamedPipe
            (ReadPipe, nil, ReadBuffer, nil, @BytesRead, nil);

          if (isExisted and (BytesRead > 0)) then
          begin
            ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
            Buffer[BytesRead] := #0;
            OemToAnsi(Buffer, Buffer);
            s := String(Buffer);
            Memo1.Text := Memo1.Text + s;
            Memo1.Update;
            Application.ProcessMessages;
          end;
        until (BytesRead < ReadBuffer);
      until (Apprunning <> WAIT_TIMEOUT);
    end;

    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

Open in new window

0
 
LVL 24

Assisted Solution

by:jimyX
jimyX earned 333 total points
ID: 34142754
After trying this, you can not. It is not because that these codes don't support Unicode but simply because you can not get that even when you are using the DOS Command Prompt (CMD) directly. try it.

You have to configure the language setting in your OS to support these languages.

Here is another method from Joe Donth. It did accept passing path containing Chinese chars to "Dir" command in Win 7 "dir C:\¿¿\" it was performed successfully and I got the list of files and directories inside that folder but the view of the path itself on the memo (the Chinese Chars only) has turned to ???:

http://ats76id.wordpress.com/2008/05/12/execute-a-dos-command-and-capture-the-output/


function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  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;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Text := GetDosOutput(Edit1.Text);
end;

Open in new window

0
ScreenConnect 6.0 Free Trial

At ScreenConnect, partner feedback doesn't fall on deaf ears. We collected partner suggestions off of their virtual wish list and transformed them into one game-changing release: ScreenConnect 6.0. Explore all of the extras and enhancements for yourself!

 

Author Comment

by:wantime
ID: 34143062
thanks! the ouput from dos is already unicode, and i have changed the fond charset of memo to default charset, it works! And i will have a deeply look at all your codes.
0
 

Author Comment

by:wantime
ID: 34143114
oh, it's not that simple as i thought... i have forgot that i changed the system language before. after i reset the system language, it doesn't work if only the fond charset of memo is changed. Time to try your suggestions : )
0
 

Author Comment

by:wantime
ID: 34171500
it doesn't help. the problem is still there.

i have a related question about the console and unicode.

OS: Vista / EN

there is a folder with chinese name under C:, and 'cmd' was executed to run dosbox.

in dosbox i execute 'dir' under C:

the chinese name could not be displayed, it is not readable.

are there any way to make dosbox support unicode under Vista /EN. (not just change language setting in control panel under Regional and Language Options)

thanks.
0
 
LVL 24

Assisted Solution

by:jimyX
jimyX earned 333 total points
ID: 34171825
There is away but you can not set it to support all the characters. There is a command line that enables you to activate certain codes for the different languages:

chcp code#
Where code# differs based on the Characters that you want to show (can be 1251, 437, ... check the site below).
Also there is a way to change the font of the cmd which can enable showing the Chinese Characters but note they will show as boxes due to the font lacks to support showing them but they are valid.
Please read the following page it explains everything:

http://stackoverflow.com/questions/1259084/what-encoding-code-page-is-cmd-exe-using

 
0
 
LVL 24

Expert Comment

by:jimyX
ID: 34171886
Example:

In the Command Prompt:

chcp 437

Let's assume you have the folder with the Chinese name in the "C:\" then use cd and copy and past the Chinese Chars:

make sure C:\ is your current directory then:

C:\cd "TheChineseName"

You still can try different codes.
0
 
LVL 24

Expert Comment

by:jimyX
ID: 34171983
Continue the last post...

After performing cd then do dir:

C:\oooo>dir

That will view the content of the folder that has a Chinese characters.
0
 

Author Comment

by:wantime
ID: 34192784
if i change the codepage, the dosbox will support the language which i need.

but the output in Memo seems not to do with the codepage in Dosbox.

maybe the only way is to set  "Regions and languageoption" in control panel to let console support all language.
0
 
LVL 24

Expert Comment

by:jimyX
ID: 34193343
Before setting the "Regional Languages" just try a Unicode-supported memo component:

http://www.tntware.com/tntmpd/downloads/p/11083.aspx
or
http://www.tmssoftware.com/site/tmsuni.asp

If also not working, most likely because the Unicode characters are lost in the conversion inside the function, then you have to set the "Regional Languages".
0
 

Author Comment

by:wantime
ID: 34195331
the Unicode-supported memo component doesn't help. But changing "Regional Languages" really works.
0

Featured Post

ScreenConnect 6.0 Free Trial

Discover new time-saving features in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI, app configurations and chat acknowledgement to improve customer engagement!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Path  to current project in Delphi. 2 80
Dynamically Created Query 3 56
update joined tables 2 47
How to Get Images From Server using App Tethering 11 29
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
This video shows how to quickly and easily add an email signature for all users on Exchange 2016. The resulting signature is applied on a server level by Exchange Online. The email signature template has been downloaded from: www.mail-signatures…

832 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question