adataset.pas

delphi通过OCI访问ORACLE

unit ADataSet;

{$INCLUDE dOCI.inc}

interface

uses
  Windows, SysUtils, Classes, DynamicArrays, Db, Math
  {$IFDEF D7} ,Variants {$ENDIF}
  ;


type
 TADataSet=class;

 TAFieldType = (ftoString, ftoSmallint, ftoInt64, ftoInteger, ftoWord, ftoBoolean,
                ftoDouble, ftoCurrency, ftoDate, ftoTime, ftoDateTime, ftoBlob, ftoClob, ftoUnknown);

 TAParamType = (ptoInput, ptoOutput, ptoInputOutput);

 TAFieldTypeNames = array [TAFieldType] of string;
 TAParamTypeNames = array [TAParamType] of string;

 TADataSetNotifyEvent = procedure(DataSet: TADataSet; Bookm : integer) of object;

 TSortType = (stASC,stDESC); // order of sorting (Ascending/Descending)

 TADatabase = class(TComponent)
  private
  protected
   FDataSets:THArrayPointer; // the list of DataSets which use this ADatabase
   procedure CloseLinkedDataSets;virtual; // if ADatabase is closing then all linked DataSets must be closed too
   procedure SetActive(Value:boolean);virtual;abstract;
   function GetActive:boolean;virtual;abstract;
  public
   constructor Create(AOwner:TComponent);override;
   destructor Destroy; override;
   procedure AddDataSet(DataSet:TDataSet);
   procedure RemoveDataSet(DataSet:TDataSet);
   procedure Open;virtual;abstract;
   procedure Close;virtual;abstract;
  published
   property Active:boolean read GetActive write SetActive default False;
 end;

 TAParam = class
  private
   FName:string;
   FFieldType:TAFieldType;
   FParamType:TAParamType;
  protected
   FParent:TADataSet;
   procedure TestType(t:TAFieldType);

   function  GetIsNull:boolean; virtual; abstract;
   procedure SetIsNull(Value:boolean); virtual; abstract;

   function  GetValue:variant; virtual; abstract;
   procedure SetValue(Value:variant); virtual; abstract;
   function  GetAsInteger:integer; virtual; abstract;
   procedure SetAsInteger(Value:integer); virtual; abstract;
   function  GetAsWord:Word; virtual; abstract;
   procedure SetAsWord(Value:Word); virtual; abstract;
   function  GetAsSmallInt:SmallInt; virtual; abstract;
   procedure SetAsSmallInt(Value:SmallInt); virtual; abstract;
   function  GetAsDate:integer; virtual; abstract;
   procedure SetAsDate(Value:integer); virtual; abstract;
   function  GetAsTime:integer; virtual; abstract;
   procedure SetAsTime(Value:integer); virtual; abstract;
   function  GetAsDateTime:int64; virtual; abstract;
   procedure SetAsDateTime(Value:int64); virtual; abstract;
   function  GetAsString:string; virtual; abstract;
   procedure SetAsString(Value:string); virtual; abstract;
   function  GetAsDouble:double; virtual; abstract;
   procedure SetAsDouble(Value:double); virtual; abstract;
   function  GetAsCurrency:currency; virtual; abstract;
   procedure SetAsCurrency(Value:currency); virtual; abstract;
   function  GetAsBoolean:Boolean; virtual; abstract;
   procedure SetAsBoolean(Value:Boolean); virtual; abstract;
   function  GetAsInt64:int64; virtual; abstract;
   procedure SetAsInt64(Value:int64); virtual; abstract;

   procedure ClearBlob(); virtual; abstract;

  public
   constructor Create(Parent:TADataSet;ParamName:string;ParamFieldType:TAFieldType;ParamParamType:TAParamType); virtual;
   procedure Clear; virtual; abstract;

   function WriteBlob(Offset:integer;Buffer:pointer;Size:integer):cardinal; virtual; abstract;
   function ReadBlob(Offset:integer;Buffer:pointer;Size:integer):cardinal; virtual; abstract;
   function ReadBlobToStream(Stream:TStream):cardinal; virtual;
   function WriteBlobFromStream(Stream:TStream):cardinal; virtual;
   function GetLobLength:integer; virtual; abstract;

   property Name:string read FName;
   property IsNull:boolean read GetIsNull write SetIsNull;
   property AsInteger:integer read GetAsInteger write SetAsInteger;
   property AsWord:Word read GetAsWord write SetAsWord;
   property AsSmallInt:SmallInt read GetAsSmallInt write SetAsSmallInt;
   property AsDate:integer read GetAsDate write SetAsDate;
   property AsTime:integer read GetAsTime write SetAsTime;
   property AsDateTime:int64 read GetAsDateTime write SetAsDateTime;
   property AsString:string read GetAsString write SetAsString;
   property AsDouble:double read GetAsDouble write SetAsDouble;
   property AsCurrency:currency read GetAsCurrency write SetAsCurrency;
   property AsBoolean:Boolean read GetAsBoolean write SetAsBoolean;
   property AsInt64:int64 read GetAsInt64 write SetAsInt64;
   property FieldType:TAFieldType read FFieldType;
   property ParamType:TAParamType read FParamType;
   property Value:variant read GetValue write SetValue;
  end;

  TAField = class
  protected
   FRequired:boolean;
   FFieldType:TAFieldType;
   FFieldSize:word;
   FName:string;
   FParent:TADataSet;
   Values:THArray;            // the Values of field
   ValuesSize:THArrayInteger; // sizes in bytes of each field value for datatypes BLOB and CLOB

   // stores True - if field has value, False - if field has NULL value (has no value)
   // !NOTE! ValuesNull=nil always when Required=true
   ValuesNull:THArrayBoolean;

   procedure Clear; virtual;

   function RecordToInternal(RecordNum:integer):Integer;

   procedure TestType(t:TAFieldType);

   function  GetIsNull(RecordNum:integer):boolean;
   procedure SetIsNull(RecordNum:integer;Value:boolean);
   function  GetAsString(RecordNum:integer):string;
   procedure SetAsString(RecordNum:integer;Value:string);
   function  GetAsInteger(RecordNum:integer):Integer;
   procedure SetAsInteger(RecordNum:integer;Value:Integer);
   function  GetAsBoolean(RecordNum:integer):Boolean;
   procedure SetAsBoolean(RecordNum:integer;Value:Boolean);
   function  GetAsDate(RecordNum:integer):integer;
   procedure SetAsDate(RecordNum:integer;Value:integer);
   function  GetAsTime(RecordNum:integer):integer;
   procedure SetAsTime(RecordNum:integer;Value:integer);
   function  GetAsDateTime(RecordNum:integer):int64;
   procedure SetAsDateTime(RecordNum:integer;Value:int64);
   function  GetAsDouble(RecordNum:integer):Double;
   procedure SetAsDouble(RecordNum:integer;Value:Double);
   function  GetAsCurrency(RecordNum:integer):Currency;
   procedure SetAsCurrency(RecordNum:integer;Value:Currency);
   function  GetAsSmallInt(RecordNum:integer):SmallInt;
   procedure SetAsSmallInt(RecordNum:integer;Value:SmallInt);
   function  GetAsWord(RecordNum:integer):Word;
   procedure SetAsWord(RecordNum:integer;Value:Word);
   function  GetAsInt64(RecordNum:integer):int64;
   procedure SetAsInt64(RecordNum:integer;Value:int64);
   function  GetValue(RecordNum:integer):variant;
   procedure SetValue(RecordNum:integer;Value:variant);
  public
   Visible:boolean;
   ReadOnly:boolean;

   constructor Create(Parent:TADataSet; FieldName:string; RFieldType:TAFieldType; FieldSize:word; Required:boolean);virtual;
   destructor Destroy; override;
//   procedure Allocate(HArray:THArray;HArrayNull:THArrayBoolean;HArraySize:THArrayInteger=nil); overload;// virtual;

   // next 3 methods are moved here from protected section
   procedure DeleteRecord(RecordNum:integer);virtual;
   procedure InsertRecord(RecordNum:integer);virtual;
   procedure Allocate; overload; virtual;

   procedure ClearBlob(RecordNum:integer); virtual;
   function WriteBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; virtual;
   function ReadBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; virtual;
   function ReadBlobToStream(RecordNum:integer;Stream:TStream):cardinal; virtual;
   function WriteBlobFromStream(RecordNum:integer;Stream:TStream):cardinal; virtual;
   function GetLobLength(RecordNum:integer):integer;virtual;

   property Name:string read FName;
   property FieldType:TAFieldType read FFieldType;
   property FieldSize:word read FFieldSize;
   property Required:boolean read FRequired;
   property IsNull[RecordNum:integer]:boolean read GetIsNull write SetIsNull;
   property AsString[RecordNum:integer]:string read GetAsString write SetAsString;
   property AsInteger[RecordNum:integer]:integer read GetAsInteger write SetAsInteger;
   property AsDate[RecordNum:integer]:integer read GetAsDate write SetAsDate;
   property AsTime[RecordNum:integer]:integer read GetAsTime write SetAsTime;
   property AsDateTime[RecordNum:integer]:int64 read GetAsDateTime write SetAsDateTime;
   property AsDouble[RecordNum:integer]:double read GetAsDouble write SetAsDouble;
   property AsCurrency[RecordNum:integer]:currency read GetAsCurrency write SetAsCurrency;
   property AsBoolean[RecordNum:integer]:Boolean read GetAsBoolean write SetAsBoolean;
   property AsWord[RecordNum:integer]:Word read GetAsWord write SetAsWord;
   property AsSmallInt[RecordNum:integer]:SmallInt read GetAsSmallInt write SetAsSmallInt;
   property AsInt64[RecordNum:integer]:int64 read GetAsInt64 write SetAsInt64;
   property Value[RecordNum:integer]:variant read GetValue write SetValue;
   property HArrayValues:THArray read Values;
   property HArrayValuesNull:THArrayBoolean read ValuesNull;
   property HArrayValuesSize:THArrayInteger read ValuesSize;
  end;

 TADataSet = class(TComponent)
  private
   FActive:boolean;
   FStreamedActive:boolean;
   FAfterInsert  : TADataSetNotifyEvent;
   FBeforeDelete : TADataSetNotifyEvent;

//   FUni:boolean; moved to the AOraSQL.pas
   FFields:THArrayPointer;
//   FSortIndex:THArrayInteger; // index array for sort without moving records

   procedure SetActive(Value:boolean);

   procedure SetAfterInsert(proc : TADataSetNotifyEvent);
   procedure SetBeforeDelete(proc : TADataSetNotifyEvent);

   function GetFieldByIndex(Index:integer):TAField;
   function GetFieldByName(FieldName:string):TAField;
   function GetFieldID(FieldName:string):integer;
   function GetParamByIndex(Index:integer):TAParam;
   function GetParamCount:integer;
   function GetFieldCount: integer;
//   function GetSorted:boolean;

  protected
   FFetched:boolean;
   FPrepared:Boolean;
   FBeginRecord:integer;
   FCurrentRec:integer;
   FParams:THArrayPointer; //TODO: move it to private
   FCount:integer;
   procedure CheckActive;
   procedure Loaded; override;
   procedure EmptyFields;
   procedure AllocateFields;
   function  GetParamID(ParamName:string):integer;
   function  GetParamByName(ParamName:string):TAParam;
   procedure ForgetValues;
//   procedure Sort(FieldIndex:integer;SortType:TSortType);overload;
//   procedure Sort(FieldName:string;SortType:TSortType);overload;
   function CreateAField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean):TAField;virtual;

  public
     // abstract methods
   procedure Fetch;virtual;abstract;
   procedure Prepare; virtual;abstract;
   procedure UnPrepare; virtual;abstract;
     // virtual methods
   procedure Open; overload; virtual;
   procedure Open(Fields:THArrayPointer); overload; virtual;
   procedure OpenAll;virtual;
   procedure Close; virtual;
   function ReadRecord(RecordNum:integer):boolean; virtual;
   procedure DeleteRecord(RecordNum:integer); virtual;
   procedure InsertRecord(RecordNum:integer); virtual;
   procedure AppendRecord; virtual;

   procedure ClearFields; virtual;
   procedure ClearParams;virtual;
   procedure AddParam(ParamName:string;FieldType:TAFieldType;ParamType:TAParamType);virtual;abstract;
   procedure AddField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean); virtual;
   procedure CopyStructure(DataSet:TDataSet);overload;
   procedure CopyStructure(ADataSet:TADataSet);overload;

   procedure ReOpen;
   procedure ReadAll;

     // navigation methods
   function EOF:boolean;virtual;
   procedure Prev;virtual;
   procedure Next;virtual;
   procedure First;virtual;


   procedure SaveToDBF(FileName:string);

   function WriteBlob(FieldNum,RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;overload;
   function ReadBlob(FieldNum,RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;overload;
   function ReadBlobToStream(FieldNum,RecordNum:integer;Stream:TStream):cardinal;overload;
   function WriteBlobFromStream(FieldNum,RecordNum:integer;Stream:TStream):cardinal;overload;

   function WriteBlob(FieldName:string;RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; overload;
   function ReadBlob(FieldName:string;RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; overload;
   function ReadBlobToStream(FieldName:string;RecordNum:integer;Stream:TStream):cardinal; overload;
   function WriteBlobFromStream(FieldName:string;RecordNum:integer;Stream:TStream):cardinal;overload;

   function ParamExists(ParamName: string): boolean;
   function FieldExists(FieldName: string): boolean;

   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;

   property ParamCount:integer read GetParamCount;
   property ParamByName[Name:string]:TAParam read GetParamByName;
   property ParamByIndex[Index:integer]:TAParam read GetParamByIndex;
   property FieldCount:integer read GetFieldCount;
   property FieldByName[Name:string]:TAField read GetFieldByName;
   property FieldByIndex[Index:integer]:TAField read GetFieldByIndex;


   property RecordCount:integer read FCount;
   property FieldID[FieldName:string]:integer read GetFieldID;
//   property Sorted:boolean read GetSorted;

   property CurrentRecord:integer read FCurrentRec;
   property Fetched:boolean read FFetched;
   property Prepared:boolean read FPrepared;
   property aaAfterInsert : TADataSetNotifyEvent read FAfterInsert write SetAfterInsert;
   property aaBeforeDelete : TADataSetNotifyEvent read FBeforeDelete write SetBeforeDelete;
  published
   property Active:boolean read FActive write SetActive;
//   property UniDirectional:boolean read FUni write FUni; moved to the AOraSQL.pas
  end;

var
 AParamTypeNames : TAParamTypeNames=('ptoInput','ptoOutput','ptoInputOutput');
 AFieldTypeNames : TAFieldTypeNames=('ftoString','ftoSmallInt','ftoInt64','ftoInteger','ftoWord','ftoBoolean','ftoDouble',
                                     'ftoCurrency','ftoDate','ftoTime','ftoDateTime','ftoBlob','ftoClob','ftoUnknown');


function TypeAToDelphi(fta:TAFieldType):TFieldType;
function TypeDelphiToA(ft:TFieldType):TAFieldType;
function ParamTypeAToDelphi(pto:TAParamType):TParamType;
function ParamTypeDelphiToA(pt:TParamType):TAParamType;

implementation

uses GoodDate, DBConsts, DataSetQuery, OraUtils, OraError, dOCIMessages
      {$IFDEF D6} ,Variants {$ENDIF};


function TypeAToDelphi(fta:TAFieldType):TFieldType;
begin
  case fta of
   ftoString:   Result:=ftString;
   ftoBoolean:  Result:=ftBoolean;
   ftoDouble:   Result:=ftFloat;
   ftoCurrency: Result:=ftCurrency;
   ftoDate:     Result:=ftDate;
   ftoTime:     Result:=ftTime;
   ftoDateTime: Result:=ftDateTime;
   ftoInteger:  Result:=ftInteger;
   ftoSmallInt: Result:=ftSmallInt;
   ftoWord:     Result:=ftWord;
   ftoBlob:     Result:=ftBlob;
   ftoClob:     Result:=ftMemo;
  else
   raise Exception.Create(SUnknownFieldType);
  end;
end;

function TypeDelphiToA(ft:TFieldType):TAFieldType;
begin
  case ft of
    ftString:   Result:=ftoString;
    ftBoolean:  Result:=ftoBoolean;
    ftFloat:    Result:=ftoDouble;
    ftCurrency: Result:=ftoCurrency;
    ftDate:     Result:=ftoDate;
    ftTime:     Result:=ftoTime;
    ftDateTime: Result:=ftodateTime;
    ftInteger:  Result:=ftoInteger;
    ftSmallInt: Result:=ftoSmallInt;
    ftWord:     Result:=ftoWord;
    ftBlob:     Result:=ftoBlob;
    ftMemo:     Result:=ftoClob;
  else
    raise Exception.Create(SErrUnknownFieldType);
  end;
end;

function ParamTypeAToDelphi(pto:TAParamType):TParamType;
begin
  case pto of
    ptoInput:      Result := ptInput;
    ptoOutput:     Result := ptOutput;
    ptoInputOutput:Result := ptInputOutput;
  else
    raise Exception.Create(SErrUnknownParameterDataType);
  end;
end;

function ParamTypeDelphiToA(pt:TParamType):TAParamType;
begin
  case pt of
    ptInput:       Result := ptoInput;
    ptOutput:      Result := ptoOutput;
    ptInputOutput,
    ptUnknown,
    ptResult:      Result := ptoInputOutput;
  else
    raise Exception.Create(SUnknownFieldType);
  end;
end;

{ TAParam }

constructor TAParam.Create(Parent:TADataSet; ParamName: string; ParamFieldType: TAFieldType;