unit untExtFiles;

interface

const
  MaxRecSize = 65530;
type
  TIBRecord = class
  private
    FLine: array[0..MaxRecSize] of AnsiChar;
    FPos: Integer;
    function GetLine: AnsiString;
  public
    procedure AppendInteger(AValue: Integer);
    procedure AppendSmallInt(AValue: SmallInt);
    procedure AppendFloat(AValue: Int64);
    procedure AppendNumeric(AValue: Int64; Scale: Integer);
    procedure AppendDate(AValue: TDateTime);
    procedure AppendTimeStamp(AValue: TDateTime);
    procedure AppendTime(AValue: TDateTime);
    procedure AppendChar(AValue: AnsiString; ASize: Integer);
    procedure AppendVarChar(AValue: AnsiString; ASize: Integer);
    procedure CheckOffset(ANextSize: Integer; AChar: Boolean);
    procedure Reset;
    constructor Create;
    property Line: AnsiString read GetLine;
    property Pos: Integer read FPos write FPos;
  end;

implementation

procedure TIBRecord.AppendChar(AValue: AnsiString; ASize: Integer);
var
  Tmp: Integer;
begin
  CheckOffset(ASize, True);

  Tmp:= Length(AValue);
  if Tmp > ASize then
    Tmp := ASize;

  SetLength(AValue, ASize);
  FillChar(FLine[FPos], ASize, 32);
  Move(AValue[1], FLine[FPos], Tmp);
  Inc(FPos, ASize);
end;

procedure TIBRecord.AppendDate(AValue: TDateTime);
var
  dInt: Integer;
begin
  CheckOffset(4, False);
  dInt := Trunc(AValue) + 15018;
  Move(dInt, FLine[FPos], 4);
  Inc(FPos, 4);
end;

procedure TIBRecord.AppendFloat(AValue: Int64);
begin
  CheckOffset(8, False);
  Move(AValue, FLine[FPos], 8);
  Inc(FPos, 8);
end;

procedure TIBRecord.AppendInteger(AValue: Integer);
begin
  CheckOffset(4, False);
  Move(AValue, FLine[FPos], 4);
  Inc(FPos, 4);
end;

procedure TIBRecord.AppendNumeric(AValue: Int64; Scale: Integer);
const
  E: array[0..18] of Int64 = (1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000,
  10000000000,100000000000,1000000000000,10000000000000,100000000000000,
  1000000000000000,10000000000000000,100000000000000000,1000000000000000000);
var
  dInt: Int64;
begin
  CheckOffset(8, False);
  AValue:= AValue*E[Scale];
  Move(AValue, FLine[FPos], 8);
  Inc(FPos, 8);
end;

procedure TIBRecord.AppendSmallInt(AValue: SmallInt);
begin
  CheckOffset(2, False);
  Move(AValue, FLine[FPos], 2);
  Inc(FPos, 2);
end;

procedure TIBRecord.AppendTime(AValue: TDateTime);
const
  MSecsPerDay10 = 24 * 60 * 60 * 1000 * 10;
var
  dInt: Integer;
begin
  dInt := Trunc(Frac(AValue)*MSecsPerDay10);
  Move(dInt, FLine[FPos], 4);
  Inc(FPos, 4);
end;

procedure TIBRecord.AppendTimeStamp(AValue: TDateTime);
const
  MSecsPerDay10 = 24 * 60 * 60 * 1000 * 10;
var
  dInt: Int64;
begin
  CheckOffset(8, False);
  dInt:= Trunc(AValue) + 15018 + (Trunc(Frac(AValue)*MSecsPerDay10) shl 32);
  Move(dInt, FLine[FPos], 8);
  Inc(FPos, 8);
end;

procedure TIBRecord.AppendVarChar(AValue: AnsiString; ASize: Integer);
var
  Tmp: Integer;
begin
  if (ASize mod 2) = 1 then
    Inc(ASize);

  Tmp:= Length(AValue);
  if Tmp > ASize then
    Tmp := ASize;

  CheckOffset(ASize + 2, True);
  SetLength(AValue, ASize);
  Move(Tmp, FLine[FPos], 2);
  Inc(FPos, 2);
  Move(AValue[1], FLine[FPos], Tmp);
  Inc(FPos, ASize);
end;

procedure TIBRecord.CheckOffset(ANextSize: Integer; AChar: Boolean);
begin
  if (ANextSize mod 4) = 0 then
    Inc(FPos, ANextSize-(FPos mod ANextSize));
end;

constructor TIBRecord.Create;
begin
  Reset;
end;

function TIBRecord.GetLine: AnsiString;
begin
  SetLength(Result, FPos);
  Move(FLine, Result[1], FPos);
end;

procedure TIBRecord.Reset;
begin
  FPos := 0;
  FillChar(FLine, SizeOf(FLine), 0);
end;

end.