[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1480
  • Last Modified:

Delphi2010: Display DOS output into Memo with Unicode support

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
wantime
Asked:
wantime
  • 6
  • 5
3 Solutions
 
Ephraim WangoyaCommented:
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
 
jimyXCommented:
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
 
jimyXCommented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
wantimeAuthor Commented:
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
 
wantimeAuthor Commented:
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
 
wantimeAuthor Commented:
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
 
jimyXCommented:
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
 
jimyXCommented:
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
 
jimyXCommented:
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
 
wantimeAuthor Commented:
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
 
jimyXCommented:
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
 
wantimeAuthor Commented:
the Unicode-supported memo component doesn't help. But changing "Regional Languages" really works.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now