virtualdataset.pas

delphi通过OCI访问ORACLE

unit VirtualDataSet;

{$INCLUDE dOCI.inc}

{
 Descendant of TDataSet

 This is a wrapper of TDataSet, for implementing Delphi specific functions.

}


{
 Data in buffers are stores in BDE compatible format
  ftInteger - as integer(4 bytes)
  ftSmallInt - as smallint(2 bytes)
  ftFloat   - as double (8 bytes)
  ftCurrency - as double(8 bytes)
  ftDate - as TDateTimeRec
  ftTime - as TDateTimeRec
  ftDateTime - as TDateTimeRec
  ftWord - as Word(2 bytes)
  ftBoolean - as WordBool(2 bytes)
  ftBlob,ftMemo - as pointer (pointer to BLOB data) and integer (size of BLOB data) (8 bytes)
  ftString  - as pchar (Size bytes), probably without #0 at the end.
}

interface

uses Db, Classes, DynamicArrays
  {$IFDEF D6} ,Variants {$ENDIF}
  {$IFDEF D7} ,Variants {$ENDIF}
  {$ifdef ADEBUG} ,ADataSet {$endif}
;

type
{$IFDEF D4}  { Borland Delphi 4.0 }
  TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
  TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
{$ENDIF}

  TVirtualDataSet = class;

  TBookmInfo = record
   Bookmark     : integer;
   BookmarkFlag: TBookmarkFlag;
  end;
  PBookmInfo=^TBookmInfo;
  PInteger=^Integer;
  TPutMode = (pmAppend,pmInsert,pmUpdate);
  TVirtualFilterRecordEvent = procedure(DataSet: TVirtualDataSet; RecNum : integer;
                                          var Accept: Boolean) of object;
  TOnFastCalcFields = procedure(DataSet: TVirtualDataSet; RecNum : integer) of object;

  TVirtualDataSet = class(TDataSet)
  private
   FCalcBuf:pointer;
   FFieldsOffset :THArrayInteger;
   FFieldsSize   :THArrayInteger;
   FOpened       :boolean;
   FRecSize      :word;

   FFilterRecordEvent :TVirtualFilterRecordEvent;
   FOnFastCalcFields :TOnFastCalcFields;
   FAfterInternalOpen: TDataSetNotifyEvent;
   OldBuffer:pointer;
   procedure VReadAll;

  protected
   FCount        :integer;
   FCurrent      :integer;
   FBookm        :THArrayInteger;
   UniqBookmark  :integer;

   function GetRecNo : integer; override;

   //abstract methods
   function  VOpen            :boolean; virtual; abstract;
   function  VPrepare         :boolean; virtual; abstract;
   function  VClose           :boolean; virtual; abstract;
   procedure VGoto(RecordNum :integer); virtual; abstract;
   procedure VInitFieldDefs(Opened:boolean); virtual; abstract;

   function  VGetFieldValue( RecordNum:integer;
                             FieldID  :integer;
                             Buffer   :pointer):boolean; virtual; abstract;

   procedure VPutFieldValue( RecordNum:integer;
                             FieldID  :integer;
                             Buffer   :pointer;
                             mode     :TPutMode;
                             IfNotNull:Boolean);virtual; abstract;

   function VPost        (RecordNum:integer):TUpdateAction;  virtual; abstract;
   function VInsert      (RecordNum:integer):TUpdateAction;  virtual; abstract;
   function VDeleteRecord(RecordNum:integer):TUpdateAction;  virtual; abstract;

   function FetchNextBlock:boolean; virtual; abstract;

   function GetRealSize(FieldType:TFieldType;Size:integer):integer;

   //overrided methods from TDataSet
   procedure InternalOpen;                                  override;
   procedure InternalEdit;                                  override;
   procedure InternalInitFieldDefs;                         override;
   procedure InternalClose;                                 override;
   procedure InternalInsert;                                override;
   function  IsCursorOpen:boolean;                          override;
   procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
   procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
   function  GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
   procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
   procedure InternalSetToRecord(Buffer: PChar);            override;
   procedure InternalGotoBookmark(Bookmark: Pointer);       override;
   function  GetRecordCount:integer;        override;
   function  AllocRecordBuffer:PChar;       override;
   procedure FreeRecordBuffer(var Buffer: PChar);           override;
   function  GetRecordSize: Word;                           override;
   procedure InternalInitRecord(Buffer: PChar);             override;
   procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
   procedure InternalPost; override;
   procedure InternalDelete; override;
   function  GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
   procedure SetFieldData(Field: TField; Buffer: Pointer); override;
   procedure InternalFirst; override;
   procedure InternalLast; override;
   procedure InternalHandleException; override;
   procedure SetFiltered(Value:boolean); override;

   procedure SetRecNo(Value : integer); override;
   function  GetFieldID(FieldName : string) : integer;
   function  GetFieldCount: integer;

   procedure ClearDataSet; virtual;
  public
    constructor Create(AOwner:TComponent);override;
    destructor  Destroy; override;
    procedure SetFieldValue(RecordNum:integer; FieldID : integer; Value:variant); virtual; abstract;
    function GetFieldValue(RecordNum:integer; FieldID : integer):variant; virtual; abstract;
    procedure GotoRecNum(RecNum:integer);
    function  GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    procedure OpenAll;

    procedure ReOpen;

    property  RecNo; //for internal use
    procedure CopyStructure(DataSet:TDataSet);

    function Locate(const KeyFields: string; const KeyValues: Variant;
                    Options: TLocateOptions): Boolean; override;
    function Lookup(const KeyFields: string; const KeyValues: Variant;
                    const ResultFields: string): Variant;override;

    property FieldID[Index:string]:integer read GetFieldID;

    property ActiveRecord;
    property CurrentRecord;

   function CompareBookmarks(Bookmark1,Bookmark2:TBookmark):integer;override;

  published
   property Active;
   property BeforeOpen;
   property AfterOpen;
   property BeforeClose;
   property AfterClose;
   property BeforeInsert;
   property AfterInsert;
   property BeforeEdit;
   property AfterEdit;
   property BeforePost;
   property AfterPost;
   property BeforeCancel;
   property AfterCancel;
   property BeforeDelete;
   property AfterDelete;
   property BeforeScroll;
   property AfterScroll;
   property OnFastCalcFields:TOnFastCalcFields read FOnFastCalcFields write FOnFastCalcFields;
   property OnDeleteError;
   property OnEditError;
   property OnNewRecord;
   property OnPostError;
   property Filtered;
   property AfterInternalOpen: TDataSetNotifyEvent read FAfterInternalOpen write FAfterInternalOpen;
   property OnVFilterRecord : TVirtualFilterRecordEvent
                         read  FFilterRecordEvent
                         write FFilterRecordEvent;

  end;

implementation

uses SysUtils, DBConsts;

constructor TVirtualDataSet.Create(AOwner:TComponent);
begin
  inherited Create(Aowner);
  FFieldsOffset := THArrayInteger.Create;
  FFieldsSize := THArrayInteger.Create;
  FBookm := THArrayInteger.Create;
  UniqBookmark := 0;
  FCount := 0;
  FCurrent := -1;
  FOpened := False;
  FCalcBuf := nil;
end;

destructor TVirtualDataSet.Destroy;
begin
{$ifdef ADEBUG}LogMessage('TVirtualDataSet.Destroy BEGIN');{$endif}

  FFieldsOffset.Free;
  FFieldsSize.Free;
  FBookm.Free;
  inherited Destroy;

{$ifdef ADEBUG}LogMessage('TVirtualDataSet.Destroy END');{$endif}
end;

procedure TVirtualDataSet.InternalOpen;
var
  i         :integer;
  RealSize  :integer;
  off       :word;
begin
  ClearBuffers;
  BookmarkSize:=sizeof(TBookmInfo);
  FCount:=0;
  FCurrent:=-1;

    { moved to VOpen by roma 24.05.2002}
//  if DefaultFields then begin
//   VInitFieldDefs(True);
//   CreateFields;
//  end;

  FOpened:=VOpen;
  if not FOpened then exit;

  FFieldsOffset.ClearMem;
  FFieldsSize.ClearMem;
  FBookm.ClearMem;
  UniqBookmark := 0;

  off := sizeof(TBookmInfo);
  for i := 0 to FieldDefs.Count-1 do
  begin
    FFieldsOffset.AddValue(off);
    RealSize := GetRealSize(FieldDefs[i].DataType, FieldDefs[i].Size);
    FFieldsSize.AddValue(RealSize);
    off := off + RealSize + 1;  //one extra byte for isFieldNull function
  end;
  FRecSize := off;

  BindFields(True);
  OldBuffer := AllocMem(RecordSize);
  if Assigned (AfterInternalOpen)
    then AfterInternalOpen(self);
end;

function TVirtualDataSet.GetRealSize(FieldType:TFieldType;Size:integer):integer;
begin
  case FieldType of
       ftFloat           : Result := SizeOf(Double);
       ftCurrency        : Result := SizeOf(Currency);
       ftInteger         : Result := SizeOf(Integer);
       ftSmallInt        : Result := SizeOf(SmallInt);
       ftDate            : Result := SizeOf(TDateTimeRec);
       ftTime            : Result := SizeOf(TDateTimeRec);
       ftWord            : Result := SizeOf(Word);
       ftBoolean         : Result := SizeOf(WordBool);
       ftDateTime        : Result := SizeOf(TDateTimeRec);
       ftString          : Result := Size;
       ftBlob,ftMemo     : Result := 2*SizeOf(pointer); // BlobSize and pointer to memory where BLOB field stores data
    else
       Result := Size;
  end;
end;

function  TVirtualDataSet.GetFieldID(FieldName : string) : integer;
begin
  Result:=FieldDefs.IndexOf(FieldName);
  if Result = -1
    then raise EDatabaseError.Create('Field "' + FieldName + '" not found!');
end;

function  TVirtualDataSet.GetFieldCount : integer;
begin
  Result:=FieldDefs.Count;
end;

procedure TVirtualDataSet.InternalClose;
begin
  if not FOpened then exit;
  if DefaultFields then Fields.Clear;
  FOpened:=not VClose;
  FCount:=0;
  FBookm.ClearMem;
  FFieldsOffset.ClearMem;
  FFieldsSize.ClearMem;
  FreeMem(OldBuffer);
  OldBuffer:=nil;
end;

procedure TVirtualDataSet.InternalInitFieldDefs;
begin
 if Active then exit;
 VInitFieldDefs(False);
end;

function TVirtualDataSet.IsCursorOpen:boolean;
begin
  Result:=FOpened;
end;

procedure TVirtualDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PInteger(Data)^:=PBookmInfo(Buffer).Bookmark;
end;

procedure TVirtualDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PBookmInfo(Buffer).Bookmark:=PInteger(Data)^;
end;

function  TVirtualDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result:=PBookmInfo(Buffer).BookmarkFlag;
end;

procedure TVirtualDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PBookmInfo(Buffer).BookmarkFlag:=Value;
end;

procedure TVirtualDataSet.InternalSetToRecord(Buffer: PChar);
begin
  FCurrent:=FBookm.IndexOf(PBookmInfo(Buffer).Bookmark);
  //MoveBy(1);
  //PBookmInfo(Buffer).BookmarkFlag := bfCurrent;
{  if PBookmInfo(Buffer).BookmarkFlag=bfBOF then
    FCurrent:=FCurrent-1;}
end;

procedure TVirtualDataSet.GotoRecNum(RecNum:integer);
var u:integer;
begin
// b.Bookmark
  u:=FBookm[RecNum];
  GotoBookmark(@u);
end;

procedure TVirtualDataSet.InternalGotoBookmark(Bookmark: Pointer);
begin
  InternalSetToRecord(PChar(bookmark));
end;

function  TVirtualDataSet.GetRecordCount:integer;
begin
 Result:=FCount;
end;

function  TVirtualDataSet.AllocRecordBuffer:PChar;
begin
  Result:=AllocMem(FRecSize);
end;

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

function  TVirtualDataSet.GetRecordSize: Word;
begin
  Result:=FRecSize;
end;

function TVirtualDataSet.GetRecNo : integer;
begin
  UpdateCursorPos;
  Result:=FCurrent;
end;

procedure TVirtualDataSet.SetRecNo(Value : integer);
begin
 if (Value>-1) and (Value<RecordCount) then
 begin
   FCurrent:=Value;
   Resync([]);//Refresh; {roma 13.08.2000}
 end;
end;

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

procedure TVirtualDataSet.InternalInsert;
begin
 // nothing yet
end;

procedure TVirtualDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var
  i    : integer;
  mode : TPutMode;
  r:integer;
begin
  r:=FCurrent;
  if r=-1 then r:=0;
  if Append then r:=RecordCount;

  if Append
   then mode:=pmAppend
   else mode:=pmInsert;

  VInsert(r);
  for i:=0 to FieldDefs.Count-1 do
    VPutFieldValue(r,i,
                   pointer(cardinal(Buffer) +
                           cardinal(FFieldsOffset.Value[i])+1),
                   mode, Boolean(pointer(cardinal(Buffer)+cardinal(FFieldsOffset.Value[i]))^));
//  Inc(UniqBookmark); // VInsert automatically call FBookm.Insert
//  FBookm.AddValue(UniqBookmark);
  if mode=pmAppend then FCurrent:=RecordCount;
  Inc(FCount);
end;

procedure TVirtualDataSet.InternalPost;
var
  i    : integer;
  mode : TPutMode;
  ua : TUpdateAction;
begin
  case State of
    dsEdit   : begin
                 ua:=VPost(FCurrent);
                 if ua<>uaApplied then abort;
                 if ua=uaAbort then abort;
                 mode:=pmUpdate;
                 for i:=0 to FieldDefs.Count-1 do
                   VPutFieldValue(FCurrent,i,
                                  pointer(cardinal(ActiveBuffer) +
                                          cardinal(FFieldsOffset.Value[i])+1),
                                  mode,
                                  Boolean(pointer(cardinal(ActiveBuffer) +
                                          cardinal(FFieldsOffset.Value[i]))^));

               end;
    dsInsert : begin
                if FCurrent<>-1 then ua:=VPost(FCurrent) else ua:=VPost(0);
                if ua=uaAbort then abort;
                if ua<>uaApplied then abort;