fpc/fcl/db/interbase/interbase.pp

{
    $Id$
    Copyright (c) 2000 by Pavel Stingl


    Interbase database & dataset
    
    Roughly based on work of FPC development team,
    especially Michael Van Canneyt 

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

unit interbase;

{$H+}

interface 

uses SysUtils, Classes, ibase60, Db;

type

  PInteger = ^integer;

  TIBDatabase = class (TDatabase)
  private
    FIBDatabaseHandle    : pointer;
    FIBTransactionHandle : pointer;
    FPassword            : string;
    FStatus              : array [0..19] of ISC_STATUS;
    FUserName            : string;
    
    procedure CheckError(ProcName : string);
  protected
    procedure DoInternalConnect; override;
    procedure DoInternalDisconnect; override;
  public
    constructor Create(AOwner : TComponent); override;

    procedure CommitTransaction; virtual;
    procedure RollbackTransaction; virtual;
    procedure StartTransaction; override;
    procedure EndTransaction; override;

    property DatabaseHandle: pointer read FIBDatabaseHandle; 
    property TransactionHandle: pointer read FIBTransactionHandle;
  published
    property Password: string read FPassword write FPassword;
    property UserName: string read FUserName write FUserName;
    
    property Connected;
    property DatabaseName;
    property KeepConnection;
    property LoginPrompt;
    property Params;
    property OnLogin;
  end;

  PIBBookmark = ^TIBBookmark;
  TIBBookmark = record
    BookmarkData: Integer;
    BookmarkFlag: TBookmarkFlag;
  end;
  
  // TStatementType indicates if SQL statement returns
  // result set.
  TStatementType = (stResult, stNoResult, stDDL);
  
  TIBDataset = class (TDataset)
  private
    FBufferSize          : longint;
    FCurrentRecord       : longint;
    FCurrStmtType        : TStatementType;
    FDatabase            : TIBDatabase;
    FFlag                : array [0..1024] of shortint;
    FIsEOF               : boolean;
    FLoadingFieldDefs    : boolean;
	FSQLPrepared		 : boolean;
    FRecordSize          : word;
    FRecordCount         : integer;
    FSQL                 : TStrings;
    FSQLDA               : PXSQLDA;
    FSQLDAAllocated      : longint;
    FStatementHandle     : pointer;
    FStatus              : array [0..19] of ISC_STATUS;
    
    FDBHandle            : pointer;
    FTRHandle            : pointer;
    
    procedure CheckError(ProcName : string);
    procedure DoAssignBuffers;
    procedure DoExecSQL;
    procedure DoFetch;
    procedure DoFreeBuffers;
    procedure DoParseSQL;
    procedure DoSQLDAAlloc(Count : longint);
    procedure DoStmtAlloc;
    procedure DoStmtDealloc;
    
    procedure SetBufExtended(Field : TField; CurrBuff,Buffer : pointer);
    procedure SetBufInteger(Field : TField; CurrBuff,Buffer : pointer);
    procedure SetBufDateTime(Field : TField; CurrBuff,Buffer : pointer; AType : integer);
    procedure SetBufString(Field : TField; CurrBuff,Buffer : pointer);
    
    function GetStmtType: TStatementType;
    
    function LoadBufferFromData(Buffer : PChar): TGetResult;
    procedure SetDatabase(Value : TIBDatabase);
    procedure SetSizes;
    procedure TranslateFieldType(AType, AScale: longint; 
      var XType: TFieldType; var XScale: word);
  protected
    function AllocRecordBuffer: PChar; override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
	function GetRecordCount: integer; override;
    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(ABookmark: Pointer); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalSetToRecord(Buffer: PChar); override;
    function IsCursorOpen: Boolean; override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property SQL : TStrings read FSQL write FSQL;
    property Database : TIBDatabase read FDatabase write SetDatabase;
  end;

implementation

type

  TTm = packed record
    tm_sec : longint;
    tm_min : longint;
    tm_hour : longint;
    tm_mday : longint;
    tm_mon : longint;
    tm_year : longint;
    tm_wday : longint;
    tm_yday : longint;
    tm_isdst : longint;
    __tm_gmtoff : longint;
    __tm_zone : Pchar;
  end;


///////////////////////////////////////////////////////////////////////
// TIBDatabase implementation
//

// PRIVATE PART of TIBDatabase

{---------------------------------------------------------------------}
{ CheckError                                                          }
{ This procedure checks IB status vector and, if found some error     }
{ condition, raises exception with IB error text                      }
{---------------------------------------------------------------------}

procedure TIBDatabase.CheckError(ProcName:string);
var
  buf : array [0..1024] of char;
  P : pointer;
  x : integer;
begin
  if ((FStatus[0] = 1) and (FStatus[1] <> 0)) then
  begin
    p := @FStatus;
    isc_interprete(Buf, @p);
    raise Exception.Create(ProcName + ': ' + StrPas(buf));
  end;
end;


// PROTECTED PART of TIBDatabase

procedure TIBDatabase.DoInternalConnect;
var
  DPB : string;
begin
  if Connected then
    Close;    
  DPB := chr(isc_dpb_version1);
  if (FUserName <> '') then
  begin
    DPB := DPB + chr(isc_dpb_user_name) + chr(Length(FUserName)) + FUserName;
    if (FPassword <> '') then
      DPB := DPB + chr(isc_dpb_password) + chr(Length(FPassword)) + FPassword;
  end;
  if (DatabaseName = '') then
    raise Exception.Create('TIBDatabase.Open: Database connect string not filled in!');
  FIBDatabaseHandle := nil;
  if isc_attach_database(@FStatus, Length(DatabaseName), @DatabaseName[1], @FIBDatabaseHandle, 
         Length(DPB), @DPB[1]) <> 0 then
    CheckError('TIBDatabase.Open');
end;

procedure TIBDatabase.DoInternalDisconnect;
begin
  if not Connected then
  begin
    FIBDatabaseHandle := nil;
    Exit;
  end;
  isc_detach_database(@FStatus[0], @FIBDatabaseHandle);
  CheckError('TIBDatabase.Close');
end;


// PUBLIC PART of TIBDatabase

constructor TIBDatabase.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FIBDatabaseHandle := nil;
  FIBTransactionHandle := nil;
  FUserName := '';
  FPassword := '';
end;

procedure TIBDatabase.CommitTransaction;
begin
  if FIBTransactionHandle <> nil then
    if isc_commit_retaining(@FStatus, @FIBTransactionHandle) <> 0 then
      CheckError('TIBDatabase.CommitTransaction');
end;

procedure TIBDatabase.RollbackTransaction;
begin
  if FIBTransactionHandle <> nil then
    if isc_rollback_retaining(@FStatus, FIBTransactionHandle) <> 0 then
      CheckError('TIBDatabase.RollbackTransaction');
end;

procedure TIBDatabase.StartTransaction;
begin
  if FIBTransactionHandle = nil then
  begin
    if isc_start_transaction(@FStatus, @FIBTransactionHandle, 1, [@FIBDatabaseHandle, 0, nil]) <> 0 then
      CheckError('TIBDatabase.StartTransaction');
  end;
end;

procedure TIBDatabase.EndTransaction;
begin
  if FIBTransactionHandle <> nil then
  begin
    if isc_commit_transaction(@FStatus, @FIBTransactionHandle) <> 0 then
      CheckError('TIBDatabase.EndTransaction');
    FIBTransactionHandle := nil;
  end;
end;


///////////////////////////////////////////////////////////////////////
// TIBDataset implementation
//

// PRIVATE PART

procedure TIBDataset.CheckError(ProcName : string);
var
  buf : array [0..1024] of char;
  P : pointer;
  Msg : string;
  x : integer;
begin
  if ((FStatus[0] = 1) and (FStatus[1] <> 0)) then
  begin
    p := @FStatus;
    while isc_interprete(Buf, @p) > 0 do
      Msg := Msg + #10' -' + StrPas(Buf);
    raise Exception.Create(ProcName + ': ' + Msg);
  end;
end;

procedure TIBDataset.DoAssignBuffers;
var
  Buf : PChar;
  x   : longint;
begin
  for x := 0 to FSQLDA^.SQLD - 1 do
  begin
    Buf := AllocMem(FSQLDA^.SQLVar[x].SQLLen);
    FSQLDA^.SQLVar[x].SQLData := Buf;
    FSQLDA^.SQLVar[x].SQLInd  := @FFlag[x];
  end;
end;

procedure TIBDataset.DoExecSQL;
begin
  if isc_dsql_execute(@FStatus, @FTrHandle, @FStatementHandle, 1, nil) <> 0 then
    CheckError('TIBDataset.DoExecSQL');
end;

procedure TIBDataset.DoFetch;
var
  Res : longint;
begin
  if FCurrStmtType <> stResult then Exit;
  Res := isc_dsql_fetch(@FStatus, @FStatementHandle, 1, FSQLDA);
  if (Res <> 100) then
    CheckError('TIBDataset.DoFetch');
  FIsEOF := (Res = 100);
end;

procedure TIBDataset.DoFreeBuffers;
var
  x   : longint;
begin
  for x := 0 to FSQLDA^.SQLD - 1 do
    if (FSQLDA^.SQLVar[x].SQLData <> nil) then
      FreeMem(FSQLDA^.SQLVar[x].SQLData);
end;

procedure TIBDataset.DoParseSQL;
var
  Buf      : string;
  x        : longint;
begin
  if FSQL.Count < 1 then
    raise Exception.Create('TIBDataset.DoParseSQL: Empty SQL statement');

  Buf := '';
  for x := 0 to FSQL.Count - 1 do
    Buf := Buf + FSQL[x] + ' ';

  if isc_dsql_prepare(@FStatus, @FTrHandle, @FStatementHandle, 0, @Buf[1], 1, nil) <> 0 then    CheckError('TIBDataset.DoParseSQL - Prepare');
    
  if isc_dsql_describe(@FStatus, @FStatementHandle, 1, FSQLDA) <> 0 then
    CheckError('TIBDataset.DoParseSQL - Describe');

  if FSQLDA^.SQLN < FSQLDA^.SQLD then
  begin
    x := FSQLDA^.SQLD;
    DoSQLDAAlloc(x);
    if isc_dsql_describe(@FStatus, @FStatementHandle, 1, FSQLDA) <> 0 then
      CheckError('TIBDataset.DoParseSQL - Describe');
  end;
  
  FCurrStmtType := GetStmtType;
  FSQLPrepared := True;  
end;

procedure TIBDataset.DoSQLDAAlloc(Count : longint);
begin
  if FSQLDAAllocated > 0 then
    FreeMem(FSQLDA, XSQLDA_Length * FSQLDAAllocated);
  GetMem(FSQLDA, XSQLDA_Length * Count);
  FSQLDAAllocated := Count;
  FSQLDA^.Version := SQLDA_VERSION1;
  FSQLDA^.SQLN := Count;
end;

procedure TIBDataset.DoStmtAlloc;
begin
  if not FDatabase.Connected then
    FDatabase.Open;
  if FDatabase.TransactionHandle = nil then
    FDatabase.StartTransaction;
  FDBHandle := FDatabase.DatabaseHandle;
  FTRHandle := FDatabase.TransactionHandle;

  if isc_dsql_allocate_statement(@FStatus, @FDBHandle, @FStatementHandle) <> 0 then
    CheckError('TIBDataset.DoStmtAlloc');
end;

procedure TIBDataset.DoStmtDealloc;
begin
  if isc_dsql_free_statement(@FStatus, @FStatementHandle, DSQL_Drop) <> 0 then
    CheckError('TIBDataset.DoStmtDealloc');
  FStatementHandle := nil;
end;

function TIBDataset.GetStmtType: TStatementType;
var
  ResBuf : array [0..7] of char;
  x : integer;
  SType : integer;
begin
  x := isc_info_sql_stmt_type;
  isc_dsql_sql_info(@FStatus, @FStatementHandle, SizeOf(x),
    @x, SizeOf(ResBuf), @ResBuf);
  if Ord(ResBuf[0]) = isc_info_sql_stmt_type then
  begin
    x := isc_vax_integer(@ResBuf[1], 2);
    SType := isc_vax_integer(@ResBuf[3], x);
  end;
  case SType of
    isc_info_sql_stmt_select:
      Result := stResult;
    isc_info_sql_stmt_insert, isc_info_sql_stmt_update,
    isc_info_sql_stmt_delete:
      Result := stNoResult;
    else Result := stDDL;
  end;
end;

function TIBDataset.LoadBufferFromData(Buffer : PChar): TGetResult;
var
  x : integer;
  p : word;
  T : TISC_TIMESTAMP;
begin
  DoFetch;
  if FIsEOF then
    Result := grEOF
  else begin
    for x := 0 to FSQLDA^.SQLD - 1 do
    begin
      if (FSQLDA^.SQLVar[x].SQLType = SQL_VARYING) or
         (FSQLDA^.SQLVar[x].SQLType = SQL_VARYING + 1) then
      begin
        Move(FSQLDA^.SQLVar[x].SQLData^, P, 2);
    	Move((FSQLDA^.SQLVar[x].SQLData + 2)^, Buffer^, P);
        PChar(Buffer+P)^ := #0;
      end
	  else
    	Move(FSQLDA^.SQLVar[x].SQLData^, Buffer^, FSQLDA^.SQLVar[x].SQLLen);
      Inc(Buffer,FSQLDA^.SQLVar[x].SQLLen);
    end;
    Result := grOK;
  end;
end;

procedure TIBDataset.SetDatabase(Value : TIBDatabase);
begin
  CheckInactive;
  If Value<>FDatabase then
  begin
    if Value<>Nil Then
      FDatabase:=Value; 
  end;
end;

procedure TIBDataset.SetSizes;
var
  x : integer;
begin
  FRecordSize := 0;
  FBufferSize := 0;
  for x := 0 to FSQLDA^.SQLD - 1 do
  begin
    Inc(FRecordSize, FSQLDA^.SQLVar[x].SQLLen);
  end;
  FBufferSize := FRecordSize + SizeOf(TIBBookmark);
end;

procedure TIBDataset.TranslateFieldType(AType, AScale: longint; 
  var XType: TFieldType; var XScale: word);
begin
  case AType of
    SQL_TEXT, SQL_VARYING, SQL_TEXT+1, SQL_VARYING+1:
      begin
        XType := ftString;
        XScale := AScale;
      end;
    SQL_DOUBLE, SQL_DOUBLE+1: 
      begin
        XType := ftFloat;
        XScale := AScale;
      end;
    SQL_LONG, SQL_LONG+1, SQL_SHORT, SQL_SHORT+1: 
      begin
        XType := ftInteger;
        XScale := AScale;
      end;
{    SQL_DATE, SQL_DATE+1, SQL_TIME, SQL_TIME+1,}
    SQL_TYPE_TIME:
      begin
        XType := ftTime;
        XScale := AScale;
      end;
    SQL_TYPE_DATE:
      begin
        XType := ftDate;
        XScale := AScale;
      end;
    SQL_FLOAT,SQL_FLOAT+1:
      begin
        XType := ftFloat;
        XScale := AScale;
      end;
    SQL_TIMESTAMP, SQL_TIMESTAMP+1: 
      begin
        XType := ftDateTime;
        XScale := AScale;
      end;
  end;
end;


// PROTECTED PART

function TIBDataset.AllocRecordBuffer: PChar;
begin
  Result := AllocMem(FBufferSize);
end;

procedure TIBDataset.FreeRecordBuffer(var Buffer: PChar);
begin
  FreeMem(Buffer);
end;

procedure TIBDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PInteger(Data)^ := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
end;

function TIBDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag;
end;

procedure TIBDataset.SetBufExtended(Field : TField; CurrBuff,Buffer : pointer);
var
  E    : extended;
  D    : double;
  S    : single;
begin
  case Field.Size of
    4    : 
      begin
        Move(CurrBuff^,S,4);
        E := S;
      end;
    8    :
      begin
        Move(CurrBuff^,D,8);
        E := D;
      end;
    10   : Move(CurrBuff^,E,10);
  end;
  Move(E, Buffer^, 10);
end;

procedure TIBDataset.SetBufInteger(Field : TField; CurrBuff,Buffer : pointer);
var
  I    : integer;
begin
  I := 0;
  Move(I, Buffer^, SizeOf(Integer));
  Move(CurrBuff^, Buffer^, Field.Size);
end;

procedure TIBDataset.SetBufDateTime(Field : TField; CurrBuff,Buffer : pointer; AType : integer);
var
  D    : TDateTime;
  S    : TSystemTime;
  TM   : TTm;
  TT   : TIsc_timestamp;
begin
  case AType of
    SQL_TYPE_DATE: 
      isc_decode_sql_date(PISC_DATE(CurrBuff), @TM);
    SQL_TYPE_TIME:
      isc_decode_sql_time(PISC_TIME(CurrBuff), @TM);
    SQL_TIMESTAMP, SQL_TIMESTAMP+1:
      isc_decode_timestamp(PISC_TIMESTAMP(CurrBuff), @TM);
  end;
  S.Year := TM.tm_year + 1900;
  S.Month := TM.tm_mon + 1;
  S.Day := TM.tm_mday;
  S.Hour := TM.tm_hour;
  S.Minute := TM.tm_min;
  S.Second := TM.tm_sec;
  S.Millisecond := 0;
  D := SystemTimeToDateTime(S);
  {$warning !!! D is okay, but Field.AsDateTime returns wrong value !!! } 
//  WriteLn(DateTimeToStr(D));
  Move(D, Buffer^, SizeOf(D));
end;

procedure TIBDataset.SetBufString(Field : TField; CurrBuff,Buffer : pointer);
begin
  Move(CurrBuff^, Buffer^, Field.Size);
  PChar(Buffer + Field.Size)^ := #0;
end;

function TIBDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  x        : longint;
  CurrBuff : PChar;
begin
  Result := False;
  CurrBuff := ActiveBuffer;
  for x := 0 to FSQLDA^.SQLD - 1 do
  begin
    if (Field.FieldName = FSQLDA^.SQLVar[x].SQLName) then
    begin

      case Field.DataType of
        ftFloat:  
          SetBufExtended(Field, CurrBuff, Buffer);
        ftString: 
          SetBufString(Field, CurrBuff, Buffer);
        ftDate,ftTime,ftDateTime:
          SetBufDateTime(Field, CurrBuff, Buffer, FSQLDA^.SQLVar[x].SQLType);
        ftInteger:
          SetBufInteger(Field, CurrBuff, Buffer);
      end;

      Result := True;

      break; 
    end
    else Inc(CurrBuff, FSQLDA^.SQLVar[x].SQLLen);
  end;
end;

function TIBDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
  if FCurrStmtType <> stResult then Exit;
  if FIsEOF then 
    Result := grEOF
  else begin
	Result := grOk;
    case GetMode of
	  gmPrior: 
		if FCurrentRecord <= 0 then
		begin
		  Result := grBOF;
		  FCurrentRecord := -1;
		end
		else Dec(FCurrentRecord);
	  gmCurrent:
		if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
		  Result := grError;
      gmNext: 
		if FCurrentRecord >= (RecordCount - 1) then
        begin
		  Result := LoadBufferFromData(Buffer);
          if Result = grOk then 
          begin
            Inc(FCurrentRecord);
            Inc(FRecordCount);
          end;
        end
		else Inc(FCurrentRecord);
    end;

    if Result = grOK then
    begin
      with PIBBookmark(Buffer + FRecordSize)^ do
      begin
        BookmarkData := FCurrentRecord;
        BookmarkFlag := bfCurrent;
      end;               
    end
    else if (Result = grError) {and (DoCheck)} then
      DatabaseError('No record');
  end;
end;

function TIBDataset.GetRecordCount: integer;
begin
  Result := FRecordCount;
end;

function TIBDataset.GetRecordSize: Word;
begin
  Result := FRecordSize;
end;

procedure TIBDataset.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
begin
end;

procedure TIBDataset.InternalClose;
begin
  DoFreeBuffers;
  DoStmtDealloc;
  if DefaultFields then
    DestroyFields;
  FIsEOF := False;
  FCurrentRecord := -1;
  FBufferSize := 0;
  FRecordSize := 0;
  FRecordCount := 0;
//  DoSQLDAAlloc(50);
end;

procedure TIBDataset.InternalDelete;
begin
end;

procedure TIBDataset.InternalFirst;
begin
  FCurrentRecord := -1;
end;

procedure TIBDataset.InternalGotoBookmark(ABookmark: Pointer);
begin
  FCurrentRecord := PInteger(ABookmark)^;
end;

procedure TIBDataset.InternalHandleException;
begin
  // not implemented
end;

procedure TIBDataset.InternalInitFieldDefs;
var
  x       : longint;
  TransFt : TFieldType;
  TransSz : word;
begin
  if FLoadingFieldDefs then 
  begin
    WriteLn('Loading FieldDefs...');
    Exit;
  end;
  
  FLoadingFieldDefs := True;
  
  try
    try
      FieldDefs.Clear;
      for x := 0 to FSQLDA^.SQLD - 1 do
      begin
        TranslateFieldType(FSQLDA^.SQLVar[x].SQLType, FSQLDA^.SQLVar[x].SQLLen,
          TransFt, TransSz);
        TFieldDef.Create(FieldDefs,
          FSQLDA^.SQLVar[x].SQLName, 
          TransFt, TransSz, False, (x+1));
      end;
    finally
    end;
  finally
    FLoadingFieldDefs := False;
  end;
end;

procedure TIBDataset.InternalInitRecord(Buffer: PChar);
begin
  FillChar(Buffer^, FBufferSize, #0);
end;

procedure TIBDataset.InternalLast;
begin
  FCurrentRecord := RecordCount;
end;

procedure TIBDataset.InternalOpen;
begin
  try
    DoStmtAlloc;
    DoParseSQL;
    if FCurrStmtType = stResult then
    begin
      DoAssignBuffers;
      DoExecSQL;
      InternalInitFieldDefs;
      if DefaultFields then
        CreateFields;
      SetSizes;
      BindFields(True);
    end
    else DoExecSQL;
  except
	raise;
  end;
  
end;

procedure TIBDataset.InternalPost;
begin
end;

procedure TIBDataset.InternalSetToRecord(Buffer: PChar);
begin
  FCurrentRecord := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
end;

function TIBDataset.IsCursorOpen: Boolean;
begin
  Result := FStatementHandle <> nil; //??
end;

procedure TIBDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
end;

procedure TIBDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PIBBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
end;

procedure TIBDataset.SetFieldData(Field: TField; Buffer: Pointer);
begin
end;

// PUBLIC PART

constructor TIBDataset.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FSQL := TStringList.Create;
  FIsEOF := False;
  FCurrentRecord := -1;
  FBufferSize := 0;
  FRecordSize := 0;
  FRecordCount := 0;
  DoSQLDAAlloc(50);
end;

destructor TIBDataset.Destroy;
begin
  FSQL.Free;
  inherited Destroy;
  FreeMem(FSQLDA, XSQLDA_Length * FSQLDAAllocated);
end;

end.

{
  $Log$
  Revision 1.1  2000-07-13 06:31:28  michael
  + Initial import

  Revision 1.1  2000/06/04 08:15:42  michael
  + Initial implementation in FCL

  Revision 1.1.1.1  2000/06/02 06:56:37  stingp1
  Initial release

}