home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d45 / ARDOCI.ZIP / AOraSQL.pas < prev    next >
Pascal/Delphi Source File  |  2001-04-06  |  37KB  |  1,204 lines
  1. unit AOraSQL;
  2.  
  3. {
  4.  Descendant of TADataSet
  5.  TAOraSQL φα±δσΣ≤σ≥±  ε≥ TADataSet
  6.  
  7.  
  8.  Purpose : access to Oracle 8 if we don't want compability with TDataSet (more quicker)
  9.  ╤δ≤µΦ≥ Σδ  Σε±≥≤∩α Ω Oracle 8 σ±δΦ φσ φ≤µφα ±εΓ∞σ±≥Φ∞ε±≥ⁿ ± TDataSet
  10.  
  11.  procedure Open;
  12.     ╬pens the query. you must call this method only for queries not for parts of PL/SQL code.
  13.     Method Open not fetch any data.
  14.  
  15.  procedure OpenAll;
  16.     Opens the query and fetches all data to client
  17.  
  18.  procedure ExecSQL;
  19.     Executed the SQL statement (parts of PL/SQL code)
  20.  
  21.  function ReadRecord(RecordNum:integer):boolean; override;
  22.     Fetches rows of data while row with number RecordNum  will be reached.
  23.  
  24.  procedure ClearParams;override;
  25.     Forget definitions of all params.
  26.  
  27.  procedure SetQuery(Query:string);
  28.     Sets the query or part of PL/SQL code.
  29.  
  30.  procedure LoadFields;
  31.     Loads definitions of fields from Oracle database.
  32.     Useful for queries like "SELECT * FROM Table1" where you don't exactly know types of fields.
  33.  
  34.  
  35.  procedure Fetch;override;
  36.     Gets next portion (FetchCount rows) of data from server.
  37.     
  38.  function GetNextSequenceNumber(SequenceName: String): Integer;
  39.     Gets next number of sequence from server.
  40.     SequenceName - the name of sequence (for example "INDWORKER")
  41.  
  42. }
  43.  
  44. interface
  45.  
  46. uses ADataSet, OraDefines, DynamicArrays, Classes, OraDB;
  47.  
  48. type
  49.   TAOraSQL=class;
  50.  
  51.   TAOraParam = class (TAParam)
  52.   private
  53.    pData:pointer;
  54.    pDataNull:sb2;
  55.    LocalType:ub2;
  56.    LocalSize:integer;
  57.  
  58.   protected
  59.    function  GetIsNull:boolean;override;
  60.    procedure SetIsNull(Value:boolean);override;
  61.  
  62.    function  GetValue:variant;override;
  63.    procedure SetValue(Value:variant);override;
  64.    function  GetAsInteger:integer;override;
  65.    procedure SetAsInteger(Value:integer);override;
  66.    function  GetAsWord:Word;override;
  67.    procedure SetAsWord(Value:Word);override;
  68.    function  GetAsSmallInt:SmallInt;override;
  69.    procedure SetAsSmallInt(Value:SmallInt);override;
  70.    function  GetAsDate:integer;override;
  71.    procedure SetAsDate(Value:integer);override;
  72.    function  GetAsTime:integer;override;
  73.    procedure SetAsTime(Value:integer);override;
  74.    function  GetAsDateTime:int64;override;
  75.    procedure SetAsDateTime(Value:int64);override;
  76.    function  GetAsString:string;override;
  77.    procedure SetAsString(Value:string);override;
  78.    function  GetAsDouble:double;override;
  79.    procedure SetAsDouble(Value:double);override;
  80.    function  GetAsCurrency:currency;override;
  81.    procedure SetAsCurrency(Value:currency);override;
  82.    function  GetAsBoolean:Boolean;override;
  83.    procedure SetAsBoolean(Value:Boolean);override;
  84.   public
  85.    constructor Create(ParamName:string;ParamFieldType:TAFieldType;ParamParamType:TAParamType);override;
  86.    destructor Destroy; override;
  87.    procedure Clear;override;
  88.   end;
  89.  
  90.   TAOraField = class(TAField)
  91.   private
  92.   // Γ≡σ∞σφφ√σ ∞α±±ΦΓ√ Γ Ωε≥ε≡√σ Σε±≥α■≥±  Σαφφ√σ Φτ ε≡αΩδα (∩ε≥ε∞ εφΦ ∩σ≡σπεφ ■≥±  Γ ∩ε±≥ε φφ√σ ∞α±±ΦΓ√)
  93.    pData:THArray;
  94.    pDataNull:THArray;
  95.    pDataLen:THArraySmallInt;
  96.    FLocalType:ub2;
  97.    FLocalSize:integer;
  98.    FMapped:boolean; // σ±≥ⁿ δΦ ∩εδσ Γ Oracle
  99.    defhp:pOCIDefine;
  100.  
  101.    procedure ZeroBuffer;
  102.    procedure ClearTemp;
  103.    procedure Add(CountF:integer); // ∩σ≡σπεφ σ∞ Σαφφ√σ Φτ Γ≡σ∞σφφ√⌡ ∞α±±ΦΓεΓ Γ ε≡αΩδεΓ±Ωε∞ ⌠ε≡∞α≥σ (pData,....)Γ ∩ε±≥ε φφ√Θ ∞α±±ΦΓ√ Γ Σσδⁿ⌠εΓ√Θ ⌠ε≡∞α≥
  104.  
  105.   protected
  106.    procedure Clear; override;
  107.    procedure Allocate; override;
  108.    procedure DeleteRecord(RecordNum:integer);
  109.  
  110.   public
  111.    constructor Create(Parent:TADataSet;FieldName:string;RFieldType:TAFieldType;FieldSize:word;Required:boolean);override;
  112.  
  113.    function WriteBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):ub4;override;
  114.    function ReadBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):ub4; override;
  115.    function GetLobLength(RecordNum:integer):integer;override;
  116.    procedure ClearBlob(RecordNum:integer);override;
  117.  
  118.   end;
  119.  
  120.   TAOraSQL = class(TADataSet)
  121.   private
  122.    FDatabase:TOraDB;
  123.    FPrepared,FSelfPrepared:boolean;
  124.    FSQL:TStrings;
  125.    FFetchCount: integer;
  126.  
  127.    procedure SetSQL(Value:TStrings);
  128.  
  129.   protected
  130.    mystmthp:pOCIStmt;
  131.    myerrhp:pOCIError;
  132.    stmt_type:ub2;
  133.  
  134.    function TestError(where:string;ex:sword):sword;
  135.    procedure MapParam;
  136.    procedure MapFields;
  137.    procedure SetFetchCount(Value:integer);
  138.   public
  139.    constructor Create(AOwner:TComponent); override;
  140.    destructor Destroy; override;
  141.    procedure OpenDatabase;
  142.    procedure Open; override;
  143.    procedure OpenAll;
  144.    procedure Close; override;
  145.    procedure Prepare;override;
  146.    procedure UnPrepare;override;
  147.    procedure ExecSQL;
  148.    function ReadRecord(RecordNum:integer):boolean; override;
  149.  
  150.    procedure ClearParams;override;
  151.    procedure SetQuery(Query:string);
  152.    function CreateAField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean):TAField;override;
  153. //   procedure AddField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean); override;
  154.    procedure AddParam(ParamName:string;FieldType:TAFieldType;ParamType:TAParamType);override;
  155.    procedure LoadFields;
  156.  
  157.    procedure Fetch;override;
  158.    function GetNextSequenceNumber(SequenceName: String): Integer;
  159.  
  160.   published
  161.    property Database:TOraDB read FDatabase write FDatabase;
  162.    property FetchCount:integer read FFetchCount write SetFetchCount;
  163.    property SQL:TStrings read FSQL write SetSQL;
  164.   end;
  165.  
  166. procedure goodOra2Delphi(FT:TAFieldType;pin,pout:pointer);
  167. procedure goodDelphi2Ora(FT:TAFieldType;pin,pout:pointer);
  168.  
  169. procedure replaceDA(t:PChar);
  170.  
  171. procedure Register;
  172.  
  173. implementation
  174.  
  175. uses SysUtils, Windows, GoodDate, OraError, DBConsts;
  176.  
  177. procedure Register;
  178. begin
  179.   RegisterComponents('Data Access', [TAOraSQL]);
  180. end;
  181.  
  182. procedure OraNumToInt64(pin,pout:pointer;opor:byte); stdcall;
  183. label m1,m2,m3,m4,m5,m6,me;
  184.      asm
  185.       pushad
  186.       pushfd
  187. //               vCurrency:=0;
  188.       xor ESI,ESI // ∞δαΣ°σσ ±δεΓε
  189.       xor EDI,EDI // ±≥α≡°σσ ±δεΓε
  190. //               exponent:=pbyte(pin)^;
  191.       mov ebx,pin
  192.       mov ch,[ebx] // exponent
  193.       inc bx
  194.  
  195.       xor ah,ah
  196. //               por:=(exponent and $7F)-1;
  197.       mov cl,ch
  198.       and cl,$7f
  199.       dec cl
  200. //               if (exponent and $80)>0
  201.       sub cl,64
  202.       test ch,$80
  203.       jnz m1
  204. //                else por:=64-por;
  205.       neg cl
  206.       jmp m2
  207. //                then por:=por-64+3
  208. m1:   add cl,3
  209.       add cl,opor //±∞σ∙σφΦσ Σδ  currency Φ int64
  210. m2:
  211.       cmp cl,19
  212.       jo  me
  213.  
  214. //               for i:=0 to por do begin
  215. //                pc:=pbyte(cardinal(pin)+i+1);
  216. //                nb:=pc^-1;
  217. m5:   mov al,[ebx]
  218.       inc ebx
  219.       cmp al,0
  220.       jz m3
  221.  
  222.       dec al
  223. //                if (exponent and $80)>0
  224. //                 then nb:=nb
  225. //                 else nb:=100-nb;
  226.       test ch,$80
  227.       jnz m3
  228.       sub al,100
  229.       neg al
  230. //                if nb=255 then nb:=0 else if nb>99 then Exception.Create('Bad internal NUMBER !');
  231. m3:   cmp al,$FF
  232.       jne m4
  233.       not al
  234. //                vCurrency:=vCurrency*100+nb;
  235. m4:   push ax
  236.       mov eax,100
  237.       mul edi
  238.       mov edi,eax
  239.       mov eax,100
  240.       mul esi
  241.       mov esi,eax
  242.       add edi,edx
  243.       xor eax,eax
  244.       pop ax
  245.       add esi,eax
  246.       adc edi,0
  247.       dec cl
  248.       jnz m5
  249.  
  250.       test ch,$80
  251.       jnz m6
  252.       not edi
  253.       not esi
  254.       add esi,1
  255.       adc edi,0
  256. m6:
  257. me:
  258.       mov ebx,pout
  259.       mov [ebx],esi
  260.       add ebx,4
  261.       mov [ebx],edi
  262.  
  263.       popfd
  264.       popad
  265.      end;
  266.  
  267. procedure replaceDA(t:PChar);
  268. var i:integer;
  269. begin
  270.  i:=0;
  271.  while ord(t[i])<>0 do begin
  272.   if (t[i]=#13) then t[i]:=' ';
  273.   inc(i);
  274.  end;
  275. end;
  276.  
  277. procedure goodOra2Delphi(FT:TAFieldType;pin,pout:pointer);
  278. var od:^oradate;
  279. begin
  280.  case FT of
  281. //  ftLargeInt: OraNumToInt64(pin,pout,2);
  282.   ftoCurrency: pcurrency(pout)^:=pdouble(pin)^; //***
  283.   ftoDate:    begin
  284.                od:=pin;
  285.                if od.Century<>0 then
  286.                 pinteger(pout)^:=MakeGoodDate((od.Century-100)*100+(od.Year-100),od.Month,od.Day);
  287.              end;
  288.   ftoTime:    begin
  289.                od:=pin;
  290.                if od.Century<>0 then
  291.                 pinteger(pout)^:=MakeGoodTime(od.Hour-1,od.Minute-1,od.Second-1,0);
  292.              end;
  293.   ftoDateTime:begin
  294.                od:=pin;
  295.                if od.Century<>0 then begin
  296.                 pInt64(pout)^:=MakeGoodDateTime((od.Century-100)*100+(od.Year-100),od.Month,od.Day,od.Hour-1,od.Minute-1,od.Second-1,0);
  297.                end;
  298.              end;
  299.  end;
  300. end;
  301.  
  302. procedure goodDelphi2Ora(FT:TAFieldType;pin,pout:pointer);
  303. var od:^oradate;
  304.     dd,dm,dy:word;
  305.     th,tm,ts,tms:word;
  306. begin
  307.  case FT of
  308.   ftoCurrency:pdouble(pout)^:=pcurrency(pin)^; //***
  309.   ftoDate: begin
  310.            od:=pout;
  311.            UnMakeGoodDate(pinteger(pin)^,dy,dm,dd);
  312.            od.century:=100+dy div 100;
  313.            od.year:=dy mod 100 + 100;
  314.            od.month:=dm;
  315.            od.day:=dd;
  316.            od.hour:=1;
  317.            od.minute:=1;
  318.            od.second:=1;
  319.           end;
  320.   ftoTime: begin
  321.            od:=pout;
  322.            UnMakeGoodTime(pinteger(pin)^,th,tm,ts,tms);
  323.            od.century:=0;
  324.            od.year:=0;
  325.            od.month:=0;
  326.            od.day:=0;
  327.            od.hour:=th+1;
  328.            od.minute:=tm+1;
  329.            od.second:=ts+1;
  330.           end;
  331.   ftoDateTime: begin
  332.                od:=pout;
  333.                UnMakeGoodDateTime(pinteger(pin)^,dy,dm,dd,th,tm,ts,tms);
  334.                od.century:=100+dy div 100;
  335.                od.year:=dy mod 100 + 100;
  336.                od.month:=dm;
  337.                od.day:=dd;
  338.                od.hour:=th+1;
  339.                od.minute:=tm+1;
  340.                od.second:=ts+1;
  341.               end;
  342.  end;
  343. end;
  344.  
  345.  { AOraParam }
  346.  
  347. constructor TAOraParam.Create(ParamName:string;ParamFieldType:TAFieldType;ParamParamType:TAParamType);
  348. begin
  349.  inherited Create(ParamName,ParamFieldType,ParamParamType);
  350.  case FieldType of
  351.   ftoString:   LocalSize:=4001;
  352.   ftoBoolean:  LocalSize:=sizeof(boolean);
  353.   ftoDouble:   LocalSize:=sizeof(double);
  354.   ftoCurrency: LocalSize:=sizeof(double); //***21;
  355.   ftoDate:     LocalSize:=sizeof(oradate);
  356.   ftoTime:     LocalSize:=sizeof(oradate);
  357.   ftoDateTime: LocalSize:=sizeof(oradate);
  358.   ftoInteger:  LocalSize:=sizeof(integer);
  359.   ftoSmallInt: LocalSize:=sizeof(smallint);
  360.   ftoWord:     LocalSize:=sizeof(word);
  361.  else
  362.   raise Exception.Create('Unknown data type !');
  363.  end;
  364.  pData:=AllocMem(LocalSize);
  365.  case FieldType of
  366.   ftoString:  LocalType:=SQLT_STR;
  367.   ftoBoolean: LocalType:=SQLT_INT;
  368.   ftoDouble:  LocalType:=SQLT_FLT;
  369.   ftoCurrency:LocalType:=SQLT_FLT; //***SQLT_NUM;
  370.   ftoDate:    LocalType:=SQLT_DAT;
  371.   ftoTime:    LocalType:=SQLT_DAT;
  372.   ftoDateTime:LocalType:=SQLT_DAT;
  373.   ftoInteger: LocalType:=SQLT_INT;
  374.   ftoSmallInt:LocalType:=SQLT_INT;
  375.   ftoWord:    LocalType:=SQLT_INT;
  376.  else
  377.   LocalType:=65535;
  378.  end;
  379. end;
  380.  
  381. destructor TAOraParam.Destroy;
  382. begin
  383.  FreeMem(pData);
  384.  inherited Destroy;
  385. end;
  386.  
  387. function TAOraParam.GetIsNull:boolean;
  388. begin
  389.  Result:=pDataNull=-1;
  390. end;
  391.  
  392. procedure TAOraParam.SetIsNull(Value:boolean);
  393. begin
  394.  if Value then pDataNull:=-1 else pDataNull:=0;
  395. end;
  396.  
  397. function  TAOraParam.GetAsInteger:integer;
  398. begin
  399.  TestType(ftoInteger);
  400.  if IsNull then Result:=0 else Result:=pInteger(pData)^;
  401. end;
  402.  
  403. procedure TAOraParam.SetAsInteger(Value:integer);
  404. begin
  405.  TestType(ftoInteger);
  406.  SetIsNull(False);
  407.  pInteger(pData)^:=Value;
  408. end;
  409.  
  410. function  TAOraParam.GetAsDate:integer;
  411. begin
  412.  TestType(ftoDate);
  413.  if IsNull then Result:=0 else goodOra2Delphi(ftoDate,pData,@Result);
  414. end;
  415.  
  416. procedure TAOraParam.SetAsDate(Value:integer);
  417. begin
  418.  TestType(ftoDate);
  419.  SetIsNull(False);
  420.  goodDelphi2Ora(ftoDate,@Value,pData);
  421. end;
  422.  
  423. function  TAOraParam.GetAsString:string;
  424. begin
  425.  TestType(ftoString);
  426.  if IsNull then Result:='' else Result:=pchar(pData);
  427. end;
  428.  
  429. procedure TAOraParam.SetAsString(Value:string);
  430. begin
  431.  TestType(ftoString);
  432.  SetIsNull(False);
  433.  strpcopy(pData,Value);
  434. end;
  435.  
  436. function  TAOraParam.GetAsDouble:double;
  437. begin
  438.  TestType(ftoDouble);
  439.  if IsNull then Result:=0 else Result:=pdouble(pData)^;
  440. end;
  441.  
  442. procedure TAOraParam.SetAsDouble(Value:double);
  443. begin
  444.  TestType(ftoDouble);
  445.  SetIsNull(False);
  446.  pdouble(pData)^:=Value;
  447. end;
  448.  
  449. function  TAOraParam.GetAsCurrency:currency;
  450. begin
  451.  TestType(ftoCurrency);
  452.  if IsNull then Result:=0 else Result:=pdouble(pData)^;
  453. end;
  454.  
  455. procedure TAOraParam.SetAsCurrency(Value:currency);
  456. begin
  457.  TestType(ftoCurrency);
  458.  SetIsNull(False);
  459.  pdouble(pData)^:=Value;
  460. end;
  461.  
  462. function  TAOraParam.GetAsBoolean:Boolean;
  463. begin
  464.  TestType(ftoBoolean);
  465.  if IsNull then Result:=False else Result:=pbyte(pData)^<>0;
  466. end;
  467.  
  468. procedure TAOraParam.SetAsBoolean(Value:Boolean);
  469. begin
  470.  TestType(ftoBoolean);
  471.  SetIsNull(False);
  472.  if Value then pbyte(pData)^:=1 else pbyte(pData)^:=0;
  473. end;
  474.  
  475. function TAOraParam.GetAsDateTime: int64;
  476. begin
  477.  TestType(ftoDateTime);
  478.  if IsNull then Result:=0 else goodOra2Delphi(ftoDateTime,pData,@Result);
  479. end;
  480.  
  481. function TAOraParam.GetAsTime: integer;
  482. begin
  483.  TestType(ftoTime);
  484.  if IsNull then Result:=0 else goodOra2Delphi(ftoTime,pData,@Result);
  485. end;
  486.  
  487. procedure TAOraParam.SetAsDateTime(Value: int64);
  488. begin
  489.  TestType(ftoDateTime);
  490.  SetIsNull(False);
  491.  goodDelphi2Ora(ftoDateTime,@Value,pData);
  492. end;
  493.  
  494. procedure TAOraParam.SetAsTime(Value: integer);
  495. begin
  496.  TestType(ftoTime);
  497.  SetIsNull(False);
  498.  goodDelphi2Ora(ftoTime,@Value,pData);
  499. end;
  500.  
  501. function TAOraParam.GetAsSmallInt: SmallInt;
  502. begin
  503.  TestType(ftoSmallInt);
  504.  if IsNull then Result:=0 else Result:=psmallint(pData)^;
  505. end;
  506.  
  507. function TAOraParam.GetAsWord: Word;
  508. begin
  509.  TestType(ftoWord);
  510.  if IsNull then Result:=0 else Result:=pword(pData)^;
  511. end;
  512.  
  513. procedure TAOraParam.SetAsSmallInt(Value: SmallInt);
  514. begin
  515.  TestType(ftoSmallInt);
  516.  SetIsNull(False);
  517.  psmallint(pData)^:=Value;
  518. end;
  519.  
  520. procedure TAOraParam.SetAsWord(Value: Word);
  521. begin
  522.  TestType(ftoWord);
  523.  SetIsNull(False);
  524.  pword(pData)^:=Value;
  525. end;
  526.  
  527. procedure TAOraParam.Clear;
  528. begin
  529.  SetIsNull(True);
  530. end;
  531.  
  532. function TAOraParam.GetValue: variant;
  533. begin
  534.  if IsNull then begin
  535.   Result:=Null;
  536.   exit;
  537.  end;
  538.  case FieldType of
  539.   ftoString: Value:=AsString;
  540.   ftoSmallint: Value:=AsSmallInt;
  541.   ftoInteger: Value:=AsInteger;
  542.   ftoWord: Value:=AsWord;
  543.   ftoBoolean: Value:=AsBoolean;
  544.   ftoDouble: Value:=AsDouble;
  545.   ftoCurrency: Value:=AsCurrency;
  546.   ftoDate: Value:=AsDate;
  547.   ftoTime: Value:=AsTime;
  548. //  ftoDateTime: Value:=AsDateTime;
  549.  end;
  550. end;
  551.  
  552. procedure TAOraParam.SetValue(Value: variant);
  553. begin
  554.  if Value=Null then begin
  555.   Clear;
  556.   exit;
  557.  end;
  558.  case FieldType of
  559.   ftoString: AsString:=Value;
  560.   ftoSmallint: AsSmallInt:=Value;
  561.   ftoInteger: AsInteger:=Value;
  562.   ftoWord: AsWord:=Value;
  563.   ftoBoolean: AsBoolean:=Value;
  564.   ftoDouble: AsDouble:=Value;
  565.   ftoCurrency: AsCurrency:=Value;
  566.   ftoDate: AsDate:=Value;
  567.   ftoTime: AsTime:=Value;
  568. //  ftoDateTime: AsDateTime:=Value;
  569.  end;
  570. end;
  571.  
  572. { TAOraField }
  573.  
  574. constructor TAOraField.Create(Parent:TADataSet;FieldName:string;RFieldType:TAFieldType;FieldSize:word;Required:boolean);
  575. begin
  576.  inherited Create(Parent,FieldName,RFieldType,FieldSize,Required);
  577.  
  578.  pData:=nil;
  579.  pDataNull:=nil;
  580.  pDataLen:=nil;
  581. end;
  582.  
  583. procedure TAOraField.Add(CountF:integer);
  584. var  resi,redi:pointer;
  585.      i,j:integer;
  586.      vcurrency:currency;
  587.      vdate,vtime:integer;
  588.      vdatetime:int64;
  589. label next,nexti;
  590. begin
  591.  if Assigned(ValuesNull) then begin
  592.   ValuesNull.AddFillValues(CountF);
  593.   if FMapped then begin
  594.    resi:=pDataNull.Memory;
  595.    redi:=ValuesNull.GetAddr(ValuesNull.Count-CountF);
  596.    asm // ∩σ≡σφε±Φ∞ Null-∩≡ΦτφαΩΦ Φτ sb2(⌠ε≡∞α≥ Oracle) Γ Boolean
  597.     pushad
  598.     pushfd
  599.     mov   esi,resi
  600.     mov   edi,redi
  601.     mov   ecx,CountF
  602.   nexti:
  603.     xor   bl,bl
  604.     LODSW
  605.     test  ax,ax
  606.     jnz   next
  607.     mov   bl,1            // ²≥ε True
  608.   next:
  609.     mov   [edi],bl
  610.     inc   edi
  611.     dec   ecx
  612.     jnz   nexti
  613.     popfd
  614.     popad
  615.    end;
  616.   end;
  617.  end;
  618.  // ∩σ≡σφε±Φ∞ τφα≈σφΦ  ∩εδσΘ
  619.  if FMapped then begin
  620.   case FieldType of
  621.    ftoString:  Values.AddMany(pData.Memory,CountF);
  622.    ftoBoolean: Values.AddMany(pData.Memory,CountF);
  623.    ftoDouble:  Values.AddMany(pData.Memory,CountF);
  624.    ftoCurrency:for i:=0 to CountF-1 do begin
  625.                 goodOra2Delphi(ftoCurrency,THArrayDouble(pData).GetAddr(i),@vcurrency);
  626.                 THArrayCurrency(Values).AddValue(vcurrency);
  627.                end;
  628.    ftoDate:    for i:=0 to CountF-1 do begin
  629.                 goodOra2Delphi(ftoDate,pData.GetAddr(i),@vdate);
  630.                 THArrayInteger(Values).AddValue(vdate);
  631.                end;
  632.    ftoTime:    for i:=0 to CountF-1 do begin
  633.                 goodOra2Delphi(ftoTime,pData.GetAddr(i),@vtime);
  634.                 THArrayInteger(Values).AddValue(vdate);
  635.                end;
  636.    ftoDateTime:for i:=0 to CountF-1 do begin
  637.                 goodOra2Delphi(ftoDateTime,pData.GetAddr(i),@vdatetime);
  638.                 THArrayInt64(Values).AddValue(vdatetime);
  639.                end;
  640.    ftoInteger: Values.AddMany(pData.Memory,CountF);
  641.    ftoSmallInt:Values.AddMany(pData.Memory,CountF);
  642.    ftoWord:    Values.AddMany(pData.Memory,CountF);
  643.    ftoBlob,ftoClob:begin
  644.                 Values.AddMany(pData.Memory,CountF);// Ωε∩Φ≡≤σ∞ Σσ±Ω≡Φ∩≥ε≡√ φα ∩ε±≥ε φφεσ ∞σ±≥ε µΦ≥σδⁿ±≥Γα
  645.                 // ±Ωε∩Φ≡εΓαδΦ ±≥εδⁿΩε Σσ±Ω≡Φ∩≥ε≡εΓ ±ΩεδⁿΩε ±≥≡εΩ Σε±≥αδΦ
  646.                 // ε±≥αδⁿφ√σ Σσ±Ω≡Φ∩≥ε≡√ ε±ΓεßεµΣασ∞
  647.                 for j:=CountF to pData.Count-1 do
  648.                  TAOraSQL(FParent).TestError('Add - OCIDescriptorFree - ',TAOraSQL(FParent).Database.OCIDescriptorFree(ppointer(pData.GetAddr(j))^,OCI_DTYPE_LOB));
  649.  
  650. {                for j:=0 to CountF-1 do begin
  651.                  ppointer(pData.GetAddr(j))^:=nil;
  652.                  // αδδεΩαΘ≥Φ∞ φεΓ√σ Σσ±Ω≡Φ∩≥ε≡√ Σδ  ±ΣσΣ≤■°σπε Γ√τεΓα fetch
  653.                  TAOraSQL(FParent).TestError('Prepare - DescriptorAlloc - ',TAOraSQL(FParent).Database.OCIDescriptorAlloc(TAOraSQL(FParent).Database.myenvhp,pData.GetAddr(j),OCI_DTYPE_LOB,0,nil));
  654.                 end;}
  655.                end;
  656.   else
  657.    raise Exception.Create('Unknown data type !');
  658.   end;
  659.  end else begin
  660.   Values.AddFillValues(CountF);
  661.  end;
  662. end;
  663.  
  664. procedure TAOraField.ZeroBuffer;
  665. begin
  666.  if Assigned(pData) and not (FieldType in [ftoBlob,ftoClob]) then pData.Zero;
  667.  if Assigned(pDataNull) then pDataNull.Zero;
  668.  if Assigned(pDataLen) then pDataLen.Zero;
  669. end;
  670.  
  671. function TAOraField.GetLobLength(RecordNum: integer):integer;
  672. var len:ub4;
  673. begin
  674.  TestType(ftoBlob);
  675.  TAOraSQL(FParent).TestError('OCILobGetLength - ',TAOraSQL(FParent).Database.OCILobGetLength(TAOraSQL(FParent).Database.mysvchp,TAOraSQL(FParent).myerrhp,THArrayPointer(Values)[RecordToInternal(RecordNum)],len));
  676.  Result:=len;
  677. end;
  678.  
  679. procedure TAOraField.ClearBlob(RecordNum: integer);
  680. begin
  681.  TestType(ftoBlob);
  682.  TAOraSQL(FParent).TestError('OCILobTrim - ',TAOraSQL(FParent).Database.OCILobTrim(TAOraSQL(FParent).Database.mysvchp,TAOraSQL(FParent).myerrhp,THArrayPointer(Values)[RecordToInternal(RecordNum)],0));
  683. end;
  684.  
  685. function TAOraField.WriteBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):ub4;
  686. begin
  687.  TestType(ftoBlob);
  688.  Result:=Size;
  689.  TAOraSQL(FParent).TestError('OCILobWrite - ',TAOraSQL(FParent).Database.OCILobWrite(TAOraSQL(FParent).Database.mysvchp,TAOraSQL(FParent).myerrhp,THArrayPointer(Values)[RecordToInternal(RecordNum)],Result,Offset+1,Buffer,Result,OCI_ONE_PIECE,nil,nil,0,0));
  690. end;
  691.  
  692. function TAOraField.ReadBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):ub4;
  693. begin
  694.  TestType(ftoBlob);
  695.  Result:=Size;
  696.  TAOraSQL(FParent).TestError('OCILobRead - ',TAOraSQL(FParent).Database.OCILobRead(TAOraSQL(FParent).Database.mysvchp,TAOraSQL(FParent).myerrhp,THArrayPointer(Values)[RecordToInternal(RecordNum)],Result,Offset+1,Buffer,Result,nil,nil,0,0));
  697. end;
  698.  
  699. {function TAOraField.ReadBlobToStream(RecordNum:integer; Stream: TStream): ub4;
  700. var buf:array[0..16383] of byte;
  701.     sz:ub4;
  702.     Offset:integer;
  703. begin
  704.  Result:=0; Offset:=0;
  705.  repeat
  706.   sz:=ReadBlob(RecordNum,Offset,@buf,sizeof(buf));
  707.   Result:=Result+sz;
  708.   inc(Offset,sz);
  709.   Stream.Write(buf,sz);
  710.  until sz<>sizeof(buf);
  711. end;
  712.  
  713. function TAOraField.WriteBlobFromStream(RecordNum: integer; Stream: TStream):ub4;
  714. var buf:array[0..16383] of byte;
  715.     sz:integer;
  716.     Offset:integer;
  717. begin
  718.  ClearBlob(RecordNum);
  719.  Result:=0; Offset:=0;
  720.  Stream.Seek(0,soFromBeginning);
  721.  if Stream.Size>0 then begin
  722.   repeat
  723.    sz:=Stream.Read(buf,sizeof(buf));
  724.    buf[sz]:=0; buf[sz+1]:=0; buf[sz+2]:=0;
  725.    Result:=Result+WriteBlob(RecordNum,Offset,@buf,sz);
  726.    inc(Offset,sz);
  727.   until Offset=Stream.Size;
  728.  end;
  729. end;}
  730.  
  731. procedure TAOraField.DeleteRecord(RecordNum:integer);
  732. begin
  733.  if FieldType in [ftoBlob,ftoClob] then
  734.   if THArrayPointer(Values)[RecordNum]<>nil
  735.    then TAOraSQL(FParent).TestError('UnPrepare - OCIDescriptorFree - ',TAOraSQL(FParent).Database.OCIDescriptorFree(THArrayPointer(Values)[RecordNum],OCI_DTYPE_LOB));
  736.  inherited DeleteRecord(RecordNum);
  737. end;
  738.  
  739.  
  740. procedure TAOraField.Clear;
  741. var j:integer;
  742. begin
  743.  ClearTemp;
  744. // if(pData<>nil)or(pDataNull<>nil)or(pDataLen<>nil)then raise Exception.Create('TAOraField.Clear pData<>nil!!');
  745.  
  746.  if Assigned(Values) then
  747.   if FieldType in [ftoBlob,ftoClob] then
  748.    for j:=0 to Values.Count-1 do
  749.     if THArrayPointer(Values)[j]<>nil
  750.       then TAOraSQL(FParent).TestError('DescriptorFree - ',TAOraSQL(FParent).Database.OCIDescriptorFree(THArrayPointer(Values)[j],OCI_DTYPE_LOB));
  751.  
  752.  if Assigned(defhp) then begin
  753.   TAOraSQL(FParent).TestError('def handle free - ',TAOraSQL(FParent).Database.OCIHandleFree(defhp,OCI_HTYPE_DEFINE));
  754.   defhp:=nil;
  755.  end;
  756.  inherited Clear;
  757. end;
  758.  
  759. procedure TAOraField.ClearTemp;
  760. {var j:integer;
  761.     p:pointer;}
  762. begin
  763. { if FieldType in [ftoBlob,ftoClob] then
  764.   if pData<>nil then
  765.    for j:=0 to pData.Count-1 do begin
  766.     p:=ppointer(pData.GetAddr(j))^;
  767.     if p<>nil then begin
  768.      TAOraSQL(FParent).TestError('DescriptorFree - ',TAOraSQL(FParent).Database.OCIDescriptorFree(p,OCI_DTYPE_LOB));
  769.      ppointer(pData.GetAddr(j))^:=nil;
  770.     end;
  771.    end;
  772.  }
  773.   if pData<>nil then begin pData.Free; pData:=nil; end;
  774.   if pDataNull<>nil then begin pDataNull.Free; pDataNull:=nil; end;
  775.   if pDataLen<>nil then begin pDataLen.Free; pDataLen:=nil; end;
  776.   if Values<>nil then Values.Hold;
  777.   if ValuesNull<>nil then ValuesNull.Hold;
  778. end;
  779.  
  780. procedure TAOraField.Allocate;
  781. begin
  782.  inherited Allocate;
  783.  
  784.  pData:=THArray.Create;
  785.  case FieldType of
  786.   ftoString:   pData.ItemSize:=FieldSize;
  787.   ftoBoolean:  pData.ItemSize:=sizeof(boolean);
  788.   ftoDouble:   pData.ItemSize:=sizeof(double);
  789.   ftoCurrency: pData.ItemSize:=sizeof(double); //***21;
  790.   ftoDate:     pData.ItemSize:=sizeof(oradate);
  791.   ftoTime:     pData.ItemSize:=sizeof(oradate);
  792.   ftoDateTime: pData.ItemSize:=sizeof(oradate);
  793.   ftoInteger:  pData.ItemSize:=sizeof(integer);
  794.   ftoSmallInt: pData.ItemSize:=sizeof(smallint);
  795.   ftoWord:     pData.ItemSize:=sizeof(word);
  796.   ftoBlob,ftoClob:pData.ItemSize:=sizeof(pointer);
  797.  else
  798.   raise Exception.Create('Unknown data type !');
  799.  end;
  800.  
  801.  pDataNull:=THArray.Create;
  802.  pDataNull.ItemSize:=sizeof(sb2);
  803.  pDataLen:=THArraySmallInt.Create;
  804.  
  805.  pData.SetCapacity(TAOraSQL(FParent).FetchCount);
  806.  pData.AddFillValues(TAOraSQL(FParent).FetchCount);
  807.  pDataNull.SetCapacity(TAOraSQL(FParent).FetchCount);
  808.  pDataNull.AddFillValues(TAOraSQL(FParent).FetchCount);
  809.  pDataLen.SetCapacity(TAOraSQL(FParent).FetchCount);
  810.  pDataLen.AddFillValues(TAOraSQL(FParent).FetchCount);
  811.  
  812.  case FieldType of
  813.   ftoString:   FLocalType:=SQLT_CHR;
  814.   ftoBoolean:  FLocalType:=SQLT_CHR;
  815.   ftoDouble:   FLocalType:=SQLT_FLT;
  816.   ftoCurrency: FLocalType:=SQLT_FLT;
  817.   ftoDate:     FLocalType:=SQLT_DAT;
  818.   ftoTime:     FLocalType:=SQLT_DAT;
  819.   ftoDateTime: FLocalType:=SQLT_DAT;
  820.   ftoInteger:  FLocalType:=SQLT_INT;
  821.   ftoSmallInt: FLocalType:=SQLT_INT;
  822.   ftoWord:     FLocalType:=SQLT_INT;
  823.   ftoBlob:     FLocalType:=SQLT_BLOB;
  824.   ftoClob:     FLocalType:=SQLT_CLOB;
  825.  else
  826.   raise Exception.Create('Unknown data type !');
  827.  end;
  828.  
  829.  case FieldType of
  830.   ftoString:   FLocalSize:=FieldSize;
  831.   ftoBoolean:  FLocalSize:=sizeof(boolean);
  832.   ftoDouble:   FLocalSize:=sizeof(double);
  833.   ftoCurrency: FLocalSize:=sizeof(double);
  834.   ftoDate:     FLocalSize:=sizeof(oradate);
  835.   ftoTime:     FLocalSize:=sizeof(oradate);
  836.   ftoDateTime: FLocalSize:=sizeof(oradate);
  837.   ftoInteger:  FLocalSize:=sizeof(integer);
  838.   ftoSmallInt: FLocalSize:=sizeof(smallint);
  839.   ftoWord:     FLocalSize:=sizeof(word);
  840.   ftoBlob:     FLocalSize:=sizeof(pointer);
  841.   ftoClob:     FLocalSize:=sizeof(pointer);
  842.  else
  843.   raise Exception.Create('Unknown data type !');
  844.  end;
  845.  
  846.  FMapped:=False;
  847.  defhp:=nil;
  848. end;
  849.  
  850.  { TAOraSQL }
  851.  
  852. constructor TAOraSQL.Create(AOwner:TComponent);
  853. begin
  854.  inherited Create(AOwner);
  855.  
  856.  FFetchCount:=100;
  857.  FSQL:=TStringList.Create;
  858.  myerrhp:=nil;
  859. end;
  860.  
  861. destructor TAOraSQL.Destroy;
  862. begin
  863.  Close;
  864. // ClearParams;
  865. // FParams.Free;
  866.  FSQL.Free;
  867.  inherited Destroy;
  868. end;
  869.  
  870. procedure TAOraSQL.Open;
  871. var e:sword;
  872. begin
  873.  if Active then exit;
  874.  FSelfPrepared:=not FPrepared;
  875.  if FSelfPrepared then Prepare;
  876.  
  877.  FFetched:=False;
  878.  if stmt_type<>OCI_STMT_SELECT then
  879.   raise Exception.Create('▌≥ε φσ SELECT-Γ√≡αµσφΦσ !');
  880.  
  881.  MapParam;
  882.  
  883.  e:=Database.OCIStmtExecute(Database.mysvchp,mystmthp,myerrhp,0,0,nil,nil,OCI_DEFAULT);
  884.  if e<>OCI_NO_DATA
  885.   then TestError('Open - OCIStmtExecute - ',e)
  886.   else FFetched:=True;
  887.  
  888.  inherited Open;
  889.  if e<>OCI_NO_DATA then MapFields;
  890. end;
  891.  
  892. procedure TAOraSQL.Close;
  893. begin
  894.  if not Active then exit;
  895.  inherited Close;
  896.  if FSelfPrepared then UnPrepare;
  897. end;
  898.  
  899. procedure TAOraSQL.OpenDatabase;
  900. begin
  901.  if not Assigned(FDatabase) then begin
  902.   raise Exception.Create('Database not assigned.');
  903.  end;
  904.  
  905.  if not Database.Active then begin
  906.   Database.Open;
  907.   if not Database.Active then raise Exception.Create('Database not active.');
  908.  end;
  909. end;
  910.  
  911. procedure TAOraSQL.Prepare;
  912. var texta:pchar;
  913.     stmt_type_len:ub4;
  914. begin
  915.  if FPrepared then exit;
  916.  
  917.  if Trim(FSQL.Text)='' then raise Exception.Create('Error: SQL statement is empty.');
  918.  
  919.  OpenDatabase;
  920.  
  921.  TestError('Prepare - OCIHandleAlloc - ',Database.OCIHandleAlloc(Database.myenvhp,myerrhp,OCI_HTYPE_ERROR,0,nil));
  922.  TestError('Prepare - OCIHandleAlloc - ',Database.OCIHandleAlloc(Database.myenvhp,mystmthp,OCI_HTYPE_STMT,0,nil));
  923.  
  924.  texta:=AllocMem(Length(FSQL.Text)+1);
  925.  strpcopy(texta,FSQL.Text);
  926.  replaceDA(texta);
  927.  TestError('Prepare - OCIStmtPrepare - ',Database.OCIStmtPrepare(mystmthp,myerrhp,texta,strlen(texta),OCI_NTV_SYNTAX,OCI_DEFAULT));
  928.  stmt_type_len:=sizeof(stmt_type);
  929.  TestError('Prepare - OCIAttrGet(STMT_TYPE) - ',Database.OCIAttrGet(mystmthp,OCI_HTYPE_STMT,@stmt_type,@stmt_type_len,OCI_ATTR_STMT_TYPE,myerrhp));
  930.  
  931.  FreeMem(texta);
  932.  
  933.  FPrepared:=True;
  934. end;
  935.  
  936. procedure TAOraSQL.UnPrepare;
  937. begin
  938.  if not FPrepared then exit;
  939.  if Active then Close;
  940.  
  941.  if Assigned(mystmthp) then TestError('UnPrepare - OCIHandleFree - ',Database.OCIHandleFree(mystmthp,OCI_HTYPE_STMT));
  942.  mystmthp:=nil;
  943.  
  944.  if Assigned(myerrhp) then TestError('UnPrepare - OCIHandleFree - ',Database.OCIHandleFree(myerrhp,OCI_HTYPE_ERROR));
  945.  myerrhp:=nil;
  946.  
  947.  FPrepared:=False;
  948. end;
  949.  
  950. procedure TAOraSQL.ExecSQL;
  951. begin
  952.  if Active then exit;
  953.  FSelfPrepared:=not FPrepared;
  954.  if FSelfPrepared then Prepare;
  955.  
  956.  MapParam;
  957.  TestError('ExecSQL - OCIStmtExecute ',Database.OCIStmtExecute(Database.mysvchp,mystmthp,myerrhp,1,0,nil,nil,OCI_DEFAULT));
  958.  
  959.  if FSelfPrepared then UnPrepare;
  960. end;
  961.  
  962. procedure TAOraSQL.MapParam;
  963. var Param:TAOraParam;
  964.     texta:array[0..4000] of char;
  965.     mybindhp:pOCIBind;
  966.     i:integer;
  967. begin
  968.  mybindhp:=nil;
  969.  for i:=0 to ParamCount-1 do begin
  970.   Param:=TAOraParam(ParamByIndex[i]);
  971.   strpcopy(texta,':'+Param.Name);
  972.   TestError('Prepare - OCIBindByName - ',Database.OCIBindByName(mystmthp,mybindhp,myerrhp,texta,strlen(texta),
  973.             Param.pData,Param.LocalSize,Param.LocalType,@(Param.pDataNull),nil,nil,0,nil,OCI_DEFAULT));
  974. //  if mybindhp<>nil then raise Exception.Create('MapParam : mybindhp<>nil!!!');
  975.  end;
  976. end;
  977.  
  978. procedure TAOraSQL.MapFields;
  979. var i:integer;
  980.     paramcnt:ub4;
  981.     mypard:pOCIParam;
  982.     colname:pchar;
  983.     colnamelen:ub4;
  984.     Name:string;
  985. //    ID:integer;
  986.     CF:TAOraField;
  987. begin
  988.  TestError('Open - OCIAttrGet(Param Count) - ',Database.OCIAttrGet(mystmthp,OCI_HTYPE_STMT,@paramcnt,nil,OCI_ATTR_PARAM_COUNT,myerrhp));
  989.  for i:=0 to paramcnt-1 do begin
  990.   mypard:=nil;
  991.   TestError('Open - OCIParamGet',Database.OCIParamGet(mystmthp,OCI_HTYPE_STMT,myerrhp,mypard,i+1));
  992.   TestError('Open - OCIAttrGet(Column Name) - ',Database.OCIAttrGet(mypard,OCI_DTYPE_PARAM,@colname,@colnamelen,OCI_ATTR_NAME,myerrhp));
  993.   Name:=strpas(colname);
  994.   SetLength(Name,colnamelen);
  995. //  ID:=FieldID[Name];
  996. //  if ID=-1 then raise Exception.Create('MapFields: Field "'+Name+'" not found!!');
  997. //   if ID<>-1 then begin
  998.     CF:=TAOraField(FieldByName[Name]);
  999.     CF.FMapped:=True;
  1000. {    CF.pData.Zero;
  1001.     CF.pDataNull.Zero;
  1002.     CF.pDataLen.Zero;
  1003.     if CF.FieldType in [ftoBlob,ftoClob] then
  1004.       for j:=0 to FFetchCount-1 do
  1005.        TestError('Prepare - DescriptorAlloc - ',Database.OCIDescriptorAlloc(Database.myenvhp,CF.pData.GetAddr(j),OCI_DTYPE_LOB,0,nil));
  1006.                      }
  1007.     TestError('Open - OCIDefineByPos - ',Database.OCIDefineByPos(mystmthp,CF.defhp,myerrhp,i+1,CF.pData.Memory,CF.FLocalSize,CF.FLocalType,CF.pDataNull.Memory,CF.pDataLen.Memory,nil,OCI_DEFAULT));
  1008.     TestError('Open - OCIDefineArrayOfStruct - ',Database.OCIDefineArrayOfStruct(CF.defhp,myerrhp,CF.FLocalSize,sizeof(sb2),sizeof(smallint),0));
  1009. //   end;
  1010.  end;
  1011. end;
  1012.  
  1013. procedure TAOraSQL.SetSQL(Value:TStrings);
  1014. begin
  1015.  FSQL.Assign(Value);
  1016. end;
  1017.  
  1018. function TAOraSQL.TestError(where:string;ex:sword):sword;
  1019. var errcode:sb4;
  1020.     errbuf:array[0..511] of char;
  1021. begin
  1022.  Result:=ex;
  1023.  case ex of
  1024.   OCI_SUCCESS: exit;
  1025.   OCI_SUCCESS_WITH_INFO: raise EOraError.Create(ex,0,'Oracle Error: OCI success with info');
  1026.   OCI_NEED_DATA: raise EOraError.Create(ex,0,'Oracle Error: OCI need data');
  1027.   OCI_NO_DATA: raise EOraError.Create(ex,0,'Oracle Error: OCI no data');
  1028.   OCI_ERROR: begin
  1029.               Database.OCIErrorGet(myerrhp,1,nil,errcode,errbuf,sizeof(errbuf),OCI_HTYPE_ERROR);
  1030.               raise EOraError.Create(ex,errcode,'Oracle Error '{#'+inttostr(errcode)+': '}+strpas(errbuf));
  1031.              end;
  1032.   OCI_INVALID_HANDLE: raise EOraError.Create(ex,0,'Oracle Error: OCI invalid handle');
  1033.   OCI_STILL_EXECUTING: raise EOraError.Create(ex,0,'Oracle Error: OCI still execute');
  1034.   else raise EOraError.Create(-20001,-20001,'UNKNOWN ORACLE ERROR!');
  1035.  end;
  1036. end;
  1037.  
  1038. {procedure TAOraSQL.AddField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean);
  1039. var F:TAOraField;
  1040. var i:integer;
  1041. begin
  1042.  if FieldName = '' then ADatabaseError(SFieldNameMissing, self);
  1043.  for i:=0 to FieldCount-1 do
  1044.   if AnsiCompareText(FieldByIndex[i].Name,FieldName)=0 then ADatabaseError(Format(SDuplicateFieldName,[FieldName,self.name]));
  1045.  
  1046.  F:=TAOraField.Create(TADataSet(self),FieldName,FieldType,FieldSize,Required);
  1047.  FFields.AddValue(F);
  1048. end;}
  1049.  
  1050. function TAOraSQL.CreateAField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean): TAField;
  1051. begin
  1052.  Result:=TAOraField.Create(self,FieldName,FieldType,FieldSize,Required);
  1053. end;
  1054.  
  1055. procedure TAOraSQL.SetFetchCount(Value:integer);
  1056. begin
  1057.  if (Value<1) or (Value>32767) then raise Exception.Create('The FetchCount value ('+IntToStr(Value)+') too large!');
  1058.  if FPrepared then raise Exception.Create('Cannot set the FetchCount property because the TAOraSQL is prepared!');
  1059.  FFetchCount:=Value;
  1060. end;
  1061.  
  1062. function TAOraSQL.ReadRecord(RecordNum:integer):boolean;
  1063. begin
  1064.  while (not FFetched) and (RecordNum>=RecordCount) do Fetch;
  1065.  Result:=inherited ReadRecord(RecordNum);
  1066. end;
  1067.  
  1068. procedure TAOraSQL.Fetch;
  1069. var i,j:integer;
  1070.     numrow,oldnumrow:integer;
  1071.     Res:sword;
  1072.     CF:TAOraField;
  1073. begin
  1074.  if UniDirectional then begin ForgetValues; FBeginRecord:=RecordCount; end;
  1075.  
  1076.  oldnumrow:=RecordCount;
  1077.  
  1078.  for i:=0 to FieldCount-1 do begin
  1079.   CF:=TAOraField(FieldByIndex[i]);
  1080.   CF.ZeroBuffer;
  1081.   if CF.FieldType in [ftoBlob,ftoClob] then
  1082.     for j:=0 to FFetchCount-1 do
  1083.        TestError('Prepare - DescriptorAlloc - ',Database.OCIDescriptorAlloc(Database.myenvhp,CF.pData.GetAddr(j),OCI_DTYPE_LOB,0,nil));
  1084.  end;
  1085.  
  1086.  Res:=Database.OCIStmtFetch(mystmthp,myerrhp,FFetchCount,OCI_FETCH_NEXT,OCI_DEFAULT);
  1087.  if (Res=OCI_SUCCESS) or (Res=OCI_NO_DATA) or (Res=OCI_NEED_DATA) then begin
  1088.   TestError('Fetch - OCIAttrGet (fetched numrows)- ',Database.OCIAttrGet(mystmthp,OCI_HTYPE_STMT,@numrow,nil,OCI_ATTR_ROW_COUNT,myerrhp));
  1089.   FCount:=numrow;
  1090.  
  1091.   if numrow<>oldnumrow then
  1092.    for i:=0 to FieldCount-1 do
  1093.     TAOraField(FieldByIndex[i]).Add(numrow-oldnumrow); // ∩σ≡πεφ σ∞ Φτ Γ≡σ∞σφφ√⌡ ∞α±±ΦΓεΓ Γ ∩ε±≥ε φφ√σ
  1094.  
  1095.   if (Res=OCI_NO_DATA) then begin // ταΩεφ≈ΦδΦ Γ√≥ πΦΓα≥ⁿ
  1096.    FFetched:=True;
  1097.    for i:=0 to FieldCount-1 do begin
  1098.     CF:=TAOraField(FieldByIndex[i]);
  1099.     CF.ClearTemp;
  1100.    end;
  1101.   end;
  1102.  end else begin
  1103.   FFetched:=True;
  1104.   TestError('Fetch - OCIStmtFetch - ',Res);
  1105.  end;
  1106. end;
  1107.  
  1108. function TAOraSQL.GetNextSequenceNumber(SequenceName: String): Integer;
  1109. begin
  1110.   SetQuery('BEGIN SELECT ' + SequenceName + '.NEXTVAL INTO :Value FROM DUAL; END;');
  1111.   AddParam('Value', ftoInteger, ptoOutput);
  1112.   ExecSQL;
  1113.   Result := ParamByName['Value'].AsInteger;
  1114. end;
  1115.  
  1116. procedure TAOraSQL.LoadFields;
  1117. var i:integer;
  1118.     mypard:pOCIParam;
  1119.     colname:pchar;
  1120.     colnamelen:ub4;
  1121.     Name:string;
  1122.     isnull:ub1;
  1123.     OraType:ub2;
  1124.     OraSize:ub2;
  1125.     OraPrec:ub2;
  1126.     OraScale:sb1;
  1127.     parSize:ub4;
  1128.     data:ub4;
  1129.     DType:TAFieldType;
  1130.     DSize:integer;
  1131.     selfprepared:boolean;
  1132. begin
  1133.  if Active then exit;
  1134.  selfprepared:=not FPrepared;
  1135.  if selfprepared then Prepare;
  1136.  ClearFields;
  1137. try
  1138.  MapParam;
  1139.  // πεΓε≡Φ∞ ≈≥ε τα∩≡ε± φσ φαΣε Γ√∩εδφ ≥ⁿ α ≥εδⁿΩε Γ√≥ φ≤≥ⁿ ∩εδφεσ ε∩Φ±αφΦσ ∩εδσΘ (²≥ε ∩α≡α∞σ≥≡√) Γ τα∩≡ε±σ
  1140.  TestError('OCIStmtExecute describe - ',Database.OCIStmtExecute(Database.mysvchp,mystmthp,myerrhp,0,0,nil,nil,OCI_DESCRIBE_ONLY));
  1141.  mypard:=nil;
  1142.  i:=0;
  1143.  while True do begin
  1144.   // Σε±≥ασ∞ handle i-≥επε ∩α≡α∞σ≥≡α (∩εδ ) τα∩≡ε±α - mypard. ∩ε ²≥ε∞≤ ⌡σφΣδ≤ ∞√ ∩ε≥ε∞ Γ√≥α∙Φ∞ Γ±σ α≥≡Φß≤≥√ ∩εδ  ≥αΩΦσ ΩαΩ ≥Φ∩,≡ατ∞σ≡,≥ε≈φε±≥ⁿ,isnull Φ Σ≡.
  1145.   if Database.OCIParamGet(mystmthp,OCI_HTYPE_STMT,myerrhp,mypard,i+1)<>OCI_SUCCESS then break;
  1146.   TestError('OCIAttrGet(Column Name) - ',Database.OCIAttrGet(mypard,OCI_DTYPE_PARAM,@colname,@colnamelen,OCI_ATTR_NAME,myerrhp));
  1147.   Name:=strpas(colname);
  1148.   SetLength(Name,colnamelen);
  1149.   // φσ∩ε±≡σΣ±≥Γσφφε Γ√≥ πΦΓασ∞ α≥≡Φß≤≥√ ≥σΩ≤∙σπε ∩εδ  (∩α≡α∞σ≥≡α)
  1150.   parSize:=sizeof(OraType);  TestError('OCIAttrGet(Column Type) - ',Database.OCIAttrGet(mypard,OCI_DTYPE_PARAM,@data,@parSize,OCI_ATTR_DATA_TYPE,myerrhp)); OraType:=ub2(data);
  1151.   parSize:=sizeof(OraSize);  TestError('OCIAttrGet(Column Size) - ',Database.OCIAttrGet(mypard,OCI_DTYPE_PARAM,@data,@parSize,OCI_ATTR_DATA_SIZE,myerrhp)); OraSize:=ub2(data);
  1152.   parSize:=sizeof(OraPrec);  TestError('OCIAttrGet(Column Prec) - ',Database.OCIAttrGet(mypard,OCI_DTYPE_PARAM,@data,@parSize,OCI_ATTR_PRECISION,myerrhp)); OraPrec:=ub1(data);
  1153.   parSize:=sizeof(OraScale); TestError('OCIAttrGet(Column Scale) - ',Database.OCIAttrGet(mypard,OCI_DTYPE_PARAM,@data,@parSize,OCI_ATTR_SCALE,myerrhp));    OraScale:=sb1(data);
  1154.   parSize:=sizeof(isnull);   TestError('OCIAttrGet(Column IsNull) - ',Database.OCIAttrGet(mypard,OCI_DTYPE_PARAM,@data,@parSize,OCI_ATTR_IS_NULL,myerrhp));  isnull:=ub1(data);
  1155.   case OraType of
  1156.    1,96:  begin DType:=ftoString; DSize:=OraSize; end;
  1157.    2:     begin if (OraScale=0) and (OraPrec<11) and (OraPrec>0) then DType:=ftoInteger else DType:=ftoDouble; DSize:=0; end;
  1158.    12:    begin DType:=ftoDate; DSize:=0; end;
  1159.    113:   begin DType:=ftoBlob; DSize:=0; end;
  1160.   else    begin DType:=ftoUnknown; DSize:=-1; end;
  1161.   end;
  1162.   AddField(Name,DType,DSize,isnull=0);
  1163.   i:=i+1;
  1164.  end;
  1165. finally
  1166.  if selfprepared then UnPrepare;
  1167. end;
  1168. end;
  1169.  
  1170. procedure TAOraSQL.OpenAll;
  1171. begin
  1172.  Open;
  1173.  ReadAll;
  1174. end;
  1175.  
  1176. procedure TAOraSQL.AddParam(ParamName:string;FieldType:TAFieldType;ParamType:TAParamType);
  1177. var i:integer;
  1178. begin
  1179.  if ParamName = '' then ADatabaseError('Paramter name missing!', self);
  1180.  for i:=0 to ParamCount-1 do
  1181.   if AnsiCompareText(TAParam(ParamByIndex[i]).Name,ParamName)=0 then ADatabaseError(Format(SDuplicateName,[ParamName,self.name]));
  1182.  
  1183.  FParams.AddValue(TAOraParam.Create(ParamName,FieldType,ParamType));
  1184. end;
  1185.  
  1186. procedure TAOraSQL.SetQuery(Query:string);
  1187. begin
  1188.  if FPrepared then UnPrepare;
  1189.  Close;
  1190.  ClearFields;
  1191.  ClearParams;
  1192.  SQL.Text:=Query;
  1193. end;
  1194.  
  1195. procedure TAOraSQL.ClearParams;
  1196. var i:integer;
  1197. begin
  1198.  for i:=0 to FParams.Count-1 do TAOraParam(FParams[i]).Free;
  1199.  FParams.Clear;
  1200. end;
  1201.  
  1202.  
  1203. end.
  1204.