aorasql.pas

delphi通过OCI访问ORACLE

unit AOraSQL;

{$INCLUDE dOCI.inc}

interface

uses
	ADataSet, OraDefines, DynamicArrays, Classes, OraDB
    {$IFDEF D6} ,Variants {$ENDIF}
    {$IFDEF D7} ,Variants {$ENDIF}
    ;

type
  TAOraSQL = class;

  TAOraParam = class (TAParam)
  private
   pData:pointer;
   pDataNull:sb2;
   LocalType:ub2;
   LocalSize:integer;

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

  public
   constructor Create(Parent:TADataSet;ParamName:string;ParamFieldType:TAFieldType;ParamParamType:TAParamType);override;
   destructor Destroy; override;
   procedure Clear;override;

   function WriteBlob(Offset:integer;Buffer:pointer;Size:integer):ub4;override;
   function ReadBlob(Offset:integer;Buffer:pointer;Size:integer):ub4; override;
   function GetLobLength:integer;override;
   procedure ClearBlob;override;

  end;

  TAOraField = class(TAField)
  private
  // temporary arrays for storing data in oracle format (before data will be moved to the persistent arrays)
   pData:THArray;
   pDataNull:THArray;
   pDataLen:THArraySmallInt;
   FLocalType:ub2;
   FLocalSize:integer;
   FMapped:boolean; // if this field exists in oracle
   defhp:pOCIDefine;

   procedure ZeroBuffer;
   procedure ClearTemp;
   procedure Add(CountF:integer); // move (and convert) data from temporary arrays(pData,...) into persistent ones in Delphi format

  protected
   procedure Clear; override;

  public
   constructor Create(Parent:TADataSet;FieldName:string;RFieldType:TAFieldType;FieldSize:word;Required:boolean);override;

   procedure Allocate; override;
   procedure DeleteRecord(RecordNum:integer);override;
   procedure InsertRecord(RecordNum:integer);override;

   function WriteBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):ub4;override;
   function ReadBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):ub4; override;
   function GetLobLength(RecordNum:integer):integer;override;
   procedure ClearBlob(RecordNum:integer);override;

  end;

  TASQLType = (stUnknown, stSelect, stUpdate, stDelete, stInsert, stCreate, stDrop, stAlter, stBegin, stDeclare);

  TAOraSQL = class(TADataSet)
  private
   FDatabase:TOraDB;
   FSelfPrepared:boolean;
   FSQL:TStrings;
   FFetchCount: integer;
   FUni:boolean;
   FElapsed:TDateTime;

   procedure SetSQL(Value:TStrings);

  protected
   mystmthp:pOCIStmt;
   myerrhp:pOCIError;
   stmt_type:ub2;

   function GetSQLType:TASQLType;

   function TestError(where:string;ex:sword):sword;
   procedure MapParam;
   procedure MapFields;
   procedure SetFetchCount(Value:integer);
   procedure OpenDatabase;
  public
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
   procedure Open; override;
   procedure Close; override;
   procedure Prepare;override;
   procedure UnPrepare;override;
   procedure ExecSQL;
   procedure First;override;
   procedure Next;override;
   function ReadRecord(RecordNum:integer):boolean; override;

   procedure ClearParams;override;
   procedure SetQuery(Query:string);
   function CreateAField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean):TAField;override;
//   procedure AddField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean); override;
   procedure AddParam(ParamName:string;FieldType:TAFieldType;ParamType:TAParamType);override;
   procedure LoadFields;

   procedure Fetch;override;
   function GetNextSequenceNumber(SequenceName: String): Integer;

   property SQLType:TASQLType read GetSQLType;
   property Elapsed:TDateTime read FElapsed;
  published
   property Database:TOraDB read FDatabase write FDatabase;
   property FetchCount:integer read FFetchCount write SetFetchCount;
   property SQL:TStrings read FSQL write SetSQL;
   property UniDirectional:boolean read FUni write FUni;
  end;

procedure goodOra2Delphi(FT:TAFieldType;pin,pout:pointer);
procedure goodDelphi2Ora(FT:TAFieldType;pin,pout:pointer);

implementation

uses SysUtils, Windows, DBConsts, GoodDate, OraError, OraUtils, dOCIMessages;

procedure goodOra2Delphi(FT:TAFieldType; pin, pout:pointer);
var od:^oradate;
begin
 case FT of
//  ftLargeInt: OraNumToInt64(pin,pout,2);
  ftoCurrency: pcurrency(pout)^ := pdouble(pin)^; //***
  ftoDate:    begin
               od := pin;
               if od.Century <> 0 then
                pinteger(pout)^ := MakeGoodDate((od.Century - 100)*100 + (od.Year - 100), od.Month, od.Day);
             end;
  ftoTime:    begin
               od := pin;
               if od.Century <> 0 then
                pinteger(pout)^ := MakeGoodTime(od.Hour - 1, od.Minute - 1, od.Second - 1, 0);
             end;
  ftoDateTime:begin
               od := pin;
               if od.Century <> 0 then begin
                pInt64(pout)^ := MakeGoodDateTime((od.Century - 100)*100 + (od.Year - 100), od.Month, od.Day, od.Hour - 1, od.Minute - 1, od.Second - 1, 0);
               end;
             end;
 end;
end;

procedure goodDelphi2Ora(FT:TAFieldType; pin, pout:pointer);
var od:^oradate;
    dd,dm,dy:word;
    th,tm,ts,tms:word;
begin
 case FT of
  ftoCurrency:pdouble(pout)^ := pcurrency(pin)^; //***
  ftoDate: begin
           od := pout;
           UnMakeGoodDate(pinteger(pin)^, dy, dm, dd);
           od.century := 100 + dy div 100;
           od.year := dy mod 100 + 100;
           od.month := dm;
           od.day := dd;
           od.hour := 1;
           od.minute := 1;
           od.second := 1;
          end;
  ftoTime: begin
           od := pout;
           UnMakeGoodTime(pinteger(pin)^, th, tm, ts, tms);
           od.century := 0;
           od.year := 0;
           od.month := 0;
           od.day := 0;
           od.hour := th + 1;
           od.minute := tm + 1;
           od.second := ts + 1;
          end;
  ftoDateTime: begin
               od := pout;
               UnMakeGoodDateTime({pinteger}pInt64(pin)^, dy, dm, dd, th, tm, ts, tms);
               od.century := 100 + dy div 100;
               od.year := dy mod 100 + 100;
               od.month := dm;
               od.day := dd;
               od.hour := th + 1;
               od.minute := tm + 1;
               od.second := ts + 1;
              end;
 end;
end;


 { AOraParam }

constructor TAOraParam.Create(Parent:TADataSet;ParamName:string; ParamFieldType:TAFieldType; ParamParamType:TAParamType);
begin
  inherited Create(Parent, ParamName, ParamFieldType, ParamParamType);

  case FieldType of
    ftoString:   LocalSize := 4001;
    ftoBoolean:  LocalSize := sizeof(boolean);
    ftoDouble:   LocalSize := sizeof(double);
    ftoCurrency: LocalSize := sizeof(double); //***21;
    ftoDate:     LocalSize := sizeof(oradate);
    ftoTime:     LocalSize := sizeof(oradate);
    ftoDateTime: LocalSize := sizeof(oradate);
    ftoInt64:    LocalSize := sizeof(int64);
    ftoInteger:  LocalSize := sizeof(integer);
    ftoSmallInt: LocalSize := sizeof(smallint);
    ftoWord:     LocalSize := sizeof(word);
    ftoBlob:     LocalSize := sizeof(pOCILobLocator);
    ftoClob:     LocalSize := sizeof(pOCILobLocator);
  else
    raise Exception.Create(sErrUnknownDataType);
  end;

  pDataNull := -1; // roma 27.02.2003
  pData := AllocMem(LocalSize);

  case FieldType of
    ftoString:  LocalType := SQLT_STR;
    ftoBoolean: LocalType := SQLT_INT;
    ftoDouble:  LocalType := SQLT_FLT;
    ftoCurrency:LocalType := SQLT_FLT; //***SQLT_NUM;
    ftoDate:    LocalType := SQLT_DAT;
    ftoTime:    LocalType := SQLT_DAT;
    ftoDateTime:LocalType := SQLT_DAT;
    ftoInt64:   LocalType := SQLT_FLT;//???
    ftoInteger: LocalType := SQLT_INT;
    ftoSmallInt:LocalType := SQLT_INT;
    ftoWord:    LocalType := SQLT_INT;
    ftoBlob:    LocalType := SQLT_BLOB;
    ftoClob:    LocalType := SQLT_CLOB;
  else
    LocalType := 65535;
  end;

//  if (LocalType in [SQLT_BLOB, SQLT_CLOB]) and Assigned(FParent) then
//    TAOraSQL(FParent).TestError('TAOraParam.Create - DescriptorAlloc - ',
//              TAOraSQL(FParent).Database.OCIDescriptorAlloc(TAOraSQL(FParent).Database.myenvhp,
//                                                            pData, OCI_DTYPE_LOB, 0, nil));
end;

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

  if LocalType in [SQLT_BLOB, SQLT_CLOB] then
    if Assigned(FParent) and (pOCILobLocator(pData^) <> nil) then begin // free the descriptor only if it is initialized
      TAOraSQL(FParent).TestError('TAOraParam.Destroy - OCIDescriptorFree - ',
                                  TAOraSQL(FParent).Database.OCIDescriptorFree(pData, OCI_DTYPE_LOB));
    end;

  FreeMem(pData);
  inherited Destroy;

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

function TAOraParam.GetIsNull:boolean;
begin
  Result := pDataNull = -1;
end;

procedure TAOraParam.SetIsNull(Value:boolean);
begin
  if Value
    then pDataNull := -1
    else pDataNull := 0;
end;

function  TAOraParam.GetAsInteger:integer;
begin
  TestType(ftoInteger);
  if IsNull
    then Result := 0
    else Result := pInteger(pData)^;
end;

procedure TAOraParam.SetAsInteger(Value:integer);
begin
  TestType(ftoInteger);
  SetIsNull(False);
  pInteger(pData)^ := Value;
end;

function  TAOraParam.GetAsDate:integer;
begin
  TestType(ftoDate);
  if IsNull
    then Result := 0
    else goodOra2Delphi(ftoDate, pData, @Result);
end;