Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

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

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

interface

uses
  Windows
MessagesSysUtilsVariantsClassesGraphicsControlsForms,
  
DialogsStdCtrls;



type
  TForm1 
= class(TForm)
    
Button1TButton;
    
Button2TButton;
    
Memo1TMemo;
    
procedure Button2Click(SenderTObject);
    
procedure Button1Click(SenderTObject);
  private
    { Private 
declarations }
  public
    { Public 
declarations }
  
end;

var
  
Form1TForm1;

implementation
uses EsConsole
;
{
$R *.dfm}


  
procedure ExecConsoleApp(CommandLineAnsiStringOutputTStringListErrors:
  
TStringList);
var
  
saTSECURITYATTRIBUTES;
  
siTSTARTUPINFO;
  
piTPROCESSINFORMATION;
  
hPipeOutputReadTHANDLE;
  
hPipeOutputWriteTHANDLE;
  
hPipeErrorsReadTHANDLE;
  
hPipeErrorsWriteTHANDLE;
  
ResbTestBoolean;
  
env: array[0..100of Char;
  
szBuffer: array[0..256of Char;
  
dwNumberOfBytesReadDWORD;
  
StreamTMemoryStream;
begin
  sa
.nLength := sizeof(sa);
  
sa.bInheritHandle := true;
  
sa.lpSecurityDescriptor := nil;
  
CreatePipe(hPipeOutputReadhPipeOutputWrite, @sa0);
  
CreatePipe(hPipeErrorsReadhPipeErrorsWrite, @sa0);
  
ZeroMemory(@envSizeOf(env));
  
ZeroMemory(@siSizeOf(si));
  
ZeroMemory(@piSizeOf(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(nilpchar(CommandLine), nilniltrue,
    
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @envnilsipi);

  
// 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(hPipeOutputReadszBuffer256dwNumberOfBytesRead,
        
nil);
      if 
not bTest then
      begin
        
break;
      
end;
      
Stream.Write(szBufferdwNumberOfBytesRead);
    
end;
    
Stream.Position := 0;
    
Output.LoadFromStream(Stream);
  
finally
    Stream
.Free;
  
end;

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

  
WaitForSingleObject(pi.hProcessINFINITE);
  
CloseHandle(pi.hProcess);
  
CloseHandle(hPipeOutputRead);
  
CloseHandle(hPipeErrorsRead);
end;






procedure TForm1.Button2Click(SenderTObject);
begin
close
;
end;

procedure TForm1.Button1Click(SenderTObject);
var
  
OutPTStringList;
  
ErrorPTStringList;
begin
  OutP 
:= TStringList.Create;
  
ErrorP := TstringList.Create;

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

  
OutP.Free;
  
ErrorP.Free;
end;

end

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

PHP код:
{
Модуль “русификации“ консольных приложений
(cEugene Kasnerik1999
e
-maileugene1975@mail.ru
}
unit EsConsole;

interface

implementation

uses
  Windows
;

{
Описание структуры приведено здесь с единственной целью –
не подключать SysUtils и
соответственнокод инициализации
этого модуля
Консольные приложения обычно малы и 25К кода
обработки исключений – несколько высокая плата за описание
единственной структуры
.
}
type
  TTextRec 
record
    Handle
Integer;
    
ModeInteger;
    
BufSizeCardinal;
    
BufPosCardinal;
    
BufEndCardinal;
    
BufPtrPChar;
    
OpenFuncPointer;
    
InOutFuncPointer;
    
FlushFuncPointer;
    
CloseFuncPointer;
    
UserData: array[1..32of Byte;
    
name: array[0..259of Char;
    
Buffer: array[0..127of Char;
end;

function 
ConOutFunc(var TextTTextRec): Integer;
var
  
DummyCardinal;
  
SavePosInteger;
begin
  SavePos 
:= Text.BufPos;
  if 
SavePos 0 then
  begin
    Text
.BufPos := 0;
    
CharToOemBuff(Text.BufPtrText.BufPtrSavePos);
    if 
WriteFile(Text.HandleText.BufPtr^, SavePosDummynilthen
      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. 

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


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 03:33.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025