altРешение задачи русификации консольных приложений с помощью модуля EsConsole Евгения Каснерика вполне симпатичное. Однако оно половинчатое: если запустить программку

{$APPTYPE CONSOLE}
uses
EsConsole in ‘esconsole.pas’;
var
S: string[80];
begin
ReadLn(S);
WriteLn(S);
ReadLn
end.
и ввести строку кириллицы, то получим ту же проблему — на экране будет абракадабра, поскольку русифицирован файл Output, а файл Input — нет. Поэтому на основе функции TextIn из модуля System предлагаю пополнить модуль EsConsole функцией ConInFunc (текст ниже), в которой реализован тот же принцип, что и в ConOutFunc с точностью до наоборот: вводим строку в буфер с помощью ReadFile, а затем в буфере с помощью OemToCharBuff преобразуем эту строку.
Попутно у меня пара вопросов к Евгению Каснерику или другому, кто может ответить.

Во-первых, зачем в функции ConOutFunc используется локальная переменная SavePos? По-моему, можно обойтись без нее — в тексте ниже я даю подправленный код этой функции.

Во-вторых, непонятно почему в разделе инициализации к Output.FlushFunc подсоединяется ConOutFunc, а не Flush:

TTextRec(Output).InOutFunc := @ConOutFunc;
С учетом дополнений и поправок предлагаю такой модуль:
{
Модуль «русификации» консольных приложений
(c) Eugene Kasnerik, 1999
e-mail: eugene1975@mail.ru
(c) Nikolay Kuchma, 2010
e-mail: kuchma@ksu.kz
}
unit EsConsole;

interface

implementation

uses
Windows;

type
TTextRec = packed record
Handle: Integer;
Mode: Word;
Flags: Word;
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 ConInFunc(var Text: TTextRec): Integer;
const
ERROR_BROKEN_PIPE = 109;
begin
Text.BufPos := 0;
Text.BufEnd := 0;
if ReadFile(Text.Handle, Text.BufPtr^, Text.BufSize, Text.BufEnd, nil)
then begin
if Text.BufEnd > 0 then
OemToCharBuff(Text.BufPtr, Text.BufPtr, Text.BufEnd);
Result := 0
end
else begin
Result := GetLastError;
if Result = ERROR_BROKEN_PIPE then
Result := 0
end
end;

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

initialization
Reset(Input);
TTextRec(Input).InOutFunc := @ConInFunc;
TTextRec(Input).FlushFunc := @Flush;
Rewrite(Output);
TTextRec(Output).InOutFunc := @ConOutFunc;
TTextRec(Output).FlushFunc := @ConOutFunc
end.

News Reporter