Русификация ввода в консольных приложениях на Delphi

© 2010 Кучма Николай

Решение задачи русификации консольных приложений с помощью модуля 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.

Copyright© 2010 Кучма Николай  Специально для Delphi Plus