Показать сообщение отдельно
  #1  
Старый 12.12.2011, 04:17
vipnet vipnet вне форума
Прохожий
 
Регистрация: 12.12.2011
Сообщения: 4
Репутация: 10
По умолчанию Проблема с иероглифами в консоли

Все доброго времени суток.
При выполнении программы в консоли все русские символы отображаются в виде иероглифов
Собственно исходный код:
PHP код:
unit Unit1;

interface

uses
  Windows
, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  
Dialogs, StdCtrls;



type
  TForm1 
= class(TForm)
    
Button1: TButton;
    
Button2: TButton;
    
Memo1: TMemo;
    
procedure Button2Click(Sender: TObject);
    
procedure Button1Click(Sender: TObject);
  private
    { Private 
declarations }
  public
    { Public 
declarations }
  
end;

var
  
Form1: TForm1;

implementation
uses EsConsole
;
{
$R *.dfm}


  
procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
  
TStringList);
var
  
sa: TSECURITYATTRIBUTES;
  
si: TSTARTUPINFO;
  
pi: TPROCESSINFORMATION;
  
hPipeOutputRead: THANDLE;
  
hPipeOutputWrite: THANDLE;
  
hPipeErrorsRead: THANDLE;
  
hPipeErrorsWrite: THANDLE;
  
Res, bTest: Boolean;
  
env: array[0..100] of Char;
  
szBuffer: array[0..256] of Char;
  
dwNumberOfBytesRead: DWORD;
  
Stream: TMemoryStream;
begin
  sa
.nLength := sizeof(sa);
  
sa.bInheritHandle := true;
  
sa.lpSecurityDescriptor := nil;
  
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
  
CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
  
ZeroMemory(@env, SizeOf(env));
  
ZeroMemory(@si, SizeOf(si));
  
ZeroMemory(@pi, SizeOf(pi));
  
si.cb := SizeOf(si);
  
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  
si.wShowWindow := SW_HIDE;
  
si.hStdInput := 0;
  
si.hStdOutput := hPipeOutputWrite;
  
si.hStdError := hPipeErrorsWrite;

  
  
Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
    
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

  
// Procedure will exit if CreateProcess fail
  
if not Res then
  begin
    CloseHandle
(hPipeOutputRead);
    
CloseHandle(hPipeOutputWrite);
    
CloseHandle(hPipeErrorsRead);
    
CloseHandle(hPipeErrorsWrite);
    Exit;
  
end;
  
CloseHandle(hPipeOutputWrite);
  
CloseHandle(hPipeErrorsWrite);

  
//Read output pipe
  
Stream := TMemoryStream.Create;
  try
    while 
true do
    
begin
      bTest 
:= ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
        
nil);
      if 
not bTest then
      begin
        
break;
      
end;
      
Stream.Write(szBuffer, dwNumberOfBytesRead);
    
end;
    
Stream.Position := 0;
    
Output.LoadFromStream(Stream);
  
finally
    Stream
.Free;
  
end;

  
//Read error pipe
  
Stream := TMemoryStream.Create;
  try
    while 
true do
    
begin
      bTest 
:= ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
        
nil);
      if 
not bTest then
      begin
        
break;
      
end;
      
Stream.Write(szBuffer, dwNumberOfBytesRead);
    
end;
    
Stream.Position := 0;
    
Errors.LoadFromStream(Stream);
  
finally
    Stream
.Free;
  
end;

  
WaitForSingleObject(pi.hProcess, INFINITE);
  
CloseHandle(pi.hProcess);
  
CloseHandle(hPipeOutputRead);
  
CloseHandle(hPipeErrorsRead);
end;






procedure TForm1.Button2Click(Sender: TObject);
begin
close
;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  
OutP: TStringList;
  
ErrorP: TStringList;
begin
  OutP 
:= TStringList.Create;
  
ErrorP := TstringList.Create;

  
ExecConsoleApp('ping localhost', OutP, ErrorP);
  
Memo1.Lines.Assign(OutP);

  
OutP.Free;
  
ErrorP.Free;
end;

end. 

Прогуглил решение, получил ответ в виде такого вот модуля :

PHP код:
{
Модуль “русификации“ консольных приложений
(c) Eugene Kasnerik, 1999
e
-mail: eugene1975@mail.ru
}
unit EsConsole;

interface

implementation

uses
  Windows
;

{
Описание структуры приведено здесь с единственной целью –
не подключать SysUtils и
, соответственно, код инициализации
этого модуля
. Консольные приложения обычно малы и 25К кода
обработки исключений – несколько высокая плата за описание
единственной структуры
.
}
type
  TTextRec 
= record
    Handle
: Integer;
    
Mode: Integer;
    
BufSize: Cardinal;
    
BufPos: Cardinal;
    
BufEnd: Cardinal;
    
BufPtr: PChar;
    
OpenFunc: Pointer;
    
InOutFunc: Pointer;
    
FlushFunc: Pointer;
    
CloseFunc: Pointer;
    
UserData: array[1..32] of Byte;
    
name: array[0..259] of Char;
    
Buffer: array[0..127] of Char;
end;

function 
ConOutFunc(var Text: TTextRec): Integer;
var
  
Dummy: Cardinal;
  
SavePos: Integer;
begin
  SavePos 
:= Text.BufPos;
  if 
SavePos > 0 then
  begin
    Text
.BufPos := 0;
    
CharToOemBuff(Text.BufPtr, Text.BufPtr, SavePos);
    if 
WriteFile(Text.Handle, Text.BufPtr^, SavePos, Dummy, nil) then
      Result 
:= 0
    
else
      
Result := GetLastError;
  
end
  
else
    
Result := 0;
end;

initialization
  Rewrite
(Output); // Проводим инициализацию файла
  
{ И подменяем обработчики. Есть в этом что-то от
  хака
, но цель оправдывает средства }
  
TTextRec(Output).InOutFunc := @ConOutFunc;
  
TTextRec(Output).FlushFunc := @ConOutFunc;
end. 
Подцепил его. Итог : не работает, получаю это :

PHP код:
Project1.exe raised exception class EInIotError with message 'I/O error 105'.Process stopped.Use Step or Run to continue. 

Вопросы следующие:
Возможно ли исправить ошибку?
Существуют ли другие пути решения?
Заранее спасибо.
Ответить с цитированием