mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 07:19:27 +02:00
marco
parent
aa9df955ee
commit
c1814c4328
@ -1,8 +1,4 @@
|
||||
unit oracleconnection;
|
||||
//
|
||||
// For usage of "returning" like clauses see mantis #18133
|
||||
//
|
||||
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
@ -105,7 +101,7 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
math, StrUtils;
|
||||
math, StrUtils, FmtBCD;
|
||||
|
||||
ResourceString
|
||||
SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
|
||||
@ -140,6 +136,167 @@ begin
|
||||
result:=OCI_CONTINUE;
|
||||
end;
|
||||
|
||||
//conversions
|
||||
|
||||
Procedure FmtBCD2Nvu(bcd:tBCD;b:pByte);
|
||||
var
|
||||
i,j,cnt : integer;
|
||||
nibbles : array [0..maxfmtbcdfractionsize-1] of byte;
|
||||
exp : shortint;
|
||||
bb : byte;
|
||||
begin
|
||||
fillchar(b[0],22,#0);
|
||||
if BCDPrecision(bcd)=0 then // zero, special case
|
||||
begin
|
||||
b[0]:=1;
|
||||
b[1]:=$80;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (BCDPrecision(bcd)-BCDScale(bcd)) mod 2 <>0 then // odd number before decimal point
|
||||
begin
|
||||
nibbles[0]:=0;
|
||||
j:=1;
|
||||
end
|
||||
else
|
||||
j:=0;
|
||||
for i:=0 to bcd.Precision -1 do
|
||||
if i mod 2 =0 then
|
||||
nibbles[i+j]:=bcd.Fraction[i div 2] shr 4
|
||||
else
|
||||
nibbles[i+j]:=bcd.Fraction[i div 2] and $0f;
|
||||
nibbles[bcd.Precision+j]:=0; // make sure last nibble is also 0 in case we have odd scale
|
||||
exp:=(BCDPrecision(bcd)-BCDScale(bcd)+1) div 2;
|
||||
cnt:=exp+(BCDScale(bcd)+1) div 2;
|
||||
// to avoid "ora 01438: value larger than specified precision allowed for this column"
|
||||
// remove trailing zeros (scale < 0)
|
||||
while (nibbles[cnt*2-2]*10+nibbles[cnt*2-1])=0 do
|
||||
cnt:=cnt-1;
|
||||
// and remove leading zeros (scale > precision)
|
||||
j:=0;
|
||||
while (nibbles[j*2]*10+nibbles[j*2+1])=0 do
|
||||
begin
|
||||
j:=j+1;
|
||||
exp:=exp-1;
|
||||
end;
|
||||
if IsBCDNegative(bcd) then
|
||||
begin
|
||||
b[0]:=cnt-j+1;
|
||||
b[1]:=not(exp+64) and $7f ;
|
||||
for i:=j to cnt-1 do
|
||||
begin
|
||||
bb:=nibbles[i*2]*10+nibbles[i*2+1];
|
||||
b[2+i-j]:=101-bb;
|
||||
end;
|
||||
if 2+cnt-j<22 then // add a 102 at the end of the number if place left.
|
||||
begin
|
||||
b[0]:=b[0]+1;
|
||||
b[2+cnt-j]:=102;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
b[0]:=cnt-j+1;
|
||||
b[1]:=(exp+64) or $80 ;
|
||||
for i:=j to cnt-1 do
|
||||
begin
|
||||
bb:=nibbles[i*2]*10+nibbles[i*2+1];
|
||||
b[2+i-j]:=1+bb;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Nvu2FmtBCE(b:pbyte):tBCD;
|
||||
var
|
||||
i,j : integer;
|
||||
bb,size : byte;
|
||||
exp : shortint;
|
||||
nibbles : array [0..maxfmtbcdfractionsize-1] of byte;
|
||||
scale : integer;
|
||||
begin
|
||||
size := b[0];
|
||||
if (size=1) and (b[1]=$80) then // special representation for 0
|
||||
result:=IntegerToBCD(0)
|
||||
else
|
||||
begin
|
||||
result.SignSpecialPlaces:=0; //sign positive, non blank, scale 0
|
||||
result.Precision:=1; //BCDNegate works only if Precision <>0
|
||||
if (b[1] and $80)=$80 then // then the number is positive
|
||||
begin
|
||||
exp := (b[1] and $7f)-65;
|
||||
for i := 0 to size-2 do
|
||||
begin
|
||||
bb := b[i+2]-1;
|
||||
nibbles[i*2]:=bb div 10;
|
||||
nibbles[i*2+1]:=(bb mod 10);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
BCDNegate(result);
|
||||
exp := (not(b[1]) and $7f)-65;
|
||||
if b[size]=102 then // last byte doesn't count if = 102
|
||||
size:=size-1;
|
||||
for i := 0 to size-2 do
|
||||
begin
|
||||
bb := 101-b[i+2];
|
||||
nibbles[i*2]:=bb div 10;
|
||||
nibbles[i*2+1]:=(bb mod 10);
|
||||
end;
|
||||
end;
|
||||
nibbles[(size-1)*2]:=0;
|
||||
result.Precision:=(size-1)*2;
|
||||
scale:=result.Precision-(exp*2+2);
|
||||
if scale>=0 then
|
||||
begin
|
||||
if (scale>result.Precision) then // need to add leading 0's
|
||||
begin
|
||||
for i:=0 to (scale-result.Precision+1) div 2 do
|
||||
result.Fraction[i]:=0;
|
||||
i:=scale-result.Precision;
|
||||
result.Precision:=scale;
|
||||
end
|
||||
else
|
||||
i:=0;
|
||||
j:=i;
|
||||
if (i=0) and (nibbles[0]=0) then // get rid of leading zero received from oci
|
||||
begin
|
||||
result.Precision:=result.Precision-1;
|
||||
j:=-1;
|
||||
end;
|
||||
while i<=result.Precision do // copy nibbles
|
||||
begin
|
||||
if i mod 2 =0 then
|
||||
result.Fraction[i div 2]:=nibbles[i-j] shl 4
|
||||
else
|
||||
result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i-j];
|
||||
i:=i+1;
|
||||
end;
|
||||
result.SignSpecialPlaces:=result.SignSpecialPlaces or scale;
|
||||
end
|
||||
else
|
||||
begin // add trailing zero's, increase precision to take them into account
|
||||
i:=0;
|
||||
while i<=result.Precision do // copy nibbles
|
||||
begin
|
||||
if i mod 2 =0 then
|
||||
result.Fraction[i div 2]:=nibbles[i] shl 4
|
||||
else
|
||||
result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i];
|
||||
i:=i+1;
|
||||
end;
|
||||
result.Precision:=result.Precision-scale;
|
||||
for i := size -1 to High(result.Fraction) do
|
||||
result.Fraction[i] := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
// TOracleConnection
|
||||
|
||||
procedure TOracleConnection.HandleError;
|
||||
|
||||
var errcode : sb4;
|
||||
@ -197,7 +354,10 @@ begin
|
||||
day:=pb[3];
|
||||
asDateTime:=EncodeDate(year,month,day);
|
||||
end;
|
||||
end;
|
||||
ftFMTBcd : begin
|
||||
AsFMTBCD:=Nvu2FmtBCE(parambuffers[SQLVarNr].buffer);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
@ -369,6 +529,7 @@ begin
|
||||
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;
|
||||
ftFMTBcd : begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
|
||||
|
||||
end;
|
||||
parambuffers[tel].buffer := getmem(OFieldSize);
|
||||
@ -437,6 +598,9 @@ begin
|
||||
pb[5] := 1;
|
||||
pb[6] := 1;
|
||||
end;
|
||||
ftFmtBCD : begin
|
||||
FmtBCD2Nvu(asFmtBCD,parambuffers[SQLVarNr].buffer);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
@ -549,7 +713,7 @@ var Param : POCIParam;
|
||||
|
||||
FieldType : TFieldType;
|
||||
FieldName : string;
|
||||
FieldSize : word;
|
||||
FieldSize : integer;
|
||||
|
||||
OFieldType : ub2;
|
||||
OFieldName : Pchar;
|
||||
@ -589,11 +753,11 @@ begin
|
||||
HandleError;
|
||||
if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
|
||||
HandleError;
|
||||
if Oscale = 0 then
|
||||
if (Oscale = 0) and (Oprecision<9) then
|
||||
begin
|
||||
if Oprecision=0 then //Number(0,0) = number(32,4)
|
||||
begin //Warning ftBCD is limited to precision 12
|
||||
FieldType := ftBCD;
|
||||
begin
|
||||
FieldType := ftFMTBCD;
|
||||
FieldSize := 4;
|
||||
OFieldType := SQLT_VNU;
|
||||
OFieldSize:= 22;
|
||||
@ -605,20 +769,32 @@ begin
|
||||
OFieldSize:= sizeof(integer);
|
||||
end;
|
||||
end
|
||||
else if (oscale = -127) {and (OPrecision=0)} then
|
||||
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
|
||||
else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
|
||||
begin
|
||||
FieldType := ftBCD;
|
||||
FieldSize := oscale;
|
||||
OFieldType := SQLT_VNU;
|
||||
OFieldSize:= 22;
|
||||
end
|
||||
else FieldType := ftUnknown;
|
||||
else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
|
||||
begin
|
||||
FieldType := ftFMTBCD;
|
||||
FieldSize := oscale;
|
||||
OFieldType := SQLT_VNU;
|
||||
OFieldSize:= 22;
|
||||
end
|
||||
else //approximation with double, best can do
|
||||
begin
|
||||
FieldType := ftFloat;
|
||||
OFieldType := SQLT_FLT;
|
||||
OFieldSize:=sizeof(double);
|
||||
end;
|
||||
end;
|
||||
OCI_TYPECODE_CHAR,
|
||||
OCI_TYPECODE_VARCHAR,
|
||||
@ -704,6 +880,9 @@ begin
|
||||
end;
|
||||
move(cur,buffer^,SizeOf(Currency));
|
||||
end;
|
||||
ftFMTBCD : begin
|
||||
pBCD(buffer)^:= Nvu2FmtBCE(fieldbuffers[FieldDef.FieldNo-1].buffer);
|
||||
end;
|
||||
ftFloat : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
|
||||
ftInteger : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
|
||||
ftDate : begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user