oradb.pas

delphi通过OCI访问ORACLE

unit OraDB;

{$INCLUDE dOCI.inc}

{
  TOraDB - component to connect to Oracle
  All other components (such as TOraSQL, TAOraSQL) use this component to get access to Oracle server

  You can get more information about TOraDB in documentation.

   procedure Open; - establishes connect to server
   procedure Close; - closes connect
   procedure StartTransaction; - sets InTransaction=True and sets transaction isolation level. no OCI calls performed.
   procedure CommitTransaction; - calls before and after events and executes OCITransCommit.
   procedure RollbackTransaction; - calls OnRollback event and executes OCITransRollback.
   procedure Break; // executes OCIBreak
   property  InTransaction:boolean - determines is transaction in process.
}


interface

uses
  Db, Classes, Windows, OraDefines, ADataSet, dOCIMessages;

const OraLibName='oci.dll'; // OCI library main file name (can be changed in OnBeforeInitOCI event)

type
  TOraDB=class;

  TOraConnectAs   = (caNormal, caSYSDBA, caSYSOPER);

  TOraTransIsolationLevel   = (tiDefault, tiReadCommited, tiRepeatableRead, tiReadOnly);
  TOraSessionIsolationLevel = (siDefault, siReadCommited, siRepeatableRead);
  TOraSQLTrace  = (stDefault, stTrue, stFalse);

  TBeforeLoginEvent = procedure(Sender: TOraDB;var ConnectString, Username, Password: string;Accept:boolean) of object;
  TAfterLoginEvent  = procedure(Sender: TOraDB) of object;
  TBeforeInitOCI    = procedure(Sender: TOraDB;LibName:string;Accept:boolean) of object;
  TAfterInitOCI     = procedure(Sender: TOraDB) of object;


  TOraPreferences = class(TPersistent)
  private
    FConvertCRLF:boolean;
    FFloatPrecision:integer;
    FIntegerPrecision:integer;
    FSmallIntPrecision:integer;
//   FMaxStringFieldSize:integer;
  public
    constructor Create;
  published
    property ConvertCRLF:boolean read FConvertCRLF write FConvertCRLF default True;
    property FloatPrecision:integer read FFloatPrecision write FFloatPrecision default 0;
    property IntegerPrecision:integer read FIntegerPrecision write FIntegerPrecision default 0;
    property SmallIntPrecision:integer read FSmallIntPrecision write FSmallIntPrecision default 0;
//   property MaxStringFieldSize:integer read FMaxStringFieldSize write FMaxStringFieldSize;
  end;

  TOraDB = class(TADataBase)
  private
    hDll:THandle;
    FStreamedActive:boolean;
    FActive:boolean;
    FStarted:boolean;
    FName,FPassword,FServer:string;
    FLoginPrompt:boolean;
    FInTransaction:boolean;
    FOraTransIsolationLevel:TOraTransIsolationLevel;
    FOraSessionIsolationLevel:TOraSessionIsolationLevel;
    FRollbackOnDisconnect:boolean;
    FConnectAs:TOraConnectAs;
    FSQLTrace:TOraSQLTrace;
    FPreferences:TOraPreferences;

    FBeforeInitOCI:TBeforeInitOCI;
    FAfterInitOCI:TAfterInitOCI;
    FBeforeLoginEvent:TBeforeLoginEvent;
    FAfterLoginEvent:TAfterLoginEvent;
    FBeforeCommit:TNotifyEvent;
    FAfterCommit:TNotifyEvent;
    FOnStartTransaction:TNotifyEvent;
    FOnRollback:TNotifyEvent;



    FOraRegKey:string;
    FOraHome:string;
    FOraDllName:string;
    FOraIsPO8:boolean;
    FOraTnsNames:string;
    FOraDllVersion:integer;

    procedure GetOCIVersion;
    procedure LoadTNSPaths;
    procedure LoadOCIPaths;
    procedure InitOCI;

  protected
    procedure Loaded; override;
    procedure SetSessionIsolationLevel;
    procedure SetTransIsolationLevel;
    procedure SetSQLTrace;
    procedure SetActive(Value:boolean);override;
    function GetActive:boolean;override;

  public
    myenvhp:pOCIEnv;
    mysrvhp:pOCIServer;
    dberrhp:pOCIError;
    myusrhp:pOCISession;
    mysvchp:pOCISvcCtx;

    OCIEnvCreate:TOCIEnvCreate;
    OCIInitialize:TOCIInitialize;
    OCIEnvInit:TOCIEnvInit;
    OCIHandleAlloc:TOCIHandleAlloc;
    OCIServerAttach:TOCIServerAttach;
    OCIAttrSet:TOCIAttrSet;
    OCISessionBegin:TOCISessionBegin;
    OCISessionEnd:TOCISessionEnd;
    OCIServerDetach:TOCIServerDetach;
    OCIHandleFree:TOCIHandleFree;
    OCIErrorGet:TOCIErrorGet;
    OCIStmtPrepare:TOCIStmtPrepare;
    OCIStmtExecute:TOCIStmtExecute;
    OCIParamGet:TOCIParamGet;
    OCIAttrGet:TOCIAttrGet;
    OCIStmtFetch:TOCIStmtFetch;
    OCIDefineByPos:TOCIDefineByPos;
    OCIDefineArrayOfStruct:TOCIDefineArrayOfStruct;
    OCIBindByPos:TOCIBindByPos;
    OCIBindByName:TOCIBindByName;
    OCITransStart:TOCITransStart;
    OCITransCommit:TOCITransCommit;
    OCITransRollback:TOCITransRollback;
    OCIDescribeAny:TOCIDescribeAny;
    OCIBreak:TOCIBreak;
    OCIDescriptorAlloc:TOCIDescriptorAlloc;
    OCIDescriptorFree:TOCIDescriptorFree;
    OCILobRead:TOCILobRead;
    OCILobWrite:TOCILobWrite;
    OCIStmtGetPieceInfo:TOCIStmtGetPieceInfo;
    OCIStmtSetPieceInfo:TOCIStmtSetPieceInfo;
    OCILobGetLength:TOCILobGetLength;
    OCILobErase:TOCILobErase;
    OCILobTrim:TOCILobTrim;

    procedure GetServicesList(AList: TStrings);

    function TestError(where:string;ex:sword):sword;

    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Open;override;
    procedure Close;override;
    procedure StartTransaction;
    procedure CommitTransaction;
    procedure RollbackTransaction;
    procedure Break; // calls OCIBreak

    property  InTransaction:boolean read FInTransaction;
  published
    property Active;//:boolean read FActive write DoActive default False;
    property DBLogin:string read FName write FName;
    property DBPassword:string read FPassword write FPassword;
    property DBServer:string read FServer write FServer;
    property LoginPrompt:boolean read FLoginPrompt write FLoginPrompt default True;
    property OraTransIsolationLevel:TOraTransIsolationLevel read FOraTransIsolationLevel write FOraTransIsolationLevel;
    property OraSessionIsolationLevel:TOraSessionIsolationLevel read FOraSessionIsolationLevel write FOraSessionIsolationLevel;
    property RollbackOnDisconnect:boolean read FRollbackOnDisconnect write FRollbackOnDisconnect;
    property ConnectAs:TOraConnectAs read FConnectAs write FConnectAs;
    property SQLTrace:TOraSQLTrace read FSQLTrace write FSQLTrace;
    property Preferences:TOraPreferences read FPreferences write FPreferences;
    property BeforeInitOCI:TBeforeInitOCI read FBeforeInitOCI write FBeforeInitOCI;
    property AfterInitOCI :TAfterInitOCI read FAfterInitOCI write FAfterInitOCI;
    property BeforeLogin:TBeforeLoginEvent read FBeforeLoginEvent write FBeforeLoginEvent;
    property AfterLogin:TAfterLoginEvent read FAfterLoginEvent write FAfterLoginEvent;
    property OnStartTransaction:TNotifyEvent read FOnStartTransaction write FOnStartTransaction;
    property BeforeCommit:TNotifyEvent read FBeforeCommit write FBeforeCommit;
    property AfterCommit:TNotifyEvent read FAfterCommit write FAfterCommit;
  end;


const
   // Oracle client version constants
    OraVer80000 = 800000000;
    OraVer80400 = 800040000;
    OraVer80500 = 800050000;
    OraVer80501 = 800050001;
    OraVer81000 = 801000000;
    OraVer81500 = 801050000;

implementation

uses SysUtils, Dblogdlg, Registry, OraError, OraUtils;

(*
const

NumberOfUsedOCIFunctions = 33;

UsedOCIFunctionNames : array[1..NumberOfUsedOCIFunctions ] of string = (
{'OCIEnvCreate',}'OCIInitialize','OCIEnvInit','OCIHandleAlloc','OCIServerAttach',
'OCIAttrSet','OCISessionBegin','OCISessionEnd','OCIServerDetach','OCIHandleFree',
'OCIErrorGet','OCIStmtPrepare','OCIStmtExecute','OCIParamGet','OCIAttrGet',
'OCIStmtFetch','OCIDefineByPos','OCIDefineArrayOfStruct','OCIBindByPos',
'OCIBindByName','OCITransStart','OCITransCommit','OCITransRollback','OCIDescribeAny',
'OCIBreak','OCIDescriptorAlloc','OCIDescriptorFree','OCILobRead','OCILobWrite',
'OCIStmtGetPieceInfo','OCIStmtSetPieceInfo','OCILobGetLength','OCILobErase','OCILobTrim');
*)


 { TOraPreferences }

constructor TOraPreferences.Create;
begin
// inherited Create;
 ConvertCRLF:=True;
end;

 { TOraDB }

constructor TOraDB.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 FInTransaction := False;
 FLoginPrompt := True;
 FRollbackOnDisconnect := False;
 FConnectAs := caNormal;
 FSQLTrace:=stDefault;
 FPreferences := TOraPreferences.Create;
end;

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

 FPreferences.Free;
 if Active then Close;
 inherited Destroy;

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


procedure TOraDB.Loaded;
begin
 inherited Loaded;
 Active:=FStreamedActive;
end;

function TOraDB.TestError(where:string;ex:sword):sword;
var errcode:sb4;
    errbuf:array[0..511] of char;
begin
 Result:=ex;
 case ex of
  OCI_SUCCESS: exit;
  OCI_SUCCESS_WITH_INFO: raise EDatabaseError.Create(sOraErrSuccessWithInfo);
  OCI_NEED_DATA: raise EDatabaseError.Create(sOraErrNeedData);
  OCI_NO_DATA: raise EDatabaseError.Create(sOraErrNoData);
  OCI_ERROR: begin
              OCIErrorGet(dberrhp,1,nil,errcode,errbuf,sizeof(errbuf),OCI_HTYPE_ERROR);
              raise EDatabaseError.Create('Oracle error #'+inttostr(errcode)+': '+strpas(errbuf));
             end;
  OCI_INVALID_HANDLE: raise EDatabaseError.Create(sOraErrInvalidHandle);
  OCI_STILL_EXECUTING: raise EDatabaseError.Create(sOraErrStillExecute);
  else raise EDatabaseError.Create(sOraErrUNKNOWN);
 end;
end;

procedure TOraDB.InitOCI;
var Accept:boolean;
    LibName:string;
//    FirstFunc:pointer;
//    p:^pointer;
    errstr:string;
//    i:integer;
    errbuf: PChar;
begin
 if FStarted then exit;

 LoadOCIPaths;
 GetOCIVersion;
 LoadTNSPaths;
 LibName:=FOraDllName;

 Accept:=True;
 if Assigned(FBeforeInitOCI) then FBeforeInitOCI(self, LibName, Accept);
 if not Accept then exit;

 hDll:=LoadLibrary(PChar(LibName));
 if hDll=0 then begin
    FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
                  nil, GetLastError(), (SUBLANG_DEFAULT shl 10) or LANG_NEUTRAL,
                  PChar(@errbuf), 0, nil);
    errstr := errbuf;
    LocalFree(HLOCAL(errbuf));
//     ADatabaseErrorFmt(sOraErrLoadLibrary, [s], nil);
    raise Exception.CreateFmt(sOraErrLoadLibrary, [errstr]);
 end;

  @OCIEnvCreate:=GetProcAddress(hDll,'OCIEnvCreate');
  @OCIInitialize:=GetProcAddress(hDll,'OCIInitialize');
  @OCIEnvInit:=GetProcAddress(hDll,'OCIEnvInit');
  @OCIHandleAlloc:=GetProcAddress(hDll,'OCIHandleAlloc');
  @OCIServerAttach:=GetProcAddress(hDll,'OCIServerAttach');
  @OCIAttrSet:=GetProcAddress(hDll,'OCIAttrSet');
  @OCISessionBegin:=GetProcAddress(hDll,'OCISessionBegin');
  @OCISessionEnd:=GetProcAddress(hDll,'OCISessionEnd');
  @OCIServerDetach:=GetProcAddress(hDll,'OCIServerDetach');
  @OCIHandleFree:=GetProcAddress(hDll,'OCIHandleFree');
  @OCIErrorGet:=GetProcAddress(hDll,'OCIErrorGet');
  @OCIStmtPrepare:=GetProcAddress(hDll,'OCIStmtPrepare');
  @OCIStmtExecute:=GetProcAddress(hDll,'OCIStmtExecute');
  @OCIParamGet:=GetProcAddress(hDll,'OCIParamGet');
  @OCIAttrGet:=GetProcAddress(hDll,'OCIAttrGet');
  @OCIStmtFetch:=GetProcAddress(hDll,'OCIStmtFetch');
  @OCIDefineByPos:=GetProcAddress(hDll,'OCIDefineByPos');
  @OCIDefineArrayOfStruct:=GetProcAddress(hDll,'OCIDefineArrayOfStruct');
  @OCIBindByPos:=GetProcAddress(hDll,'OCIBindByPos');
  @OCIBindByName:=GetProcAddress(hDll,'OCIBindByName');
  @OCITransStart:=GetProcAddress(hDll,'OCITransStart');
  @OCITransCommit:=GetProcAddress(hDll,'OCITransCommit');
  @OCITransRollback:=GetProcAddress(hDll,'OCITransRollback');
  @OCIDescribeAny:=GetProcAddress(hDll,'OCIDescribeAny');
  @OCIBreak:=GetProcAddress(hDll,'OCIBreak');
  @OCIDescriptorAlloc:=GetProcAddress(hDll,'OCIDescriptorAlloc');
  @OCIDescriptorFree:=GetProcAddress(hDll,'OCIDescriptorFree');
  @OCILobRead:=GetProcAddress(hDll,'OCILobRead');
  @OCILobWrite:=GetProcAddress(hDll,'OCILobWrite');
  @OCIStmtGetPieceInfo:=GetProcAddress(hDll,'OCIStmtGetPieceInfo');
  @OCIStmtSetPieceInfo:=GetProcAddress(hDll,'OCIStmtSetPieceInfo');
  @OCILobGetLength:=GetProcAddress(hDll,'OCILobGetLength');
  @OCILobErase:=GetProcAddress(hDll,'OCILobErase');
  @OCILobTrim:=GetProcAddress(hDll,'OCILobTrim');
  FStarted:=True;

 {errstr:='';
 FirstFunc:=@@OCIInitialize;
 for i:=1 to NumberOfUsedOCIFunctions do begin
   p:=pointer(integer(FirstFunc)+sizeof(pointer)*(i-1));
   if p^=nil then errstr:=errstr+UsedOCIFunctionNames[i]+' ';
 end;
 if errstr<>'' then raise EDatabaseError.CreateFmt(sOraErrCannotGetFunctions,[errstr]);
  }
 if Assigned(FAfterInitOCI) then FAfterInitOCI(self);
end;

procedure TOraDB.SetSessionIsolationLevel;
var str:array[0..1023] of char;
    mystmthp:pOCIStmt;
begin
 if not FActive then exit;

 case FOraSessionIsolationLevel of
  siReadCommited   : str:='ALTER SESSION SET ISOLATION_LEVEL = READ COMMITTED'; // don't translate
  siRepeatableRead : str:='ALTER SESSION SET ISOLATION_LEVEL = SERIALIZABLE';   // don't translate
  siDefault        : exit;
 end;

 // setting Isolation Level for current session
 TestError('OCIHandleAlloc - ',OCIHandleAlloc(myenvhp,mystmthp,OCI_HTYPE_STMT,0,nil));

 TestError('OCIStmtPrepare - ',OCIStmtPrepare(mystmthp,dberrhp,str,strlen(str),OCI_NTV_SYNTAX,OCI_DEFAULT));

 TestError('OCIStmtExecute ',OCIStmtExecute(mysvchp,mystmthp,dberrhp,1,0,nil,nil,OCI_DEFAULT));

 TestError('OCIHandleFree - ',OCIHandleFree(mystmthp,OCI_HTYPE_STMT));
end;

procedure TOraDB.SetTransIsolationLevel;
var str:array[0..256] of char;