123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672 |
- unit oracleconnection;
- {$mode objfpc}{$H+}
- {$Define LinkDynamically}
- interface
- uses
- Classes, SysUtils, sqldb,db,dbconst,
- {$IfDef LinkDynamically}
- ocidyn,
- {$ELSE}
- oci,
- {$ENDIF}
- oratypes;
- const
- DefaultTimeOut = 60;
- type
- EOraDatabaseError = class(EDatabaseError)
- public
- ORAErrorCode : Longint;
- end;
- TOracleTrans = Class(TSQLHandle)
- protected
- FOciSvcCtx : POCISvcCtx;
- FOciTrans : POCITrans;
- FOciFlags : ub4;
- public
- destructor Destroy(); override;
- end;
-
- TOraFieldBuf = record
- Buffer : pointer;
- Ind : sb2;
- end;
- TOracleCursor = Class(TSQLCursor)
- protected
- FOciStmt : POCIStmt;
- FieldBuffers : array of TOraFieldBuf;
- ParamBuffers : array of TOraFieldBuf;
- end;
- { TOracleConnection }
- TOracleConnection = class (TSQLConnection)
- private
- FOciEnvironment : POciEnv;
- FOciError : POCIError;
- FOciServer : POCIServer;
- FOciUserSession : POCISession;
- FUserMem : pointer;
- procedure HandleError;
- procedure SetParameters(cursor : TSQLCursor;AParams : TParams);
- protected
- // - Connect/disconnect
- procedure DoInternalConnect; override;
- procedure DoInternalDisconnect; override;
- // - Handle (de)allocation
- function AllocateCursorHandle:TSQLCursor; override;
- procedure DeAllocateCursorHandle(var cursor:TSQLCursor); override;
- function AllocateTransactionHandle:TSQLHandle; override;
- // - Statement handling
- procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
- procedure UnPrepareStatement(cursor:TSQLCursor); override;
- // - Transaction handling
- procedure InternalStartDBTransaction(trans:TOracleTrans);
- function GetTransactionHandle(trans:TSQLHandle):pointer; override;
- function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
- function Commit(trans:TSQLHandle):boolean; override;
- function Rollback(trans:TSQLHandle):boolean; override;
- procedure CommitRetaining(trans:TSQLHandle); override;
- procedure RollbackRetaining(trans:TSQLHandle); override;
- // - Statement execution
- procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
- function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
- // - Result retrieving
- procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
- function Fetch(cursor:TSQLCursor):boolean; override;
- function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
- // function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
- procedure FreeFldBuffers(cursor:TSQLCursor); override;
- public
- constructor Create(AOwner : TComponent); override;
- end;
- TOracleConnectionDef = Class(TConnectionDef)
- Class Function TypeName : String; override;
- Class Function ConnectionClass : TSQLConnectionClass; override;
- Class Function Description : String; override;
- end;
- implementation
- uses
- math, StrUtils;
- ResourceString
- SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
- SErrHandleAllocFailed = 'The allocation of the error handle failed.';
- SErrOracle = 'Oracle returned error %s:';
- procedure TOracleConnection.HandleError;
- var errcode : sb4;
- buf : array[0..1023] of char;
- E : EOraDatabaseError;
- begin
- OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);
- if (Self.Name <> '') then
- E := EOraDatabaseError.CreateFmt('%s : %s',[Self.Name,pchar(buf)])
- else
- E := EOraDatabaseError.Create(pchar(buf));
- E.ORAErrorCode := errcode;
- Raise E;
- end;
- procedure TOracleConnection.DoInternalConnect;
- var
- ConnectString : string;
- TempServiceContext : POCISvcCtx;
- begin
- {$IfDef LinkDynamically}
- InitialiseOCI;
- {$EndIf}
- inherited DoInternalConnect;
- //todo: get rid of FUserMem, as it isn't used
- FUserMem := nil;
- // Create environment handle
- if OCIEnvCreate(FOciEnvironment,oci_default,nil,nil,nil,nil,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrEnvCreateFailed,self);
- // Create error handle
- if OciHandleAlloc(FOciEnvironment,FOciError,OCI_HTYPE_ERROR,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrHandleAllocFailed,self);
- // Create Server handle
- if OciHandleAlloc(FOciEnvironment,FOciServer,OCI_HTYPE_SERVER,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrHandleAllocFailed,self);
- // Initialize Server handle
- if hostname='' then connectstring := databasename
- else connectstring := '//'+hostname+'/'+databasename;
- if OCIServerAttach(FOciServer,FOciError,@(ConnectString[1]),Length(ConnectString),OCI_DEFAULT) <> OCI_SUCCESS then
- HandleError();
- // Create temporary service-context handle for user-authentication
- if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrHandleAllocFailed,self);
- // Create user-session handle
- if OciHandleAlloc(FOciEnvironment,FOciUserSession,OCI_HTYPE_SESSION,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrHandleAllocFailed,self);
- // Set the server-handle in the service-context handle
- if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
- HandleError();
- // Set username and password in the user-session handle
- if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.UserName[1]),Length(Self.UserName),OCI_ATTR_USERNAME,FOciError) <> OCI_SUCCESS then
- HandleError();
- if OCIAttrSet(FOciUserSession,OCI_HTYPE_SESSION,@(Self.Password[1]),Length(Self.Password),OCI_ATTR_PASSWORD,FOciError) <> OCI_SUCCESS then
- HandleError();
- // Authenticate
- if OCISessionBegin(TempServiceContext,FOciError,FOcIUserSession,OCI_CRED_RDBMS,OCI_DEFAULT) <> OCI_SUCCESS then
- HandleError();
- // Free temporary service-context handle
- OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
- end;
- procedure TOracleConnection.DoInternalDisconnect;
- var
- TempServiceContext : POCISvcCtx;
- begin
- inherited DoInternalDisconnect;
- // Create temporary service-context handle for user-disconnect
- if OciHandleAlloc(FOciEnvironment,TempServiceContext,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrHandleAllocFailed,self);
- // Set the server handle in the service-context handle
- if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
- HandleError();
- // Set the user session handle in the service-context handle
- if OCIAttrSet(TempServiceContext,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
- HandleError();
- // Disconnect uses-session handle
- if OCISessionEnd(TempServiceContext,FOciError,FOcIUserSession,OCI_DEFAULT) <> OCI_SUCCESS then
- HandleError();
- // Free user-session handle
- OCIHandleFree(FOciUserSession,OCI_HTYPE_SESSION);
- // Free temporary service-context handle
- OCIHandleFree(TempServiceContext,OCI_HTYPE_SVCCTX);
- // Disconnect server handle
- if OCIServerDetach(FOciServer,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
- HandleError();
- // Free connection handles
- OCIHandleFree(FOciServer,OCI_HTYPE_SERVER);
- OCIHandleFree(FOciError,OCI_HTYPE_ERROR);
- OCIHandleFree(FOciEnvironment,OCI_HTYPE_ENV);
- {$IfDef LinkDynamically}
- ReleaseOCI;
- {$EndIf}
- end;
- function TOracleConnection.AllocateCursorHandle: TSQLCursor;
- var Cursor : TOracleCursor;
- begin
- Cursor:=TOracleCursor.Create;
- Result := cursor;
- end;
- procedure TOracleConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
- var tel : word;
- begin
- with cursor as TOracleCursor do
- begin
- if Length(FieldBuffers) > 0 then
- for tel := 0 to high(FieldBuffers) do freemem(FieldBuffers[tel].buffer);
- end;
- FreeAndNil(cursor);
- end;
- function TOracleConnection.AllocateTransactionHandle: TSQLHandle;
- var
- locRes : TOracleTrans;
- begin
- locRes := TOracleTrans.Create();
- try
- // Allocate service-context handle
- if OciHandleAlloc(FOciEnvironment,locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrHandleAllocFailed,self);
- // Set the server-handle in the service-context handle
- if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciServer,0,OCI_ATTR_SERVER,FOciError) <> OCI_SUCCESS then
- HandleError();
- // Set the user-session handle in the service-context handle
- if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,FOciUserSession,0,OCI_ATTR_SESSION,FOciError) <> OCI_SUCCESS then
- HandleError();
- // Allocate transaction handle
- if OciHandleAlloc(FOciEnvironment,locRes.FOciTrans,OCI_HTYPE_TRANS,0,FUserMem) <> OCI_SUCCESS then
- DatabaseError(SErrHandleAllocFailed,self);
- // Set the transaction handle in the service-context handle
- if OCIAttrSet(locRes.FOciSvcCtx,OCI_HTYPE_SVCCTX,locRes.FOciTrans,0,OCI_ATTR_TRANS,FOciError) <> OCI_SUCCESS then
- HandleError();
- except
- locRes.Free();
- raise;
- end;
- Result := locRes;
- end;
- procedure TOracleConnection.PrepareStatement(cursor: TSQLCursor;
- ATransaction: TSQLTransaction; buf: string; AParams: TParams);
-
- var tel : integer;
- FOcibind : POCIDefine;
-
- OFieldType : ub2;
- OFieldSize : sb4;
- begin
- with cursor as TOracleCursor do
- begin
- if OCIStmtPrepare2(TOracleTrans(ATransaction.Handle).FOciSvcCtx,FOciStmt,FOciError,@buf[1],length(buf),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT) = OCI_ERROR then
- HandleError;
- if assigned(AParams) then
- begin
- setlength(ParamBuffers,AParams.Count);
- for tel := 0 to AParams.Count-1 do
- begin
- case AParams[tel].DataType of
- ftInteger : begin OFieldType := SQLT_INT; OFieldSize := sizeof(integer); end;
- ftFloat : begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
- ftDate, ftDateTime : begin OFieldType := SQLT_DAT; OFieldSize := 7; end;
- ftString : begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
- end;
- parambuffers[tel].buffer := getmem(OFieldSize);
- FOciBind := nil;
- if OCIBindByName(FOciStmt,FOcibind,FOciError,pchar(AParams[tel].Name),length(AParams[tel].Name),ParamBuffers[tel].buffer,OFieldSize,OFieldType,@ParamBuffers[tel].ind,nil,nil,0,nil,OCI_DEFAULT )= OCI_ERROR then
- HandleError;
- end;
- end;
- FPrepared := True;
- end;
- end;
- procedure TOracleConnection.SetParameters(cursor : TSQLCursor;AParams : TParams);
- var SQLVarNr : integer;
- i : integer;
- f : double;
- year,month,day : word;
- db : array[0..4] of byte;
- pb : pbyte;
- s : string;
- begin
- with cursor as TOracleCursor do for SQLVarNr := 0 to High(ParamBuffers) do with AParams[SQLVarNr] do
- begin
- if IsNull then parambuffers[SQLVarNr].ind := -1 else
- parambuffers[SQLVarNr].ind := 0;
- case DataType of
- ftInteger : begin
- i := asInteger;
- move(i,parambuffers[SQLVarNr].buffer^,sizeof(integer));
- end;
- ftFloat : begin
- f := asFloat;
- move(f,parambuffers[SQLVarNr].buffer^,sizeof(double));
- end;
- ftString : begin
- s := asString+#0;
- move(s[1],parambuffers[SQLVarNr].buffer^,length(s)+1);
- end;
- ftDate, ftDateTime: begin
- DecodeDate(asDateTime,year,month,day);
- pb := parambuffers[SQLVarNr].buffer;
- pb[0] := (year div 100)+100;
- pb[1] := (year mod 100)+100;
- pb[2] := month;
- pb[3] := day;
- pb[4] := 1;
- pb[5] := 1;
- pb[6] := 1;
- end;
- end;
- end;
- end;
- procedure TOracleConnection.UnPrepareStatement(cursor: TSQLCursor);
- begin
- if OCIStmtRelease(TOracleCursor(cursor).FOciStmt,FOciError,nil,0,OCI_DEFAULT)<> OCI_SUCCESS then
- HandleError();
- cursor.FPrepared:=False;
- end;
- procedure TOracleConnection.InternalStartDBTransaction(trans : TOracleTrans);
- begin
- if OCITransStart(trans.FOciSvcCtx,FOciError,DefaultTimeOut,trans.FOciFlags) <> OCI_SUCCESS then
- HandleError();
- end;
- function TOracleConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
- begin
- Result := trans;
- end;
- function TOracleConnection.StartDBTransaction(trans: TSQLHandle; AParams: string): boolean;
- var
- x_flags : ub4;
- i : Integer;
- s : string;
- locTrans : TOracleTrans;
- begin
- locTrans := TOracleTrans(trans);
- if ( Length(AParams) = 0 ) then begin
- x_flags := OCI_TRANS_NEW or OCI_TRANS_READWRITE;
- end else begin
- x_flags := OCI_DEFAULT;
- i := 1;
- s := ExtractSubStr(AParams,i,StdWordDelims);
- while ( s <> '' ) do begin
- if ( s = 'readonly' ) then
- x_flags := x_flags and OCI_TRANS_READONLY
- else if ( s = 'serializable' ) then
- x_flags := x_flags and OCI_TRANS_SERIALIZABLE
- else if ( s = 'readwrite' ) then
- x_flags := x_flags and OCI_TRANS_READWRITE;
- s := ExtractSubStr(AParams,i,StdWordDelims);
- end;
- x_flags := x_flags and OCI_TRANS_NEW;
- end;
- locTrans.FOciFlags := x_flags;
- InternalStartDBTransaction(locTrans);
- Result := True;
- end;
- function TOracleConnection.Commit(trans: TSQLHandle): boolean;
- begin
- if OCITransCommit(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
- HandleError();
- Result := True;
- end;
- function TOracleConnection.Rollback(trans: TSQLHandle): boolean;
- begin
- if OCITransRollback(TOracleTrans(trans).FOciSvcCtx,FOciError,OCI_DEFAULT) <> OCI_SUCCESS then
- HandleError();
- Result := True;
- end;
- procedure TOracleConnection.CommitRetaining(trans: TSQLHandle);
- begin
- Commit(trans);
- InternalStartDBTransaction(TOracleTrans(trans));
- end;
- procedure TOracleConnection.RollbackRetaining(trans: TSQLHandle);
- begin
- Rollback(trans);
- InternalStartDBTransaction(TOracleTrans(trans));
- end;
- procedure TOracleConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
- begin
- if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, AParams);
- if cursor.FStatementType = stSelect then
- begin
- if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,0,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
- HandleError;
- end
- else
- begin
- if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,1,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then
- HandleError;
- end;
- end;
- function TOracleConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
- var rowcount: ub4;
- begin
- if OCIAttrGet((cursor as TOracleCursor).FOciStmt, OCI_HTYPE_STMT, @rowcount, nil, OCI_ATTR_ROW_COUNT, FOciError) = OCI_SUCCESS then
- Result:=rowcount
- else
- Result:=inherited RowsAffected(cursor);
- end;
- procedure TOracleConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
- var Param : POCIParam;
- tel : ub4;
- FieldType : TFieldType;
- FieldName : string;
- FieldSize : word;
- OFieldType : ub2;
- OFieldName : Pchar;
- OFieldSize : sb4;
- OFNameLength : ub4;
- NumCols : ub4;
- FOciDefine : POCIDefine;
- OPrecision : sb2;
- OScale : sb1;
- begin
- Param := nil;
- with cursor as TOracleCursor do
- begin
- if OCIAttrGet(FOciStmt,OCI_HTYPE_STMT,@numcols,nil,OCI_ATTR_PARAM_COUNT,FOciError) = OCI_ERROR then
- HandleError;
- // Let op, moet gewist worden. En in een keer gealloceerd
- Setlength(FieldBuffers,numcols);
- for tel := 1 to numcols do
- begin
- if OCIParamGet(FOciStmt,OCI_HTYPE_STMT,FOciError,Param,tel) = OCI_ERROR then
- HandleError;
- if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldType,nil,OCI_ATTR_DATA_TYPE,FOciError) = OCI_ERROR then
- HandleError;
- if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldSize,nil,OCI_ATTR_DATA_SIZE,FOciError) = OCI_ERROR then
- HandleError;
- FieldSize := 0;
-
- case OFieldType of
- OCI_TYPECODE_NUMBER : begin
- if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oprecision,nil,OCI_ATTR_PRECISION,FOciError) = OCI_ERROR then
- HandleError;
- if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
- HandleError;
- if Oscale = 0 then
- begin
- FieldType := ftInteger;
- OFieldType := SQLT_INT;
- OFieldSize:= sizeof(integer);
- end
- else if (oscale = -127) {and (OPrecision=0)} then
- begin
- FieldType := ftFloat;
- OFieldType := SQLT_FLT;
- OFieldSize:=sizeof(double);
- end
- else if (oscale <=4) and (OPrecision<=12) then
- begin
- FieldType := ftBCD;
- FieldSize := oscale;
- OFieldType := SQLT_VNU;
- OFieldSize:= 22;
- end
- else FieldType := ftUnknown;
- end;
- OCI_TYPECODE_CHAR,
- OCI_TYPECODE_VARCHAR,
- OCI_TYPECODE_VARCHAR2 : begin FieldType := ftString; FieldSize := OFieldSize; inc(OFieldsize) ;OFieldType:=SQLT_STR end;
- OCI_TYPECODE_DATE : FieldType := ftDate;
- OCI_TYPECODE_TIMESTAMP,
- OCI_TYPECODE_TIMESTAMP_LTZ,
- OCI_TYPECODE_TIMESTAMP_TZ : begin
- FieldType := ftDateTime;
- OFieldType := SQLT_ODT;
- end;
- else
- FieldType := ftUnknown;
- end;
- FieldBuffers[tel-1].buffer := getmem(OFieldSize);
- FOciDefine := nil;
- if OciDefineByPos(FOciStmt,FOciDefine,FOciError,tel,fieldbuffers[tel-1].buffer,OFieldSize,OFieldType,@(fieldbuffers[tel-1].ind),nil,nil,OCI_DEFAULT) = OCI_ERROR then
- HandleError;
- if OCIAttrGet(Param,OCI_DTYPE_PARAM,@OFieldName,@OFNameLength,OCI_ATTR_NAME,FOciError) <> OCI_SUCCESS then
- HandleError;
- setlength(Fieldname,OFNameLength);
- move(OFieldName^,Fieldname[1],OFNameLength);
- TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, False, tel);
- end;
- end;
- end;
- function TOracleConnection.Fetch(cursor: TSQLCursor): boolean;
- begin
- case OCIStmtFetch2((cursor as TOracleCursor).FOciStmt,FOciError,1,OCI_FETCH_NEXT,1,OCI_DEFAULT) of
- OCI_ERROR : begin
- Result := False;
- HandleError;
- end;
- OCI_NO_DATA : Result := False;
- OCI_SUCCESS : Result := True;
- OCI_SUCCESS_WITH_INFO : Begin
- Result := True;
- HandleError;
- end;
- end; {case}
- end;
- function TOracleConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
- var dt : TDateTime;
- b : pbyte;
- size,i : byte;
- exp : shortint;
- cur : Currency;
- odt : POCIdateTime;
- begin
- CreateBlob := False;
- with cursor as TOracleCursor do if fieldbuffers[FieldDef.FieldNo-1].ind = -1 then
- Result := False
- else
- begin
- result := True;
- case FieldDef.DataType of
- ftString : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,FieldDef.Size);
- ftBCD : begin
- b := fieldbuffers[FieldDef.FieldNo-1].buffer;
- size := b[0];
- cur := 0;
- if (b[1] and $80)=$80 then // then the number is positive
- begin
- exp := (b[1] and $7f)-65;
- for i := 2 to size do
- cur := cur + (b[i]-1) * intpower(100,-(i-2)+exp);
- end
- else
- begin
- exp := (not(b[1]) and $7f)-65;
- for i := 2 to size-1 do
- cur := cur + (101-b[i]) * intpower(100,-(i-2)+exp);
- cur := -cur;
- end;
- move(cur,buffer^,SizeOf(Currency));
- end;
- ftFloat : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
- ftInteger : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
- ftDate : begin
- b := fieldbuffers[FieldDef.FieldNo-1].buffer;
- dt := EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]);
- move(dt,buffer^,sizeof(dt));
- end;
- ftDateTime : begin
- odt := fieldbuffers[FieldDef.FieldNo-1].buffer;
- dt := ComposeDateTime(EncodeDate(odt^.year,odt^.month,odt^.day), EncodeTime(odt^.hour,odt^.min,odt^.sec,0));
- move(dt,buffer^,sizeof(dt));
- end;
- else
- Result := False;
- end;
- end;
- end;
- {function TOracleConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
- begin
- // Result:=inherited CreateBlobStream(Field, Mode);
- end;}
- procedure TOracleConnection.FreeFldBuffers(cursor: TSQLCursor);
- begin
- // inherited FreeFldBuffers(cursor);
- end;
- constructor TOracleConnection.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FConnOptions := FConnOptions + [sqEscapeRepeat];
- FUserMem := nil;
- end;
- { TOracleConnectionDef }
- class function TOracleConnectionDef.TypeName: String;
- begin
- Result:='Oracle';
- end;
- class function TOracleConnectionDef.ConnectionClass: TSQLConnectionClass;
- begin
- Result:=TOracleConnection;
- end;
- class function TOracleConnectionDef.Description: String;
- begin
- Result:='Connect to an Oracle database directly via the client library';
- end;
- { TOracleTrans }
- destructor TOracleTrans.Destroy();
- begin
- OCIHandleFree(FOciTrans,OCI_HTYPE_TRANS);
- OCIHandleFree(FOciSvcCtx,OCI_HTYPE_SVCCTX);
- inherited Destroy();
- end;
- initialization
- RegisterConnection(TOracleConnectionDef);
- finalization
- RegisterConnection(TOracleConnectionDef);
- end.
|