<commit_before>{
   Firebird Library
   Open Source Library No Data Aware for direct access to Firebird
   Relational Database from Borland Delphi / Kylix and Freepascal

   File:FBLDataset.pas
   Copyright (c) 2006 <NAME>
   <EMAIL>
   http://fblib.altervista.org

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.

   This library 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.  See the GNU
   Lesser General Public License for more details.
}

{$I fbl.inc}

{
@abstract(Dataset components)
@author(<NAME> <<EMAIL>>)
FbLib - Firebird Library @html(<br>)
FBLDataset.pas unit contains TDataset descendant components
}

unit FBLDataset;

interface
uses
  SysUtils, Classes, DB, FBLDsql, FBLTransaction, ibase_h 
  {$IFDEF D6P},FMTBcd{$ENDIF};

type
   EFBLDatasetError = class(Exception);

   {$IFDEF FPC}
   TFBLBookmark = record
    BookMark: LongInt;
    BookMarkFlag: TBookmarkFlag;
   end;
   PFBLBookmark = ^TFBLBookmark;
   {$ENDIF}

  {@abstract(TDataset descendant <unidirectional> <readonly>)}
  TFBLCustomDataset = class(TDataSet)
  private
    FIsOpen: Boolean;
    FRecordSize,
    FRecordBufferSize: Word;
    FIsEmpty,
    FReLoad: Boolean;
    FDSql: TFBLDsql;
    FAutoStartTransaction: Boolean;
    {$IFDEF FPC}
    FRecordCount: Integer;
    FCurrentRecord: Integer;
    FBlobs: TList;
    FOffset : array of Integer;
    procedure DataToBuffer(var ABuffer: PChar);
    procedure EraseBlobList;
    procedure AddToBlobList(APointer: Pointer);
    //function GetBufferListCount: Integer;
    {$ENDIF}
    procedure CheckBeforeOpen;
    procedure InternalAfterOpen;
    function GetSQL: TStrings;
    procedure SetSQL(Value: TStrings);
    function GetTransaction: TFBLTransaction;
    procedure SetTransaction(Value: TFBLTransaction);
    procedure DoOnUnPrepare(Sender: TObject);
  protected
    function GetCanModify: Boolean; override;
    function GetRecNo: LongInt; override;
    function GetRecordCount: Integer; override;
    function AllocRecordBuffer: PChar; override;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    function GetRecordSize: Word; override;
    procedure InternalOpen; override;
    procedure InternalClose; override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalFirst; override;
    procedure InternalLast; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;override;
    function IsCursorOpen: Boolean; override;
    {$IFDEF FPC}
    procedure InternalGotoBookmark(aBookmark: Pointer); override;
    procedure InternalSetToRecord(Buffer:Pchar); override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    {$ENDIF}
  public
    {$IFDEF FPC}
    {current record in buffer <freepascal only>}
    property CurrentRecord;
    {actice record in buffer <freepascal only>}
    property ActiveRecord;
    {numbers of allocated buffer <freepascal only>}
    property BufferCount;
    {number of blob fields in one record <freepascal only>}
    property BlobFieldCount;
    
    //property BufferListCount: Integer read GetBufferListCount;
    {$ENDIF}
    {Create an instace of TFBLCustomDataset}
    constructor Create(AOwen: TComponent); override;
    {Free up  all resources associated with this instance.}
    destructor Destroy; override;
    {Retrieves the current value of a field into a buffer.}
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; override; 
    {Retrieves the current value of a field into a buffer.}
    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; {$IFNDEF FPC} override; {$ENDIF }
    {Returns number of records fetched.}
    property RecordCount: Integer read GetRecordCount;
    {Returns a TBlobStream object for reading or writing the data in a specified blob field.}
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  published
    {if True call TFBLTransaction.StartTransaction  automaticcaly when open dataset}
    property AutoStartTransaction: Boolean  read FAutoStartTransaction write FAutoStartTransaction default False;
    {TFBLTransaction object  where current TFBLdataset object is attached }
    property Transaction: TFBLTransaction read GetTransaction write SetTransaction;
    {SQL Statement to execute}
    property SQL:TStrings read GetSQL write SetSQL;
  end;
  
  {@abstract(TDataset descendant <unidirectional> <readonly>)}
  TFBLDataset = class(TFBLCustomDataset)
  public
  published
    {Specifies whether or not a dataset is open.}
    property Active;
    {if True call TFBLTransaction.StartTransaction  automaticcaly when open dataset}
    property AutoStartTransaction;
     {SQL Statement to execute}
    property SQL;
    {TFBLTransaction object  where current TFBLdataset object is attached }
    property Transaction;
    {Occurs after an application closes a dataset.}
    property AfterClose;
    {Occurs after an application closes a dataset.}
    property AfterOpen;
    {Occurs after an application scrolls from one record to another.}
    property AfterScroll;
    {Occurs immediately before the dataset closes.}
    property BeforeClose;
    {Occurs before an application executes a request to open a dataset.}
    property BeforeOpen;
  end;

  {$IFDEF FPC}
  {@exclude}
  const MultFactor: array[-4..4] of Double = (0.0001,0.001,0.01,0.1,0,10,100,1000,10000);
  {$ENDIF}

implementation


constructor TFBLCustomDataset.Create(AOwen: TComponent);
begin
  inherited Create(AOwen);
  FDsql := TFBLDsql.Create(nil);
  FDsql.AutoFetchFirst := False;
  FAutoStartTransaction := False;
  {$IFDEF FPC}
  FDsql.OnUnPrepare := @DoOnUnPrepare;
  FBlobs := TList.Create;
  //FisFull := False;
  {$ELSE}
  FDsql.OnUnPrepare := DoOnUnPrepare;
  {$ENDIF}
  {$IFNDEF FPC}
    {$IFDEF D6P}
  inherited SetUniDirectional(True);
    {$ENDIF}
  {$ELSE}
    {$IFDEF VER2_0}
  IsUniDirectional := True;   // required for FPC 2.0.4
    {$ELSE}
  SetUniDirectional(True);    // required for FPC 2.1.1 (r6375)
    {$ENDIF}
  {$ENDIF}
end;

//------------------------------------------------------------------------------

destructor TFBLCustomDataset.Destroy;
begin
  //ShowMessage('Destroy');<commit_msg>* Applied patch from Funky Beast. SetUniDirectional needs to be False for FPC 2.2.x ad FPC 2.3.x<commit_after>{
   Firebird Library
   Open Source Library No Data Aware for direct access to Firebird
   Relational Database from Borland Delphi / Kylix and Freepascal

   File:FBLDataset.pas
   Copyright (c) 2006 <NAME>
   <EMAIL>
   http://fblib.altervista.org

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.

   This library 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.  See the GNU
   Lesser General Public License for more details.
}

{$I fbl.inc}

{
@abstract(Dataset components)
@author(<NAME> <<EMAIL>>)
FbLib - Firebird Library @html(<br>)
FBLDataset.pas unit contains TDataset descendant components
}

unit FBLDataset;

interface
uses
  SysUtils, Classes, DB, FBLDsql, FBLTransaction, ibase_h 
  {$IFDEF D6P},FMTBcd{$ENDIF};

type
   EFBLDatasetError = class(Exception);

   {$IFDEF FPC}
   TFBLBookmark = record
    BookMark: LongInt;
    BookMarkFlag: TBookmarkFlag;
   end;
   PFBLBookmark = ^TFBLBookmark;
   {$ENDIF}

  {@abstract(TDataset descendant <unidirectional> <readonly>)}
  TFBLCustomDataset = class(TDataSet)
  private
    FIsOpen: Boolean;
    FRecordSize,
    FRecordBufferSize: Word;
    FIsEmpty,
    FReLoad: Boolean;
    FDSql: TFBLDsql;
    FAutoStartTransaction: Boolean;
    {$IFDEF FPC}
    FRecordCount: Integer;
    FCurrentRecord: Integer;
    FBlobs: TList;
    FOffset : array of Integer;
    procedure DataToBuffer(var ABuffer: PChar);
    procedure EraseBlobList;
    procedure AddToBlobList(APointer: Pointer);
    //function GetBufferListCount: Integer;
    {$ENDIF}
    procedure CheckBeforeOpen;
    procedure InternalAfterOpen;
    function GetSQL: TStrings;
    procedure SetSQL(Value: TStrings);
    function GetTransaction: TFBLTransaction;
    procedure SetTransaction(Value: TFBLTransaction);
    procedure DoOnUnPrepare(Sender: TObject);
  protected
    function GetCanModify: Boolean; override;
    function GetRecNo: LongInt; override;
    function GetRecordCount: Integer; override;
    function AllocRecordBuffer: PChar; override;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    function GetRecordSize: Word; override;
    procedure InternalOpen; override;
    procedure InternalClose; override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalFirst; override;
    procedure InternalLast; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;override;
    function IsCursorOpen: Boolean; override;
    {$IFDEF FPC}
    procedure InternalGotoBookmark(aBookmark: Pointer); override;
    procedure InternalSetToRecord(Buffer:Pchar); override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    {$ENDIF}
  public
    {$IFDEF FPC}
    {current record in buffer <freepascal only>}
    property CurrentRecord;
    {actice record in buffer <freepascal only>}
    property ActiveRecord;
    {numbers of allocated buffer <freepascal only>}
    property BufferCount;
    {number of blob fields in one record <freepascal only>}
    property BlobFieldCount;
    
    //property BufferListCount: Integer read GetBufferListCount;
    {$ENDIF}
    {Create an instace of TFBLCustomDataset}
    constructor Create(AOwen: TComponent); override;
    {Free up  all resources associated with this instance.}
    destructor Destroy; override;
    {Retrieves the current value of a field into a buffer.}
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; override; 
    {Retrieves the current value of a field into a buffer.}
    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; {$IFNDEF FPC} override; {$ENDIF }
    {Returns number of records fetched.}
    property RecordCount: Integer read GetRecordCount;
    {Returns a TBlobStream object for reading or writing the data in a specified blob field.}
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  published
    {if True call TFBLTransaction.StartTransaction  automaticcaly when open dataset}
    property AutoStartTransaction: Boolean  read FAutoStartTransaction write FAutoStartTransaction default False;
    {TFBLTransaction object  where current TFBLdataset object is attached }
    property Transaction: TFBLTransaction read GetTransaction write SetTransaction;
    {SQL Statement to execute}
    property SQL:TStrings read GetSQL write SetSQL;
  end;
  
  {@abstract(TDataset descendant <unidirectional> <readonly>)}
  TFBLDataset = class(TFBLCustomDataset)
  public
  published
    {Specifies whether or not a dataset is open.}
    property Active;
    {if True call TFBLTransaction.StartTransaction  automaticcaly when open dataset}
    property AutoStartTransaction;
     {SQL Statement to execute}
    property SQL;
    {TFBLTransaction object  where current TFBLdataset object is attached }
    property Transaction;
    {Occurs after an application closes a dataset.}
    property AfterClose;
    {Occurs after an application closes a dataset.}
    property AfterOpen;
    {Occurs after an application scrolls from one record to another.}
    property AfterScroll;
    {Occurs immediately before the dataset closes.}
    property BeforeClose;
    {Occurs before an application executes a request to open a dataset.}
    property BeforeOpen;
  end;

  {$IFDEF FPC}
  {@exclude}
  const MultFactor: array[-4..4] of Double = (0.0001,0.001,0.01,0.1,0,10,100,1000,10000);
  {$ENDIF}

implementation


constructor TFBLCustomDataset.Create(AOwen: TComponent);
begin
  inherited Create(AOwen);
  FDsql := TFBLDsql.Create(nil);
  FDsql.AutoFetchFirst := False;
  FAutoStartTransaction := False;
  {$IFDEF FPC}
  FDsql.OnUnPrepare := @DoOnUnPrepare;
  FBlobs := TList.Create;
  //FisFull := False;
  {$ELSE}
  FDsql.OnUnPrepare := DoOnUnPrepare;
  {$ENDIF}
  {$IFNDEF FPC}
    {$IFDEF D6P}
  inherited SetUniDirectional(True);
    {$ENDIF}
  {$ELSE}
    {$IFDEF VER2_0}
  IsUniDirectional := True;   // required for FPC 2.0.4
    {$ELSE}
  SetUniDirectional(True);    // required for FPC 2.1.1 (r6375)
    {$ENDIF}
    {$IF defined(VER2_2) or defined(VER2_3_1)}
  SetUniDirectional(False);
    {$ENDIF}
  {$ENDIF}
end;

//------------------------------------------------------------------------------

destructor TFBLCustomDataset.Destroy;
begin
  //ShowMessage('Destroy');
{'fraction_non_alphanumeric': 0.0894952840377277, 'fraction_numerical': 0.007991936064511485, 'mean_word_length': 3.932528409090909, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4842046', 'n_tokens_mistral': 4086, 'n_tokens_neox': 3981, 'n_words': 1319}