Comandos DOS son devueltos en idioma chino
 

Buenas noches a todos,

Tengo la siguiente función desarrollada (probando en Windows 10) y me devuelve a la VCL (TMemo) el resultado de la salida de comandos como caracteres chinos.

Código Delphi [-]
function ExecuteCommandCMD(aCommandLine: String; aReturnOutput: Boolean = False): String;
var
  objWindowsVersion: TWindowsVersion;
  typStartUpInfo: STARTUPINFO;
  typSecAttr: SECURITY_ATTRIBUTES;
  typSecDescrip: SECURITY_DESCRIPTOR;
  typProcInformation: PROCESS_INFORMATION;
  objNewStdIn: THandle;
  objNewStdOut: THandle;
  objReadStdOut: THandle;
  objWriteStdIn: THandle;
  carExitCode: Cardinal;
  caByteRead: Cardinal;
  carAvailable: Cardinal;
  arrBuffer: array[0..MAX_PATH] of Char;  // El tamaño puede ser cambiado según las necesidades.

begin
  Result := '';
  objWindowsVersion := TWindowsVersion.Create;

  try
    if objWindowsVersion.IsPlatformNT then
    begin
      InitializeSecurityDescriptor(@typSecDescrip, SECURITY_DESCRIPTOR_REVISION);
      SetSecurityDescriptorDacl(@typSecDescrip, True, nil, False);
      typSecAttr.lpSecurityDescriptor := @typSecDescrip;
    end
    else
      typSecAttr.lpSecurityDescriptor := nil;
  finally
    FreeAndNil(objWindowsVersion);
  end;

  typSecAttr.nLength := SizeOf(SECURITY_ATTRIBUTES);
  typSecAttr.bInheritHandle := True;

  // Crea un pipe anónimo y devuelve el manejador para la lectura y escritura en el pipe.
  if CreatePipe(objNewStdIn, objWriteStdIn, @typSecAttr, 0) then
  begin
    if CreatePipe(objReadStdOut, objNewStdOut, @typSecAttr, 0) then
    begin
      // Devuelve el contenido de la estructura 'STARTUPINFO' cuando se crea el proceso que es llamado.
      GetStartupInfo(typStartUpInfo);

      with typStartUpInfo do
      begin
        dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        wShowWindow := SW_SHOW; //SW_HIDE;
        hStdOutput := objNewStdOut;
        hStdError := objNewStdOut;
        hStdInput := objNewStdIn;
      end;

      Fillchar(arrBuffer, SizeOf(arrBuffer), 0);
      // Para un detalle de las variables que se pueden leer ver:
      //   - http://docwiki.embarcadero.com/Libra...onmentVariable
      // Igualmente la función que se usa aca es la de las APIs de Windows (Windows) y no la de Delphi (SysUtils).
      GetEnvironmentVariable('COMSPEC', arrBuffer, SizeOf(arrBuffer) - 1);
      StrCat(arrBuffer, PChar(' /C ' + aCommandLine));

      // Crea un proceso y su hilo promario. El nuevo proceso corre en un contexto seguro del proceso llamado.
      if CreateProcess(nil, arrBuffer, nil, nil, True, CREATE_NEW_CONSOLE, nil, nil, typStartUpInfo, typProcInformation) then
      begin
        repeat
          // Copia los datos de un pipe con nombre o anónimo en el buffer sin eliminar lo que tiene el pipe.
          // También devuelve la información de los datos del pipe.
          PeekNamedPipe(objReadStdOut, @arrBuffer, SizeOf(arrBuffer) - 1, @caByteRead, @carAvailable, nil);

          if caByteRead > 0 then
          begin
            Fillchar(arrBuffer, SizeOf(arrBuffer), 0);
            ReadFile(objReadStdOut, arrBuffer, SizeOf(arrBuffer), caByteRead, 0);
            // Acá es donde se devuelve el resultado de lo ejecutado en la consola DOS.
            if aReturnOutput then Result := Result + #13#10 + String(arrBuffer);
          end;

          Application.ProcessMessages;
          GetExitCodeProcess(typProcInformation.hProcess, carExitCode);
        until (carExitCode <> STILL_ACTIVE) and (caByteRead = 0);
      end
      else
        MessageError(ERR_DOS_COMMAND);

      CloseHandle(objReadStdOut);
      CloseHandle(objNewStdOut);
    end;

    CloseHandle(objNewStdIn);
    CloseHandle(objWriteStdIn);
  end;
end;

No entiendo en donde tengo que corregir para que lo que devuelva sea en un idioma legible tal cual lo vemos en la ventana de comandos cunado ejecutamos algo.

Saludos,
El Rayo

¿Puedes copiar aquí alguna de esas respuestas en chino?

Los programas heredan el contexto de su usuario. Es el PC en chino?

https://www.computerhope.com/chcphlp...2870b58d3b3548

Creo que cuando se refiere a "chino", no es propiamente el idioma, sino lo que bulgarmente decimos "caracteres en chino" o que "el programa me ha insultado".
Creo que está obteniendo algo como esto:


Es debido a que ese procedimiento debe ser antiguo y se está "liando" entre string/AnsiString.
Hemos hablado antes en los foros y si buscas hay soluciones similares que te funcionarán con la nuevas versiones de Delphi.

De todas formas, si en la línea del Result haces esta modificación, creo que debería aparecer el texto correctamente:

Código Delphi [-]
  // Acá es donde se devuelve el resultado de lo ejecutado en la consola DOS.
  if aReturnOutput then Result := Result + #13#10 + PAnsiChar(@arrBuffer);

Fijo !

Ahora se fabrica algo en alguna otra parte?

;-)

Neftalí, me ganaste de mano porque estaba por subir una imagen de lo que muestra y es igual a la tuya con todos esos caracteres que parecen chino.


Gracias, por la ayuda. Si puede que sea algo viejo porque lo tenía en un pequeño framework que uso y que voy actualizando. Se be que eso no lo actualice y probé en las nuevas versiones.


Con lo que decís de que en los foros hay nuevas versiones, yo debo estar buscando mal porque en este mismo foro y el otro muy conocido me aparecen funciones que son bastante viejas. Lo mas nuevo que me apareció fue algo del 2012 pero era para Lazarus y muchas de las funciones que se utilizan existen en Delphi. Igualmente las he logrado cambiar pero seguía mostrando esos caracteres en chino


Seguiré buscando y veré de actualizar la que tengo.


Saludos,
El Rayo

Mira a ver si esta unit te sirve:

Código Delphi [-]
unit PipeShell3;
 
 
interface
 
uses
  Windows, Messages, SysUtils, Classes;
 
const
  BUFFERSIZE = 4*1024;
 
type
  TPipeShell = class
  private
    PipeIn, PipeOut, PipeWrite, PipeRead: THANDLE;
    hProcess: THANDLE;
    Buffer: PAnsiChar;
  protected
  public
    constructor Create;
    destructor  Destroy; override;
    function Write(S: AnsiString): DWORD;
    function Read: AnsiString;
  end;
 
implementation
 
constructor TPipeShell.Create;
var
  sd: SECURITY_DESCRIPTOR;
  sa: SECURITY_ATTRIBUTES;
  si: STARTUPINFOA;
  pi: PROCESS_INFORMATION;
begin
  PipeIn:= 0;
  PipeOut:= 0;
  PipeWrite:= 0;
  PipeRead:= 0;
  hProcess:= 0;
 
  GetMem(Buffer, BUFFERSIZE);
  InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
  sa.lpSecurityDescriptor:= @sd;
//  sa.lpSecurityDescriptor:= nil;
  sa.nLength:= sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle:= TRUE;
  // Tuberia de entrada
  if CreatePipe(PipeIn, PipeWrite, @sa, 0) then
  begin
    // Tuberia de salida
    if CreatePipe(PipeRead, PipeOut, @sa, 0) then
    begin
      GetStartupInfoA(Si);
      // Indicamos tuberias del proceso
      si.hStdOutput:= PipeOut;
      si.hStdError:= PipeOut;
      si.hStdInput:= PipeIn;
      si.dwFlags:= STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      si.wShowWindow:= SW_HIDE;
      //si.wShowWindow:= SW_SHOW;
      // Ruta del shell
      ZeroMemory(Buffer, BUFFERSIZE);
      GetEnvironmentVariableA('COMSPEC', Buffer, BUFFERSIZE - 1);
      // Ejecutamos el shell
      if CreateProcessA(nil, Buffer, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi) then
      begin
         hProcess:= pi.hProcess;
         CloseHandle(pi.hThread);
      end;
    end;
  end;
end;
 
destructor TPipeShell.Destroy;
var
  ExitCode: DWORD;
begin
  // Tratamos de terminar el shell
  repeat
    Write('quit'); Read;
    Write('q'); Read;
    Write('exit'); Read;
    GetExitCodeProcess(hProcess, ExitCode);
  until ExitCode <> STILL_ACTIVE;
 
  if PipeIn <> 0    then CloseHandle(PipeIn);
  if PipeOut <> 0   then CloseHandle(PipeOut);
  if PipeWrite <> 0 then CloseHandle(PipeWrite);
  if PipeRead <> 0  then CloseHandle(PipeRead);
  if hProcess <> 0  then CloseHandle(hProcess);
  if Buffer <> nil  then FreeMem(Buffer);
  if WaitForSingleObject(hProcess, 9000) <> WAIT_OBJECT_0 then
    TerminateProcess(hProcess, DWORD(-1));
  //GetExitCodeProcess(hProcess, ExitCode);
  //inherited;
end;
 
function TPipeShell.Write(S: AnsiString): DWORD;
begin
  if PipeWrite = 0 then exit;
  lstrcpyA(Buffer, PAnsiCHAR(S + #10));
  WriteFile(PipeWrite, Buffer^, lstrlenA(Buffer), Result, nil);
end;
 
function TPipeShell.Read: AnsiString;
var
  dwRead, dwBytesAvail: DWORD;
begin
  if PipeRead = 0 then exit;
 
  dwRead:= 0;
  // Esperamos a que tengamos algo que leer en PipeRead
  repeat
    sleep(100);
    PeekNamedPipe(PipeRead, Buffer, BUFFERSIZE, @dwRead, @dwBytesAvail, nil);
    if dwRead > 0 then
    begin
      // Leemos y vaciamos el PipeRead
      ZeroMemory(Buffer, BUFFERSIZE);
      ReadFile(PipeRead, Buffer^, dwRead, PDWORD(0)^, nil);
      OemToCharBuffA(Buffer, Buffer, dwRead);
      Result:= Result + AnsiString(Buffer);
    end;
  until dwBytesAvail = 0;
end;  
 
end.

Para más información el código original lo publiqué aquí.


Saludos.

Haz el cambio en la línea del Result que te he propuesto y vuelve a probar.

Si con ese cambio funciona. Muchas gracias


escafandra, revisaré la clase que pasaste porque creo que es mas actualizada que lo que yo tengo. Algo parecido había visto en DelphiAccess pero estaba orientado a Lazarus y por lo que había analizado requería varios cambios mas que nada por las funciones que hacen referencia a las API. Aunque esto obligaba a cambiar algunas variables por tema de tipo de dato.


Igualmente como dije, gracias a los dos por la ayuda.


Saludos,
El Rayo