Solved

Delphi2010: Display DOS output into Memo with Unicode support

Posted on 2010-11-15
12
1,289 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
 

Author Comment

by:wantime
Comment Utility
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
Comment Utility
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
Comment Utility
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 24

Assisted Solution

by:jimyX
jimyX earned 333 total points
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
the Unicode-supported memo component doesn't help. But changing "Regional Languages" really works.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

763 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now