aorasql.pas

delphi通过OCI访问ORACLE

procedure TAOraParam.SetAsDate(Value:integer);
begin
  TestType(ftoDate);
  SetIsNull(False);
  goodDelphi2Ora(ftoDate, @Value, pData);
end;

function  TAOraParam.GetAsString:string;
begin
  TestType(ftoString);
  if IsNull
    then Result := ''
    else Result := pchar(pData);
end;

procedure TAOraParam.SetAsString(Value:string);
begin
  TestType(ftoString);
  SetIsNull(False);
  strpcopy(pData, Value);
end;

function TAOraParam.GetAsDouble:double;
begin
  TestType(ftoDouble);
  if IsNull
    then Result := 0
    else Result := pdouble(pData)^;
end;

procedure TAOraParam.SetAsDouble(Value:double);
begin
  TestType(ftoDouble);
  SetIsNull(False);
  pdouble(pData)^ := Value;
end;

function TAOraParam.GetAsCurrency:currency;
begin
 TestType(ftoCurrency);
 if IsNull then Result:=0 else Result:=pdouble(pData)^;
end;

procedure TAOraParam.SetAsCurrency(Value:currency);
begin
 TestType(ftoCurrency);
 SetIsNull(False);
 pdouble(pData)^:=Value;
end;

function TAOraParam.GetAsBoolean:Boolean;
begin
 TestType(ftoBoolean);
 if IsNull
   then Result := False
   else Result := pbyte(pData)^ <> 0;
end;

procedure TAOraParam.SetAsBoolean(Value:Boolean);
begin
 TestType(ftoBoolean);
 SetIsNull(False);
 if Value
   then pbyte(pData)^ := 1
   else pbyte(pData)^ := 0;
end;

function TAOraParam.GetAsDateTime: int64;
begin
 TestType(ftoDateTime);
 if IsNull
   then Result := 0
   else goodOra2Delphi(ftoDateTime, pData, @Result);
end;

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

procedure TAOraParam.SetAsDateTime(Value: int64);
begin
 TestType(ftoDateTime);
 SetIsNull(False);
 goodDelphi2Ora(ftoDateTime, @Value, pData);
end;

procedure TAOraParam.SetAsTime(Value: integer);
begin
 TestType(ftoTime);
 SetIsNull(False);
 goodDelphi2Ora(ftoTime, @Value, pData);
end;

function TAOraParam.GetAsSmallInt: SmallInt;
begin
 TestType(ftoSmallInt);
 if IsNull
   then Result := 0
   else Result := psmallint(pData)^;
end;

function TAOraParam.GetAsWord: Word;
begin
 TestType(ftoWord);
 if IsNull
   then Result := 0
   else Result := pword(pData)^;
end;

procedure TAOraParam.SetAsSmallInt(Value: SmallInt);
begin
 TestType(ftoSmallInt);
 SetIsNull(False);
 psmallint(pData)^ := Value;
end;

procedure TAOraParam.SetAsWord(Value: Word);
begin
 TestType(ftoWord);
 SetIsNull(False);
 pword(pData)^ := Value;
end;

function TAOraParam.GetAsInt64: int64;
begin
 TestType(ftoInt64);
 if IsNull
   then Result := 0
   else Result := pInt64(pData)^;
end;

procedure TAOraParam.SetAsInt64(Value: int64);
begin
 TestType(ftoInt64);
 SetIsNull(False);
 pInt64(pData)^ := Value;
end;

procedure TAOraParam.Clear;
begin
 SetIsNull(True);
end;

function TAOraParam.GetValue: variant;
begin
 if IsNull then begin
  Result := Null;
  exit;
 end;
 case FieldType of
  ftoString:    Result := AsString;
  ftoSmallint:  Result := AsSmallInt;
  ftoInteger:   Result := AsInteger;
  ftoWord:      Result := AsWord;
  ftoBoolean:   Result := AsBoolean;
  ftoDouble:    Result := AsDouble;
  ftoCurrency:  Result := AsCurrency;
  ftoDate:      Result := AsDate;
  ftoTime:      Result := AsTime;
{$IFDEF D6_OR_HIGHER}
  ftoDateTime:  Result := AsDateTime;
  ftoInt64:     Result := AsInt64;
{$ENDIF}
 else
  raise Exception.Create(sErrUnknownDataType);
 end;

end;

procedure TAOraParam.SetValue(Value: variant);
begin
 if Value = Null then begin
  Clear;
  exit;
 end;
 case FieldType of
  ftoString:    AsString   := Value;
  ftoSmallint:  AsSmallInt := Value;
  ftoInteger:   AsInteger  := Value;
  ftoWord:      AsWord     := Value;
  ftoBoolean:   AsBoolean  := Value;
  ftoDouble:    AsDouble   := Value;
  ftoCurrency:  AsCurrency := Value;
  ftoDate:      AsDate     := Value;
  ftoTime:      AsTime     := Value;
{$IFDEF D6_OR_HIGHER}
  ftoDateTime:  AsDateTime := Value;
  ftoInt64:     AsInt64    := Value;
{$ENDIF}
 else
  raise Exception.Create(sErrUnknownDataType);
 end;
end;

procedure TAOraParam.ClearBlob;
begin
  TestType(ftoBlob);
  TAOraSQL(FParent).TestError('ClearBlob - OCILobTrim - ',
                              TAOraSQL(FParent).Database.OCILobTrim(TAOraSQL(FParent).Database.mysvchp,
                                                                    TAOraSQL(FParent).myerrhp,
                                                                    pOCILobLocator(pData^), 0));
end;

function TAOraParam.GetLobLength: integer;
var len:ub4;
begin
  TestType(ftoBlob);
  TAOraSQL(FParent).TestError('GetLobLength - OCILobGetLength - ',
                              TAOraSQL(FParent).Database.OCILobGetLength(TAOraSQL(FParent).Database.mysvchp,
                                                                         TAOraSQL(FParent).myerrhp,
                                                                         pOCILobLocator(pData^), len));
  Result := len;
end;

function TAOraParam.ReadBlob(Offset: integer; Buffer: pointer;
  Size: integer): ub4;
begin
  TestType(ftoBlob);
  Result := Size;
  TAOraSQL(FParent).TestError('ReadBlob - OCILobRead - ',
                              TAOraSQL(FParent).Database.OCILobRead(TAOraSQL(FParent).Database.mysvchp,
                                                                    TAOraSQL(FParent).myerrhp,
                                                                    pOCILobLocator(pData^),
                                                                    Result, Offset + 1, Buffer, Result, nil, nil, 0, 0));
end;

function TAOraParam.WriteBlob(Offset: integer; Buffer: pointer;
  Size: integer): ub4;
begin
  TestType(ftoBlob);
  Result := Size;
  TAOraSQL(FParent).TestError('WriteBlob - OCILobWrite - ',
                              TAOraSQL(FParent).Database.OCILobWrite(TAOraSQL(FParent).Database.mysvchp,
                                                                     TAOraSQL(FParent).myerrhp,
                                                                     pOCILobLocator(pData^),
                                                                     Result, Offset + 1, Buffer, Result, OCI_ONE_PIECE, nil, nil, 0, 0));
end;

{ TAOraField }

constructor TAOraField.Create(Parent:TADataSet; FieldName:string; RFieldType:TAFieldType; FieldSize:word; Required:boolean);
begin
  inherited Create(Parent, FieldName, RFieldType, FieldSize, Required);

  pData     := nil;
  pDataNull := nil;
  pDataLen  := nil;
end;

procedure TAOraField.Add(CountF:integer);
var  resi,redi:pointer;
     i,j:integer;
     vcurrency:currency;
     vdate,vtime:integer;
     vdatetime:int64;
label next,nexti;
begin
 if not FMapped then begin
   if Assigned(ValuesNull) then ValuesNull.AddFillValues(CountF);
   Values.AddFillValues(CountF);
 end else begin
  if Assigned(ValuesNull) then begin
   ValuesNull.AddFillValues(CountF);
   resi := pDataNull.Memory;
   redi := ValuesNull.GetAddr(ValuesNull.Count-CountF);
   asm // move Null-indicators from sb2(Oracle format) to Boolean (Delphi format)
    pushad
    pushfd
    mov   esi,resi
    mov   edi,redi
    mov   ecx,CountF
  nexti:
    xor   bl,bl
    LODSW
    test  ax,ax
    jnz   next
    mov   bl,1            // it is True
  next:
    mov   [edi],bl
    inc   edi
    dec   ecx
    jnz   nexti
    popfd
    popad
   end;
  end;

 // moving field values
  case FieldType of
   ftoString:  Values.AddMany(pData.Memory, CountF);
   ftoBoolean: Values.AddMany(pData.Memory, CountF);
   ftoDouble:  Values.AddMany(pData.Memory, CountF);
   ftoCurrency:for i := 0 to CountF - 1 do begin
                goodOra2Delphi(ftoCurrency, THArrayDouble(pData).GetAddr(i), @vcurrency);
                THArrayCurrency(Values).AddValue(vcurrency);
               end;
   ftoDate:    for i := 0 to CountF - 1 do begin
                goodOra2Delphi(ftoDate, pData.GetAddr(i), @vdate);
                THArrayInteger(Values).AddValue(vdate);
               end;
   ftoTime:    for i := 0 to CountF - 1 do begin
                goodOra2Delphi(ftoTime, pData.GetAddr(i), @vtime);
                THArrayInteger(Values).AddValue(vdate);
               end;
   ftoDateTime:for i := 0 to CountF - 1 do begin
                goodOra2Delphi(ftoDateTime, pData.GetAddr(i), @vdatetime);
                THArrayInt64(Values).AddValue(vdatetime);
               end;
   ftoInteger: Values.AddMany(pData.Memory, CountF);
   ftoSmallInt:Values.AddMany(pData.Memory, CountF);
   ftoWord:    Values.AddMany(pData.Memory, CountF);
   ftoBlob,ftoClob:begin
                Values.AddMany(pData.Memory, CountF);// copying BLOB locators into persistent array
                // copy as many descriptors as number of fetched lines
                // the remain descriptors are freed.
                for j := CountF to pData.Count - 1 do
                 TAOraSQL(FParent).TestError('Add - OCIDescriptorFree - ',
                                             TAOraSQL(FParent).Database.OCIDescriptorFree(ppointer(pData.GetAddr(j))^, OCI_DTYPE_LOB));

{                for j:=0 to CountF-1 do begin
                 ppointer(pData.GetAddr(j))^:=nil;
                 // 嚯腩赅轵桁 眍恹