home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d45 / ARDOCI.ZIP / OraDB.pas < prev    next >
Pascal/Delphi Source File  |  2001-03-01  |  14KB  |  407 lines
  1. unit OraDB;
  2.  
  3. {
  4.   TOraDB - connect to oracle
  5.   All other components (such as TOraSQL, TAOraSQL) use this component to get access to oracle server
  6.  
  7.   You can get more information about TOraDB in documentation.
  8.  
  9.   procedure Open;
  10.    procedure Close;
  11.    procedure StartTransaction;
  12.    procedure CommitTransaction;
  13.    procedure RollbackTransaction;
  14.    procedure Break; // Γ√∩εδφ σ≥ OCIBreak
  15.    property  InTransaction:boolean read FTransaction;
  16. }
  17.  
  18. interface
  19.  
  20. uses
  21.   Db, Classes, Windows, OraDefines, ADataSet;
  22.  
  23. const OraLibName='oci.dll';
  24.  
  25. type
  26.   TOraDB=class;
  27.  
  28.   TOraTransIsolationLevel   = (tiDefault, tiReadCommited, tiRepeatableRead, tiReadOnly);
  29.   TOraSessionIsolationLevel = (siDefault, siReadCommited, siRepeatableRead);
  30.  
  31.   TBeforeLoginEvent = procedure(Sender: TOraDB;var ConnectString, Username, Password: string;Accept:boolean) of object;
  32.   TAfterLoginEvent  = procedure(Sender: TOraDB) of object;
  33.   TBeforeInitOCI    = procedure(Sender: TOraDB;LibName:string;Accept:boolean) of object;
  34.   TAfterInitOCI     = procedure(Sender: TOraDB) of object;
  35.  
  36.   TOraDB = class(TADataBase)
  37.   private
  38.    hDll:THandle;
  39.    FStreamedActive:boolean;
  40.    FActive:boolean;
  41.    FStarted:boolean;
  42.    FName,FPassword,FServer:string;
  43.    FTransaction:boolean;
  44.    FOraTransIsolationLevel:TOraTransIsolationLevel;
  45.    FOraSessionIsolationLevel:TOraSessionIsolationLevel;
  46.  
  47.    FBeforeInitOCI:TBeforeInitOCI;
  48.    FAfterInitOCI:TAfterInitOCI;
  49.    FBeforeLoginEvent:TBeforeLoginEvent;
  50.    FAfterLoginEvent:TAfterLoginEvent;
  51.    FBeforeCommit:TNotifyEvent;
  52.    FAfterCommit:TNotifyEvent;
  53.    FOnStartTransaction:TNotifyEvent;
  54.    FOnRollback:TNotifyEvent;
  55.  
  56.    procedure DoActive(Value:boolean);
  57.    procedure InitOCI;
  58.   protected
  59.    procedure Loaded; override;
  60.    procedure SetSessionIsolationLevel;
  61.    procedure SetTransIsolationLevel;   
  62.   public
  63.    myenvhp:pOCIEnv;
  64.    mysrvhp:pOCIServer;
  65.    dberrhp:pOCIError;
  66.    myusrhp:pOCISession;
  67.    mysvchp:pOCISvcCtx;
  68.  
  69.    OCIInitialize:TOCIInitialize;
  70.    OCIEnvInit:TOCIEnvInit;
  71.    OCIHandleAlloc:TOCIHandleAlloc;
  72.    OCIServerAttach:TOCIServerAttach;
  73.    OCIAttrSet:TOCIAttrSet;
  74.    OCISessionBegin:TOCISessionBegin;
  75.    OCISessionEnd:TOCISessionEnd;
  76.    OCIServerDetach:TOCIServerDetach;
  77.    OCIHandleFree:TOCIHandleFree;
  78.    OCIErrorGet:TOCIErrorGet;
  79.    OCIStmtPrepare:TOCIStmtPrepare;
  80.    OCIStmtExecute:TOCIStmtExecute;
  81.    OCIParamGet:TOCIParamGet;
  82.    OCIAttrGet:TOCIAttrGet;
  83.    OCIStmtFetch:TOCIStmtFetch;
  84.    OCIDefineByPos:TOCIDefineByPos;
  85.    OCIDefineArrayOfStruct:TOCIDefineArrayOfStruct;
  86.    OCIBindByPos:TOCIBindByPos;
  87.    OCIBindByName:TOCIBindByName;
  88.    OCITransStart:TOCITransStart;
  89.    OCITransCommit:TOCITransCommit;
  90.    OCITransRollback:TOCITransRollback;
  91.    OCIDescribeAny:TOCIDescribeAny;
  92.    OCIBreak:TOCIBreak;
  93.    OCIDescriptorAlloc:TOCIDescriptorAlloc;
  94.    OCIDescriptorFree:TOCIDescriptorFree;
  95.    OCILobRead:TOCILobRead;
  96.    OCILobWrite:TOCILobWrite;
  97.    OCIStmtGetPieceInfo:TOCIStmtGetPieceInfo;
  98.    OCIStmtSetPieceInfo:TOCIStmtSetPieceInfo;
  99.    OCILobGetLength:TOCILobGetLength;
  100.    OCILobErase:TOCILobErase;
  101.    OCILobTrim:TOCILobTrim;
  102.  
  103.    function TestError(where:string;ex:sword):sword;
  104.  
  105.    constructor Create(AOwner:TComponent); override;
  106.    destructor Destroy; override;
  107.    procedure Open;
  108.    procedure Close;
  109.    procedure StartTransaction;
  110.    procedure CommitTransaction;
  111.    procedure RollbackTransaction;
  112.    procedure Break; // Γ√∩εδφ σ≥ OCIBreak
  113.    property  InTransaction:boolean read FTransaction;
  114.   published
  115.    property Active:boolean read FActive write DoActive default False;
  116.    property DBLogin:string read FName write FName;
  117.    property DBPassword:string read FPassword write FPassword;
  118.    property DBServer:string read FServer write FServer;
  119.    property OraTransIsolationLevel:TOraTransIsolationLevel read FOraTransIsolationLevel write FOraTransIsolationLevel;
  120.    property OraSessionIsolationLevel:TOraSessionIsolationLevel read FOraSessionIsolationLevel write FOraSessionIsolationLevel;
  121.    property BeforeInitOCI:TBeforeInitOCI read FBeforeInitOCI write FBeforeInitOCI;
  122.    property AfterInitOCI :TAfterInitOCI read FAfterInitOCI write FAfterInitOCI;
  123.    property BeforeLogin:TBeforeLoginEvent read FBeforeLoginEvent write FBeforeLoginEvent;
  124.    property AfterLogin:TAfterLoginEvent read FAfterLoginEvent write FAfterLoginEvent;
  125.    property OnStartTransaction:TNotifyEvent read FOnStartTransaction write FOnStartTransaction;
  126.    property BeforeCommit:TNotifyEvent read FBeforeCommit write FBeforeCommit;
  127.    property AfterCommit:TNotifyEvent read FAfterCommit write FAfterCommit;
  128.   end;
  129.  
  130. procedure Register;
  131.  
  132. implementation
  133.  
  134. uses SysUtils;
  135.  
  136. procedure Register;
  137. begin
  138.   RegisterComponents('Data Access', [TOraDB]);
  139. end;
  140.  
  141. constructor TOraDB.Create(AOwner:TComponent);
  142. begin
  143.  inherited Create(AOwner);
  144.  FTransaction:=False;
  145. end;
  146.  
  147. procedure TOraDB.Loaded;
  148. begin
  149.  inherited Loaded;
  150.  Active:=FStreamedActive;
  151. end;
  152.  
  153. function TOraDB.TestError(where:string;ex:sword):sword;
  154. var errcode:sb4;
  155.     errbuf:array[0..511] of char;
  156. {    f:TFileStream;
  157.     len:integer;
  158.     str:string;}
  159. begin
  160. { f:=TFileStream.Create('log.txt',fmOpenReadWrite or fmCreate);
  161.  f.Seek(0,soFromEnd);
  162.  str:='TOraDB '+where;
  163.  len:=length(str);
  164.  f.Write(PChar(str)^,len);
  165.  f.Write(PChar(#13#10)^,2);
  166.  f.free;
  167.  }
  168.  Result:=ex;
  169.  case ex of
  170.   OCI_SUCCESS: exit;
  171.   OCI_SUCCESS_WITH_INFO: raise EDatabaseError.Create('Oracle error: OCI success with info');
  172.   OCI_NEED_DATA: raise EDatabaseError.Create('Oracle error: OCI need data');
  173.   OCI_NO_DATA: raise EDatabaseError.Create('Oracle error: OCI no data');
  174.   OCI_ERROR: begin
  175.               OCIErrorGet(dberrhp,1,nil,errcode,errbuf,sizeof(errbuf),OCI_HTYPE_ERROR);
  176.               raise EDatabaseError.Create('Oracle error #'+inttostr(errcode)+': '+strpas(errbuf));
  177.              end;
  178.   OCI_INVALID_HANDLE: raise EDatabaseError.Create('Oracle error: OCI invalid handle');
  179.   OCI_STILL_EXECUTING: raise EDatabaseError.Create('Oracle error: OCI still execute');
  180.   else raise EDatabaseError.Create('UNKNOWN ORACLE ERROR!');
  181.  end;
  182. end;
  183.  
  184. procedure TOraDB.InitOCI;
  185. var Accept:boolean;
  186.     LibName:string;
  187. begin
  188.  LibName:=OraLibName;
  189.  Accept:=True;
  190.  if Assigned(FBeforeInitOCI) then FBeforeInitOCI(self,LibName,Accept);
  191.  if not Accept then exit;
  192.  
  193.  if not FStarted then begin
  194.  // hDll:=LoadLibrary('ora803.dll');
  195.  { if FileOpen('C:\NoGrab.al',fmOpenRead)>0
  196.    then hDll:=LoadLibrary('oci.dll')
  197.    else hDll:=LoadLibrary('ora803.dll');}
  198.  
  199.   hDll:=LoadLibrary(PChar(LibName));
  200.   if hDll=0 then raise Exception.Create('Error load library "'+LibName+'"!');
  201.  
  202.   @OCIInitialize:=GetProcAddress(hDll,'OCIInitialize');
  203.   @OCIEnvInit:=GetProcAddress(hDll,'OCIEnvInit');
  204.   @OCIHandleAlloc:=GetProcAddress(hDll,'OCIHandleAlloc');
  205.   @OCIServerAttach:=GetProcAddress(hDll,'OCIServerAttach');
  206.   @OCIAttrSet:=GetProcAddress(hDll,'OCIAttrSet');
  207.   @OCISessionBegin:=GetProcAddress(hDll,'OCISessionBegin');
  208.   @OCISessionEnd:=GetProcAddress(hDll,'OCISessionEnd');
  209.   @OCIServerDetach:=GetProcAddress(hDll,'OCIServerDetach');
  210.   @OCIHandleFree:=GetProcAddress(hDll,'OCIHandleFree');
  211.   @OCIErrorGet:=GetProcAddress(hDll,'OCIErrorGet');
  212.   @OCIStmtPrepare:=GetProcAddress(hDll,'OCIStmtPrepare');
  213.   @OCIStmtExecute:=GetProcAddress(hDll,'OCIStmtExecute');
  214.   @OCIParamGet:=GetProcAddress(hDll,'OCIParamGet');
  215.   @OCIAttrGet:=GetProcAddress(hDll,'OCIAttrGet');
  216.   @OCIStmtFetch:=GetProcAddress(hDll,'OCIStmtFetch');
  217.   @OCIDefineByPos:=GetProcAddress(hDll,'OCIDefineByPos');
  218.   @OCIDefineArrayOfStruct:=GetProcAddress(hDll,'OCIDefineArrayOfStruct');
  219.   @OCIBindByPos:=GetProcAddress(hDll,'OCIBindByPos');
  220.   @OCIBindByName:=GetProcAddress(hDll,'OCIBindByName');
  221.   @OCITransStart:=GetProcAddress(hDll,'OCITransStart');
  222.   @OCITransCommit:=GetProcAddress(hDll,'OCITransCommit');
  223.   @OCITransRollback:=GetProcAddress(hDll,'OCITransRollback');
  224.   @OCIDescribeAny:=GetProcAddress(hDll,'OCIDescribeAny');
  225.   @OCIBreak:=GetProcAddress(hDll,'OCIBreak');
  226.   @OCIDescriptorAlloc:=GetProcAddress(hDll,'OCIDescriptorAlloc');
  227.   @OCIDescriptorFree:=GetProcAddress(hDll,'OCIDescriptorFree');
  228.   @OCILobRead:=GetProcAddress(hDll,'OCILobRead');
  229.   @OCILobWrite:=GetProcAddress(hDll,'OCILobWrite');
  230.   @OCIStmtGetPieceInfo:=GetProcAddress(hDll,'OCIStmtGetPieceInfo');
  231.   @OCIStmtSetPieceInfo:=GetProcAddress(hDll,'OCIStmtSetPieceInfo');
  232.   @OCILobGetLength:=GetProcAddress(hDll,'OCILobGetLength');
  233.   @OCILobErase:=GetProcAddress(hDll,'OCILobErase');
  234.   @OCILobTrim:=GetProcAddress(hDll,'OCILobTrim');
  235.   FStarted:=True;
  236.  end;
  237.  
  238.  if Assigned(FAfterInitOCI) then FAfterInitOCI(self);
  239. end;
  240.  
  241. procedure TOraDB.SetSessionIsolationLevel;
  242. var str:array[0..1023] of char;
  243.     mystmthp:pOCIStmt;
  244. begin
  245.  if not factive then exit;
  246.  
  247.  case FOraSessionIsolationLevel of
  248.   siReadCommited   : str:='ALTER SESSION SET ISOLATION_LEVEL=READ COMMITTED';
  249.   siRepeatableRead : str:='ALTER SESSION SET ISOLATION_LEVEL=SERIALIZABLE';
  250.   siDefault        : exit;
  251.  end;
  252.  
  253.  // setting Isolation Level for current session
  254.  TestError('OCIHandleAlloc - ',OCIHandleAlloc(myenvhp,mystmthp,OCI_HTYPE_STMT,0,nil));
  255.  
  256.  TestError('OCIStmtPrepare - ',OCIStmtPrepare(mystmthp,dberrhp,str,strlen(str),OCI_NTV_SYNTAX,OCI_DEFAULT));
  257.  
  258.  TestError('OCIStmtExecute ',OCIStmtExecute(mysvchp,mystmthp,dberrhp,1,0,nil,nil,OCI_DEFAULT));
  259.  
  260.  TestError('OCIHandleFree - ',OCIHandleFree(mystmthp,OCI_HTYPE_STMT));
  261. end;
  262.  
  263. procedure TOraDB.SetTransIsolationLevel;
  264. var str:array[0..1023] of char;
  265.     mystmthp:pOCIStmt;
  266. begin
  267.  if not factive then exit;
  268.  
  269.  case FOraTransIsolationLevel of
  270.   tiReadCommited   : str:='SET TRANSACTION ISOLATION LEVEL READ COMMITTED';
  271.   tiRepeatableRead : str:='SET TRANSACTION ISOLATION LEVEL SERIALIZABLE';
  272.   tiReadOnly       : str:='SET TRANSACTION READ ONLY';
  273.   tiDefault        : exit;
  274.  end;
  275.  
  276.  // setting Isolation Level for current beginning transaction
  277.  TestError('OCIHandleAlloc - ',OCIHandleAlloc(myenvhp,mystmthp,OCI_HTYPE_STMT,0,nil));
  278.  
  279.  TestError('OCIStmtPrepare - ',OCIStmtPrepare(mystmthp,dberrhp,str,strlen(str),OCI_NTV_SYNTAX,OCI_DEFAULT));
  280.  
  281.  TestError('OCIStmtExecute ',OCIStmtExecute(mysvchp,mystmthp,dberrhp,1,0,nil,nil,OCI_DEFAULT));
  282.  
  283.  TestError('OCIHandleFree - ',OCIHandleFree(mystmthp,OCI_HTYPE_STMT));
  284. end;
  285.  
  286. procedure TOraDB.Open;
  287. var str:array[0..1023] of char;
  288.     Accept:boolean;
  289. begin
  290.  InitOCI;
  291.  
  292.  Accept:=True;
  293.  if Assigned(FBeforeLoginEvent) then FBeforeLoginEvent(self,FServer,FName,FPassword,Accept);
  294.  if not Accept then exit;
  295.  
  296.  TestError('OCIInitialize ',OCIInitialize(OCI_DEFAULT {OCI_THREADED},nil,nil,nil,nil));
  297.  TestError('OCIEnvInit ',OCIEnvInit(myenvhp, OCI_DEFAULT, 0, nil));
  298.  TestError('OCIHandleAlloc ',OCIHandleAlloc(myenvhp,mysrvhp,OCI_HTYPE_SERVER,0,nil));
  299.  TestError('OCIHandleAlloc ',OCIHandleAlloc(myenvhp,dberrhp,OCI_HTYPE_ERROR,0,nil));
  300.  TestError('OCIHandleAlloc ',OCIHandleAlloc(myenvhp,mysvchp,OCI_HTYPE_SVCCTX,0,nil));
  301.  strpcopy(str,FServer);
  302.  
  303.  TestError('OCIServerAttach ',OCIServerAttach(mysrvhp,dberrhp,@str,strlen(str),OCI_DEFAULT));
  304.  
  305.  TestError('OCIAttrSet ',OCIAttrSet(mysvchp,OCI_HTYPE_SVCCTX,mysrvhp,0,OCI_ATTR_SERVER,dberrhp));
  306.  TestError('OCIHandleAlloc ',OCIHandleAlloc(myenvhp,myusrhp,OCI_HTYPE_SESSION,0,nil));
  307.  strpcopy(str,FName);
  308.  TestError('OCIAttrSet ',OCIAttrSet(myusrhp,OCI_HTYPE_SESSION,@str,strlen(str),OCI_ATTR_USERNAME,dberrhp));
  309.  strpcopy(str,FPassword);
  310.  TestError('OCIAttrSet ',OCIAttrSet(myusrhp,OCI_HTYPE_SESSION,@str,strlen(str),OCI_ATTR_PASSWORD,dberrhp));
  311.  TestError('OCISessionBegin ',OCISessionBegin(mysvchp,dberrhp,myusrhp,OCI_CRED_RDBMS,OCI_DEFAULT));
  312.  TestError('OCIAttrSet ',OCIAttrSet(mysvchp,OCI_HTYPE_SVCCTX,myusrhp,0,OCI_ATTR_SESSION,dberrhp));
  313.  FActive:=True;
  314.  
  315.  SetSessionIsolationLevel;
  316.  
  317.  if Assigned(FAfterLoginEvent) then FAfterLoginEvent(self);
  318.  
  319. end;
  320.  
  321. procedure TOraDB.Close;
  322. begin
  323.  if not FActive then exit;
  324.  CloseLinkedDataSets; // ταΩ≡√Γασ∞ Γ±σ DataSet√ Ω Ωε≥ε≡√∞ ∩≡Φ±εσΣΦφσφ ²≥ε≥ OraDB
  325.  
  326. // ∩ε ταΩ≡√≥ΦΦ ΩεφσΩ≥α Γ±σπΣα Σσδασ∞ RollBack (±≥≡α⌡εΓΩα ε≥ ≥επε ≈≥ε ■τσ≡ ταß√δ ±Σσδα≥ⁿ Commit)
  327.  TestError('OCITransRollback ',OCITransRollback(mysvchp,dberrhp,OCI_DEFAULT));
  328.  FTransaction:=False;
  329.  TestError('OCISessionEnd ',OCISessionEnd(mysvchp,dberrhp,myusrhp,OCI_DEFAULT));
  330.  TestError('OCIServerDetach ',OCIServerDetach(mysrvhp,dberrhp,OCI_DEFAULT));
  331.  TestError('OCIHandleFree ',OCIHandleFree(mysrvhp,OCI_HTYPE_SERVER));
  332.  TestError('OCIHandleFree ',OCIHandleFree(mysvchp,OCI_HTYPE_SVCCTX));
  333.  TestError('OCIHandleFree ',OCIHandleFree(myusrhp,OCI_HTYPE_SESSION));
  334.  TestError('OCIHandleFree ',OCIHandleFree(dberrhp,OCI_HTYPE_ERROR));
  335.  TestError('OCIHandleFree ',OCIHandleFree(myenvhp,OCI_HTYPE_ENV));
  336.  FActive:=False;
  337.  
  338.  FreeLibrary(hDll);
  339.  FStarted:=False;
  340. end;
  341.  
  342. procedure TOraDB.Break;
  343. begin
  344.  TestError('OCIBreak ',OCIBreak(mysvchp,dberrhp));
  345. end;
  346.  
  347. procedure TOraDB.DoActive(Value:boolean);
  348. begin
  349.   if (csReading in ComponentState) then  begin
  350.     if Value then FStreamedActive := True;
  351.     exit;
  352.   end;
  353.  if (csDestroying in ComponentState) then exit;
  354.  if Value and not Active then Open;
  355.  if not Value and Active then Close;
  356. end;
  357.  
  358. procedure TOraDB.StartTransaction;
  359. begin
  360.  if not Active then begin
  361.   raise Exception.Create('Database not active !');
  362.  end;
  363.  
  364.  SetTransIsolationLevel;
  365.  
  366. // TestError('OCIHandleFree ',OCITransStart(mysvchp,dberrhp,30,OCI_TRANS_NEW+OCI_TRANS_SERIALIZABLE));
  367.  FTransaction:=True;
  368.  
  369.  if Assigned(FOnStartTransaction) then FOnStartTransaction(self);
  370. end;
  371.  
  372. procedure TOraDB.CommitTransaction;
  373. begin
  374.  if not Active then begin
  375.   raise Exception.Create('Database not active !');
  376.  end;
  377.  
  378.  if Assigned(FBeforeCommit) then FBeforeCommit(self);
  379.  
  380.  TestError('OCITransCommit ',OCITransCommit(mysvchp,dberrhp,OCI_DEFAULT));
  381.  FTransaction:=False;
  382.  
  383.  if Assigned(FAfterCommit) then FAfterCommit(self);
  384. end;
  385.  
  386. procedure TOraDB.RollbackTransaction;
  387. begin
  388.  if not Active then begin
  389.   raise Exception.Create('Database not active');
  390.  end;
  391.  
  392.  if Assigned(FOnRollback) then FOnRollback(self);
  393.  
  394.  TestError('OCITransRollback ',OCITransRollback(mysvchp,dberrhp,OCI_DEFAULT));
  395.  FTransaction:=False;
  396. end;
  397.  
  398. destructor TOraDB.Destroy;
  399. begin
  400.  if Active then Close;
  401.  inherited Destroy;
  402. end;
  403.  
  404.  
  405. end.
  406.  
  407.