Solved

Delphi2010: Display DOS output into Memo with Unicode support

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

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

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…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

914 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

19 Experts available now in Live!

Get 1:1 Help Now