unit Parsers;

interface

uses
	SysUtils, Classes, InSysUtils;

type
	EStrParser = class;
	TStrParser = class;

{	TStrParser }

	TTokenCase = (tcOrigin, tcUpper, tcLower);
	TResWord = record
		Name: PChar;
		ID: Integer;
	end;

	EStrParser = class(Exception)
	private
		FOffset: Integer;
	public
		constructor Create(aParser: TStrParser; const aMessage: String);
		constructor CreateFmt(aParser: TStrParser; const aFmt: String;
			const anArgs: array of const);
		property Offset: Integer read FOffset;
		//	Смещение ошибки от начала разбираемого текста
	end;

	TStrParser = class
	private
		FSource: PChar;
		FCurPos: PChar;
		FSaveCurPos: PChar;
		FToken: string;
		FSkipLineEnds: Boolean;

		procedure SetSource(aValue: PChar);
		procedure NewToken;
		procedure SkipBlanks;
		function AcceptToken(anAccept: Boolean): Boolean;

		function GetOffset: Integer;
		procedure SetOffset(aValue: Integer);
	public
		constructor Create(aSource: PChar);
		//	Инициализирует разборщик.
		//	aSource - исходный текст

		function ReadChar: Boolean;
		procedure Reset;
		//	Сбрасывает разборщик на начало текста

		procedure SkipToNextLine;

		function Eof: Boolean;
		//	Возвращает True, если разборщик дошел до конца исходного текста

		function NextTokenIsLineEnd: Boolean;
		function NextTokenIsDelimited(aDelimiter: Char): Boolean;
		//  Извлечь из входного потока очередную лексему, если она отделена от предыдущей
		//	указанным символом.
		//	Параметры:
		//		aDelimiter - символ - разделитель лексем
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIs(const aTest: string; aCase: TTokenCase = tcOrigin): Boolean;
		//  Извлечь из входного потока очередную лексему, если она полность совпадает с
		//	заданной строкой.
		//	Параметры:
		//		aTest - строка, с которой должна совпадать лексема
		//		aCase - задает способ сравнения буквенных символов
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIsResWord(const aWords: array of TResWord; var aResWordID: Integer):
			Boolean;
		//  Извлечь из входного потока очередную лексему, если, во-первых, она содержится в
		//	указанном списке слов и, во-вторых, символ, следующий за лексемой не является
		//	алфавитно-цифровым.
		//	Параметры:
		//		aWords - список слов.
		//		aResWord - если лексема содержится в списке слов, то данный параметр возвращает
		//			идентификатор слова.
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIsResWordID(const aWords: array of TResWord; aTestID: Integer):
			Boolean;
		//  Извлечь из входного потока очередную лексему, если она содержится в списке слов
		//	под указанным идентификатором.
		//  Извлечь из входного потока очередную лексему, если, во-первых, она содержится в
		//	указанном списке слов под указанным идентификатором и, во-вторых, символ,
		//	следующий за лексемой не является алфавитно-цифровым.
		//	Параметры:
		//		aWords - список слов.
		//		aTestID - идентификатор слова, с которым должна совпадать лексема
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIsFloat: Boolean;
		//  Извлечь из входного потока очередную лексему, если её можно интерпретировать
		//	как вещественное число.
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIsNumber(const aDecimalSeps: string; out anIsInteger: Boolean): Boolean;
		//  Извлечь из входного потока очередную лексему, если её можно интерпретировать
		//	как вещественное или целочисленное число.
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIsNumeric: Boolean;
		//  Извлечь из входного потока очередную лексему, если её можно интерпретировать
		//	как целое число.
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIsAlphaNumeric: Boolean;
		//  Извлечь из входного потока очередную лексему, если её можно интерпретировать
		//	как идентификатор (начинается с буквы и дальше содержит буквы и цифры).
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		function NextTokenIsFunction: Boolean;
		//  Извлечь из входного потока очередную лексему, если её можно интерпретировать
		//	как имя функции (начинается с буквы и дальше содержит буквы и цифры,
		//	с последующим символом "(" ).
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.

		procedure SkipTo(const s: String);
		function NextTokenIsInBrackets(aLeft, aRight: Char): Boolean;
		//  Извлечь из входного потока очередную лексему, если её можно интерпретировать
		//	как строку, заключенную в скобки.
		//	Параметры:
		//		aLeft - символ левой скобки
		//		aRight - символ правой скобки
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.
		//		Символы скобок в Token не помещаются.
		//	Пример:
		//		aParser.NextTokenIsQuoted('[', ']');

		function NextTokenIsQuoted(const aLeft, aRight: string): Boolean;
		//  Извлечь из входного потока очередную лексему, если её можно интерпретировать
		//	как строку, заключенную в парные скобки.
		//	Параметры:
		//		aLeft - символы левых скобок
		//		aRight - символы закрывающих скобок
		//	Результат:
		//		Если удалось считать лексему, то функция возвращает True.
		//	Примечание:
		//		В случае удачного извлечения, лексема помещается в Token.
		//		Символы скобок в Token не помещаются.
		//		Если лексема начинается со скобки aLeft[i], то она должна завершаться
		//		скобкой aRight[i].
		//	Пример:
		//		aParser.NextTokenIsQuoted('''"', '''"');

		function NextTokenIsRestricted(const aRight: string): Boolean;
		function NextTokenIsOp(const anOps: array of TResWord; var aResWordID: Integer): Boolean;
		function NextTokenIsWord(const aWord: String): Boolean;

		procedure Expect(const aTest: string; aCase: TTokenCase = tcOrigin);
		procedure ExpectResWord(const aWords: array of TResWord; var aResWordID: Integer);
		procedure ExpectWord(const aWord: string);

		function ExpectNumeric: Integer;
		function ExpectFloat: Double;
		function ExpectAlphaNumeric: String;
		function ExpectInBrackets(aLeft, aRight: Char): String;

		procedure UndoLastToken;

		property Offset: Integer read GetOffset write SetOffset;
		property Source: PChar write SetSource;
		property Token: string read FToken;
		property SkipLineEnds: Boolean read FSkipLineEnds write FSkipLineEnds;
	end;

	TTextReader = class
	private
		Stream: TStream;
		Buffer: PChar;
		BufSize: Word;
		BufEnd: PChar;
		BufPos: PChar;

		procedure GotoNextChar;
//			procedure GotoPrevChar;

		function GetPos: Longint;
		procedure SetPos(aPos: Longint);

	public
		ConvertOemToChar: Boolean;
		property Pos: Longint read GetPos write SetPos;

		constructor Create(aStream: TStream; aBufSize: Word);
		destructor Destroy; override;

		function ReadLine: string;
		procedure ReadLineToBuf(aBuf: PChar; aBufSize: Integer);
		function ReadChar: Char;
		function Eof: Boolean;
	end;

implementation

uses
	Windows, Math;
	
function AnsiLICompare(s1, s2: PChar; aLen: Integer): Integer;
begin
	Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
			s1, Min(aLen, StrLen(s1)), s2, Min(aLen, StrLen(s2))) - 2;
end;


{ EStrParser }

constructor EStrParser.Create(aParser: TStrParser; const aMessage: String);
begin
	inherited Create(aMessage);
	FOffset := aParser.Offset;
end;

constructor EStrParser.CreateFmt(aParser: TStrParser; const aFmt: String;
	const anArgs: array of const);
begin
	inherited CreateFmt(aFmt, anArgs);
	FOffset := aParser.Offset;
end;

{	TStrParser }

constructor TStrParser.Create(aSource: PChar);
begin
	inherited Create;
	SetSource(aSource);
	FSkipLineEnds := True;
end;

function TStrParser.GetOffset: Integer;
begin
	Result := Longint(FCurPos) - Longint(FSource);
end;

procedure TStrParser.SetOffset(aValue: Integer);
begin
	FCurPos := PChar(Longint(FSource) + aValue);
end;

procedure TStrParser.SetSource(aValue: PChar);
begin
	FSource := aValue;
	Reset;
end;

procedure TStrParser.Reset;
begin
	FCurPos := FSource;
	if Assigned(FCurPos) then
		SkipBlanks;
end;

procedure TStrParser.SkipToNextLine;
var
	c: Char;
begin
	while (FCurPos^ <> #0) and (FCurPos^ <> ^M) and (FCurPos^ <> ^J) do
		Inc(FCurPos);
	c := FCurPos^;
	if c <> #0 then begin
		Inc(FCurPos);
		if (c = ^M) and (FCurPos^ = ^J) or (c = ^J) and (FCurPos^ = ^M) then
			Inc(FCurPos)
	end;
	SkipBlanks;
end;

procedure TStrParser.SkipBlanks;
begin
	if FSkipLineEnds then
		while (FCurPos^ <> #0) and (Byte(FCurPos^) <= Ord(' ')) do
			Inc(FCurPos)
	else
		while (FCurPos^ <> #0) and (Byte(FCurPos^) <= Ord(' ')) and
			(FCurPos^ <> ^M) and (FCurPos^ <> ^J)
		do
			Inc(FCurPos)
end;

function TStrParser.Eof: Boolean;
begin
	Result := FCurPos^ = #0;
end;

procedure TStrParser.NewToken;
begin
	FSaveCurPos := FCurPos;
	FToken := '';
end;

function TStrParser.ReadChar: Boolean;
begin
	if FCurPos^ = #0 then
		Result := False
	else begin
		Result := True;
		SetLength(FToken, Length(FToken) + 1);
		FToken[Length(FToken)] := FCurPos^;
		Inc(FCurPos);
	end;
end;

procedure TStrParser.UndoLastToken;
begin
	FCurPos := FSaveCurPos;
end;

function TStrParser.AcceptToken(anAccept: Boolean): Boolean;
begin
	Result := anAccept;
	if anAccept then
		SkipBlanks
	else
		FCurPos := FSaveCurPos;
end;

function TStrParser.NextTokenIs(const aTest: string; aCase: TTokenCase): Boolean;
var
	i: Integer;
begin
	NewToken;

	for i := 1 to Length(aTest) do
		if not ReadChar then begin
			Result := AcceptToken(False);
			Exit;
		end;

	case aCase of
		tcUpper: FToken := AnsiUpperCase(FToken);
		tcLower: FToken := AnsiLowerCase(FToken);
	end;

	Result := AcceptToken(FToken = aTest);
end;

function TStrParser.NextTokenIsDelimited(aDelimiter: Char): Boolean;
begin
	NewToken;

	while not Eof and (FCurPos^ <> aDelimiter) do
		ReadChar;
	Result := FCurPos^ = aDelimiter;

	AcceptToken(Result);
end;

function TStrParser.NextTokenIsLineEnd: Boolean;
var
	c: Char;
begin
	NewToken;

	c := FCurPos^;
	Result := (c = ^M) or (c = ^J);
	if Result then begin
		ReadChar;
		if (c = ^M) and (FCurPos^ = ^J) or (c = ^J) and (FCurPos^ = ^M) then
			ReadChar
	end;

	AcceptToken(Result);
end;

function TStrParser.NextTokenIsResWord(const aWords: array of TResWord; var aResWordID: Integer): Boolean;
var
	aWord: PChar;
	aLength: Word;
	i: Integer;
begin
	NewToken;

	for i := Low(aWords) to High(aWords) do begin
		aWord := aWords[i].Name;
		aLength := StrLen(aWord);
		if (AnsiLICompare(aWord, FCurPos, aLength) = 0) and
			not IsCharAlphaNumeric((FCurPos + aLength)^)
		then begin
			aResWordID := aWords[i].ID;
			Inc(FCurPos, aLength);
			Result := AcceptToken(True);
			Exit;
		end;
	end;

	Result := AcceptToken(False);
end;

function TStrParser.NextTokenIsResWordID(const aWords: array of TResWord; aTestID: Integer):
	Boolean;
var
	aWord: PChar;
	aLength: Word;
	i: Integer;
begin
	NewToken;

	for i := Low(aWords) to High(aWords) do begin
		aWord := aWords[i].Name;
		aLength := StrLen(aWord);
		if (AnsiLICompare(aWord, FCurPos, aLength) = 0) and
			not IsCharAlphaNumeric((FCurPos + aLength)^)
		then begin
			Inc(FCurPos, aLength);
			Result := AcceptToken((aWords[i].ID = aTestID) or (aTestID = -1));
			Exit;
    end;
  end;

  Result := AcceptToken(False);
end;

function TStrParser.NextTokenIsAlphaNumeric: Boolean;

	function IsCharAlpha(aC: Char): Boolean;
	begin
		Result := Windows.IsCharAlpha(aC) or (aC = '_');
	end;
	
  function IsCharAlphaNumeric(aC: Char): Boolean;
  begin
    Result := Windows.IsCharAlphaNumeric(aC) or (aC = '_');
  end;

begin
  NewToken;

  if IsCharAlpha(FCurPos^) then begin
    Result := True;
    while IsCharAlphaNumeric(FCurPos^) do
			ReadChar;
  end
  else
    Result := False;

  AcceptToken(Result);
end;

function TStrParser.NextTokenIsFunction: Boolean;

	function IsCharAlpha(aC: Char): Boolean;
	begin
		Result := Windows.IsCharAlpha(aC) or (aC = '_');
	end;

	function IsCharAlphaNumeric(aC: Char): Boolean;
	begin
		Result := Windows.IsCharAlphaNumeric(aC) or (aC = '_');
	end;

begin
	NewToken;
	Result := False;
	if IsCharAlpha(FCurPos^) then begin
		while IsCharAlphaNumeric(FCurPos^) do
			ReadChar;
		SkipBlanks;
		if FCurPos^ = '(' then begin
			Inc(FCurPos);
			Result := True;
		end;
	end;
	AcceptToken(Result);
end;

function TStrParser.NextTokenIsNumber(const aDecimalSeps: string; out anIsInteger: Boolean): Boolean;

	procedure ReadDigits;
	begin
		while FCurPos^ in ['0'..'9'] do
			ReadChar;
	end;

	procedure ReadHexDigits;
	begin
		while FCurPos^ in ['0'..'9', 'A'..'F', 'a'..'f'] do
			ReadChar;
	end;

begin
	NewToken;
	anIsInteger := True;
	if FCurPos^ in ['-', '+'] then begin
		ReadChar;
		SkipBlanks;
	end;
	
	if FCurPos^ = '$' then begin
		ReadChar;
		ReadHexDigits;
		try
			StrToInt(Token);
			Result := True;
		except
			Result := False;
		end;
	end
	else begin
		ReadDigits;
		if Pos(FCurPos^, aDecimalSeps) <> 0 then begin
			anIsInteger := False;
			ReadChar;
			FToken[Length(FToken)] := DecimalSeparator;
			ReadDigits;
		end;
		if FCurPos^ in ['e', 'E'] then begin
			anIsInteger := False;
			ReadChar;
			if FCurPos^ in ['-', '+'] then
				ReadChar;
			ReadDigits;
		end;
		Result := Token <> '';
		if Result then
			try
				StringToFloat(Token);
			except
				Result := False;
			end;
	end;
	AcceptToken(Result);
end;

function TStrParser.NextTokenIsNumeric: Boolean;
begin
  NewToken;
	if FCurPos^ in ['-', '+'] then
		ReadChar;
	while (FCurPos^ >= '0') and (FCurPos^ <= '9') do
		ReadChar;
	Result := (Token <> '') and not IsCharAlphaNumeric(FCurPos^);
	if Result then
		try
			StrToInt(Token)
		except
			Result := False
		end;
	AcceptToken(Result);
end;

function TStrParser.NextTokenIsFloat: Boolean;
begin
	NewToken;
	if FCurPos^ in ['-', '+'] then
		ReadChar;
	while (FCurPos^ >= '0') and (FCurPos^ <= '9') do
		ReadChar;
	if (FCurPos^ = '.') or (FCurPos^ = ',') then begin
		ReadChar;
		FToken[Length(FToken)] := DecimalSeparator;
	end;
	while (FCurPos^ >= '0') and (FCurPos^ <= '9') do
		ReadChar;
	if FCurPos^ in ['e', 'E'] then begin
		ReadChar;
		if FCurPos^ in ['-', '+'] then
			ReadChar;
		while (FCurPos^ >= '0') and (FCurPos^ <= '9') do
			ReadChar;
	end;
	Result := Token <> '';
	if Result then
		try
			StringToFloat(Token);
		except
			Result := False
		end;
	AcceptToken(Result);
end;

procedure TStrParser.SkipTo(const s: String);
begin
	FCurPos := AnsiStrPos(FCurPos, PChar(s));
	if Assigned(FCurPos) then begin
		Inc(FCurPos, Length(s));
		if Offset <= Length(FSource) then begin
			SkipBlanks;
			Exit
		end;
	end;
	Offset := Length(FSource)
end;

function TStrParser.NextTokenIsInBrackets(aLeft, aRight: Char): Boolean;
begin
  NewToken;
	if FCurPos^ = aLeft then begin
    Inc(FCurPos);
		while (FCurPos^ <> #0) and (FCurPos^ <> aRight) do
			ReadChar;
		if FCurPos^ = aRight then
			Inc(FCurPos);
		Result := True;
	end
	else
		Result := False;
	AcceptToken(Result);
end;

function TStrParser.NextTokenIsQuoted(const aLeft, aRight: string): Boolean;
var
	c: char;
	i: Integer;
begin
	NewToken;
	if Length(aLeft) <> Length(aRight) then
		raise EStrParser.Create(Self, 'Длины наборов кавычек не совпадают');

	Result := False;
	i := Pos(FCurPos^, aLeft);
	if i > 0 then begin
		c := aRight[i];
		Inc(FCurPos);
		while not Eof and (FCurPos^ <> c) do
			ReadChar;
		if not Eof then begin
			Inc(FCurPos);
			Result := True;
		end;
	end;
	AcceptToken(Result);
end;

function TStrParser.NextTokenIsRestricted(const aRight: string): Boolean;
begin
	NewToken;

	while not Eof and (Pos(FCurPos^, aRight) = 0) do
		ReadChar;
	Result := Length(Token) > 0;
	AcceptToken(Result);
end;

function TStrParser.NextTokenIsOp(const anOps: array of TResWord; var aResWordID: Integer): Boolean;
var
	anOp: PChar;
	aLen: Word;
	i: Integer;
begin
	NewToken;

	Result := False;
	for i := Low(anOps) to High(anOps) do begin
		anOp := anOps[i].Name;
		aLen := StrLen(anOp);
		if StrLComp(anOp, FCurPos, aLen) = 0 then begin
			aResWordID := anOps[i].ID;
			Inc(FCurPos, aLen);
			Result := True;
			break;
		end;
	end;

	AcceptToken(Result);
end;

function TStrParser.NextTokenIsWord(const aWord: String): Boolean;
var
	aLength: Word;
begin
	NewToken;
	aLength := Length(aWord);
	if (AnsiLICompare(PChar(aWord), FCurPos, aLength) = 0) and
		not IsCharAlphaNumeric((FCurPos + aLength)^)
	then begin
		Inc(FCurPos, aLength);
		Result := AcceptToken(True);
	end
	else
		Result := AcceptToken(False);
end;

procedure TStrParser.ExpectWord(const aWord: string);
begin
  if not NextTokenIsWord(aWord) then
    raise EStrParser.CreateFmt(Self, 'Ожидается: ''%s''', [aWord]);
end;

procedure TStrParser.Expect(const aTest: string; aCase: TTokenCase);
begin
  if not NextTokenIs(aTest, aCase) then
    raise EStrParser.Create(Self, 'Ожидается: ''' + aTest + '''');
end;

procedure TStrParser.ExpectResWord(const aWords: array of TResWord; var aResWordID: Integer);
var
	s: string;
	i: Integer;
begin
	if not NextTokenIsResWord(aWords, aResWordID) then begin
		s := '';
		for i := Low(aWords) to High(aWords) do
			if s = '' then
				s := aWords[i].Name
			else
				s := s + ', ' + aWords[i].Name;
		raise EStrParser.Create(Self, 'Ожидается: ' + s);
	end;
end;

function TStrParser.ExpectNumeric: Integer;
begin
  if not NextTokenIsNumeric then
		raise EStrParser.Create(Self, 'Ожидается целое число');
	Result := StrToInt(Token);
end;

function TStrParser.ExpectFloat: Double;
begin
  if not NextTokenIsFloat then
		raise EStrParser.Create(Self, 'Ожидается вещественное число');
	Result := StringToFloat(Token);
end;

function TStrParser.ExpectAlphaNumeric: String;
begin
  if not NextTokenIsAlphaNumeric then
		raise EStrParser.Create(Self, 'Ожидается идентификатор');
	Result := Token;
end;

function TStrParser.ExpectInBrackets(aLeft, aRight: Char): String;
begin
	if not NextTokenIsInBrackets(aLeft, aRight) then
		raise EStrParser.Create(Self, 'Ожидается строка а скобках: ' + aLeft + '...' + aRight);
	Result := Token;
end;

{	TTextReader }

constructor TTextReader.Create(aStream: TStream; aBufSize: Word);
begin
	inherited Create;
	Stream := aStream;
	BufSize := aBufSize;
	Buffer := AllocMem(aBufSize);
  BufEnd := Buffer + 1;
  BufPos := Buffer;
  GotoNextChar;
end;

destructor TTextReader.Destroy;
begin
  if Assigned(Buffer) then
    FreeMem(Buffer, BufSize);
  inherited Destroy;
end;

procedure TTextReader.GotoNextChar;
begin
  Inc(BufPos);
  if BufPos = BufEnd then begin
    BufEnd := Buffer + Min(BufSize, Stream.Size - Stream.Position);
    Stream.ReadBuffer(Buffer^, BufEnd - Buffer);
    BufPos := Buffer;
  end;
end;
{
procedure TTextReader.GotoPrevChar;
begin
	if BufPos = Buffer then begin
		Stream.Seek(-Longint(BufEnd - Buffer), 1);
		BufEnd := Buffer + LMin(BufSize, Stream.Position);
		Stream.Seek(-Longint(BufEnd - Buffer), 1);
		Stream.Read(Buffer^, BufEnd - Buffer);
		BufPos := BufEnd;
	end;
	Dec(BufPos);
end;
}
function TTextReader.GetPos: Longint;
begin
	Result := Stream.Position - Longint(BufEnd - BufPos);
end;

procedure TTextReader.SetPos(aPos: Longint);
begin
	if aPos <> GetPos then begin
		Stream.Seek(aPos, soFromBeginning);
		BufEnd := Buffer + 1;
		BufPos := Buffer;
		GotoNextChar;
	end;
end;

function TTextReader.ReadLine: string;

  procedure AppendFromBuffer(var aDst: String; aStartPos, anEndPos: PChar);
  var
    i, j: Integer;
  begin
    j := (anEndPos - aStartPos);
    if j = 0 then
      Exit;

    i := Length(aDst);
    SetLength(aDst, i + j);
    Move(aStartPos^, aDst[i + 1], j);
  end;

var
  aSaveBuffPos: PChar;
  aChar: Char;
begin
  Result := '';

  aSaveBuffPos := BufPos;
  while not Eof do begin

    aChar := BufPos^;
    if aChar in [^M,^J] then begin
      AppendFromBuffer(Result, aSaveBuffPos, BufPos);

      GotoNextChar;
      if not Eof and (BufPos^ in [^M,^J]) and (BufPos^ <> aChar) then
        GotoNextChar;

      aSaveBuffPos := BufPos;

      Break;
    end;

    if BufPos + 1 = BufEnd then begin
      AppendFromBuffer(Result, aSaveBuffPos, BufEnd);
      aSaveBuffPos := Buffer;
    end;
    GotoNextChar;
	end;
  AppendFromBuffer(Result, aSaveBuffPos, BufPos);

	if ConvertOemToChar and (Result <> '') then
		OemToCharBuff(PChar(Result), PChar(Result), Length(Result));
end;

procedure TTextReader.ReadLineToBuf(aBuf: PChar; aBufSize: Integer);
var
	aChar: Char;
	aSaveBuf: PChar;
begin
	aSaveBuf := aBuf;
  while (not Eof) and (aBufSize > 0) do begin
    aChar := BufPos^;
    if aChar in [^M,^J] then begin
      GotoNextChar;
      if not Eof and (BufPos^ in [^M,^J]) and (BufPos^ <> aChar) then
        GotoNextChar;
      Break;
    end;
    aBuf^ := aChar;
    Inc(aBuf);
    Dec(aBufSize);
    GotoNextChar;
  end;
	aBuf^ := #0;
	if ConvertOemToChar then
		OemToCharBuff(aSaveBuf, aSaveBuf, aBuf - aSaveBuf);
end;

function TTextReader.ReadChar: Char;
begin
	if not Eof then begin
		Result := BufPos^;
		GotoNextChar;
		if ConvertOemToChar then
			OemToCharBuff(@Result, @Result, 1);
	end
	else
		Result := #0;
end;

function TTextReader.Eof: Boolean;
begin
	Result := BufPos = BufEnd;
end;

end.
 