Commit 5557a9ab authored by mse1's avatar mse1

+ tdbcontroller.options dbo_bcdtofloatif (experimental).

git-svn-id: https://mseide-msegui.svn.sourceforge.net/svnroot/mseide-msegui/trunk@3037 56ecf5fe-6917-0410-8ac6-ca8e178bccbf
parent 17279102
......@@ -216,7 +216,7 @@ function clientminorversion: integer;
implementation
uses
strutils,msesysintf,msebits,msefloattostr;
strutils,msesysintf,msebits,msefloattostr,msedatabase;
function clientversion: string;
var
......@@ -536,6 +536,17 @@ procedure TIBConnection.TranslateFldType(SQLType,sqlsubtype,SQLLen,
begin
LensSet := False;
if SQLScale < 0 then begin
if (sqlscale < -4) and (dbo_bcdtofloatif in controller.options) then begin
LensSet:= True;
TrLen:= SQLLen;
TrType:= ftfloat;
end
else begin
LensSet:= True;
TrLen:= SQLLen;
TrType:= ftBCD
end;
{
if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
begin
LensSet := True;
......@@ -548,6 +559,7 @@ begin
TrLen := SQLLen;
TrType := ftfloat;
end;
}
end
else begin
LensSet:= True;
......@@ -972,6 +984,7 @@ begin
end;
procedure TIBConnection.SetParameters(cursor: TSQLCursor; AParams: TmseParams);
//todo: remove not needed move operations
var
ParNr,SQLVarNr: integer;
s: string;
......@@ -1005,9 +1018,10 @@ begin
ftbcd: begin
cur1:= AParams[ParNr].ascurrency;
with po1^ do begin
cur1:= cur1 / intexp10ar[4+SQLScale];
reallocmem(sqldata,sizeof(cur1));
move(cur1,sqldata^,sizeof(cur1));
scaleexp10(cur1,-(4+sqlscale));
// reallocmem(sqldata,sizeof(cur1));
// move(cur1,sqldata^,sizeof(cur1));
move(cur1,sqldata^,po1^.sqllen);
end;
end;
ftString,ftFixedChar,ftwidestring: begin
......@@ -1043,8 +1057,9 @@ begin
ftFloat,ftcurrency: begin
with po1^ do begin
if sqlscale < 0 then begin
reallocmem(sqldata,sizeof(int64));
pint64(sqldata)^:= round(AParams[ParNr].asfloat * intexp10(-SQLScale));
// reallocmem(sqldata,sizeof(int64));
int64(cur1):= round(AParams[ParNr].asfloat * intexp10(-SQLScale));
move(cur1,sqldata^,po1^.sqllen);
end
else begin
SetFloat(po1^.SQLData, AParams[ParNr].AsFloat,po1^.SQLLen);
......@@ -1070,24 +1085,27 @@ var
CurrBuff: pchar;
b: longint;
c: currency;
i64: int64;
// i64: int64;
po1: pxsqlvar;
do1: double;
procedure getbcdnum;
begin
i64:= 0;
Move(CurrBuff^,i64,po1^.SQLLen);
c:= 0;
Move(CurrBuff^,c,po1^.SQLLen);
case po1^.sqllen of
2: begin
i64:= psmallint(pointer(@i64))^; //sign extend
int64(c):= psmallint(pointer(@c))^; //sign extend
end;
4: begin
i64:= pinteger(pointer(@i64))^; //sign extend
int64(c):= pinteger(pointer(@c))^; //sign extend
end;
end;
end;
var
int1: integer;
begin
po1:= @TIBCursor(cursor).SQLDA^.SQLVar[fieldnum];
with TIBCursor(cursor),po1^ do begin
......@@ -1110,17 +1128,21 @@ begin
case DataType of
ftBCD: begin
getbcdnum;
int64(c):= i64 * intexp10ar[4+SQLScale];
scaleexp10(c,4+SQLScale);
Move(c,buffer^,sizeof(c));
end;
ftInteger,ftsmallint: begin
// b:= 0; //todo: byte order?
// Move(b, Buffer^,sizeof(longint));
// Move(CurrBuff^,Buffer^,SQLLen);
longint(buffer^):= 0;
Move(CurrBuff^,buffer^,SQLLen);
// longint(buffer^):= 0;
if datatype = ftsmallint then begin
longint(buffer^):= smallint(buffer^);
Move(CurrBuff^,b,SQLLen);
b:= psmallint(@b)^; //sign extend
Move(b,buffer^,sizeof(b));
end
else begin
Move(CurrBuff^,buffer^,SQLLen);
end;
end;
ftLargeint: begin
......@@ -1144,7 +1166,7 @@ begin
ftFloat,ftcurrency: begin
if sqlscale < 0 then begin //decimal
getbcdnum;
do1:= i64/intexp10(-SQLScale);
do1:= int64(c)/intexp10(-SQLScale);
move(do1,buffer^,sizeof(double));
end
else begin
......
......@@ -223,7 +223,7 @@ Type
implementation
uses
dbconst,msebufdataset,typinfo,dateutils,msefileutils;
dbconst,msebufdataset,typinfo,dateutils,msefileutils,msedatabase;
type
tmsebufdataset1 = class(tmsebufdataset);
var
......@@ -1010,7 +1010,7 @@ begin
FIELD_TYPE_NEWDECIMAL,
{$endif}
FIELD_TYPE_DECIMAL: begin
if Decimals < 5 then begin
if (Decimals < 4) or not (dbo_bcdtofloatif in controller.options) then begin
NewType:= ftBCD;
end
else begin
......
......@@ -1104,7 +1104,7 @@ var
ColumnSize:SQLUINTEGER;
ColName,TypeName:string;
FieldType:TFieldType;
FieldSize:word;
FieldSize: integer;
fd: tfielddef;
begin
fielddefs.clear;
......
......@@ -174,7 +174,7 @@ type
implementation
uses
math,msestream,msetypes,msedatalist,mseformatstr;
math,msestream,msetypes,msedatalist,mseformatstr,msedatabase;
ResourceString
SErrRollbackFailed = 'Rollback transaction failed';
......@@ -760,9 +760,11 @@ begin
size:= blobidsize;
end;
ftbcd: begin
int1:= PQfmod(Res,i);
if (int1 = -1) or ((int1 and $ffff) > varhdrsz + 4) then begin
fieldtype:= ftfloat;
if dbo_bcdtofloatif in controller.options then begin
int1:= PQfmod(Res,i);
if (int1 = -1) or ((int1 and $ffff) > varhdrsz + 4) then begin
fieldtype:= ftfloat;
end;
end;
end;
end;
......@@ -823,7 +825,9 @@ var
cur : currency;
NumericRecord : ^TNumericRecord;
int1: integer;
lint1: int64;
sint1: smallint;
wbo1: wordbool;
do1: double;
function getnumeric: boolean;
......@@ -840,6 +844,19 @@ var
//???? 0 in database seems to return digits and scale 0. mse
end;
function getfloat4: single;
var
si1: single;
begin
integer(si1):= beton(pinteger(currbuff)^);
result:= si1;
end;
function getfloat8: double;
begin
int64(result):= beton(pint64(currbuff)^);
end;
begin
{$ifdef FPC}{$checkpointer off}{$endif}
with TPQCursor(cursor) do begin
......@@ -855,8 +872,23 @@ begin
CurrBuff := pqgetvalue(res,CurTuple,x);
result := true;
case DataType of
ftInteger, ftSmallint, ftLargeInt,ftfloat,ftcurrency: begin
if (datatype = ftfloat) and (pqftype(res,x) = oid_numeric) then begin
ftInteger,ftSmallint,ftword: begin
case i of // postgres returns big-endian numbers
sizeof(integer): begin
int1:= BEtoN(pinteger(CurrBuff)^);
end;
sizeof(smallint): begin
int1:= BEtoN(psmallint(CurrBuff)^);
end;
end;
move(int1,buffer^,sizeof(int1));
end;
ftlargeint: begin
lint1:= BEtoN(pint64(CurrBuff)^);
move(lint1,buffer^,sizeof(lint1));
end;
ftfloat,ftcurrency: begin
if pqftype(res,x) = oid_numeric then begin
if getnumeric then begin
do1:= 0;
for int1 := NumericRecord^.Digits - 1 downto 0 do begin
......@@ -877,25 +909,16 @@ begin
else begin
do1:= nan;
end;
Move(do1, Buffer^, sizeof(double));
end
else begin
case i of // postgres returns big-endian numbers
sizeof(int64) : pint64(buffer)^ := BEtoN(pint64(CurrBuff)^);
sizeof(integer) : pinteger(buffer)^ := BEtoN(pinteger(CurrBuff)^);
sizeof(smallint) : psmallint(buffer)^ := BEtoN(psmallint(CurrBuff)^);
else begin
if i > bufsize then begin
bufsize:= -bufsize;
end
else begin
for tel:= 1 to i do begin
pchar(Buffer)[tel-1] := CurrBuff[i-tel];
end;
end;
end;
if pqftype(res,x) = oid_float4 then begin
do1:= getfloat4;
end
else begin
do1:= getfloat8;
end;
end;
Move(do1, Buffer^, sizeof(do1));
end;
ftString: begin
li:= pqgetlength(res,curtuple,x);
......@@ -916,40 +939,50 @@ begin
//save id
end;
ftdate: begin
dbl:= pointer(buffer);
dbl^:= BEtoN(plongint(CurrBuff)^) + 36526;
i:= sizeof(double);
do1:= BEtoN(plongint(CurrBuff)^) + 36526;
move(do1,buffer^,sizeof(do1));
end;
ftDateTime,fttime: begin
pint64(buffer)^ := BEtoN(pint64(CurrBuff)^);
dbl := pointer(buffer);
do1:= double(BEtoN(pint64(CurrBuff)^));
if FIntegerDatetimes then begin
dbl^ := pint64(buffer)^/1000000;
do1:= do1/1000000;
end;
dbl^ := (dbl^+3.1558464E+009)/86400; // postgres counts seconds elapsed since 1-1-2000
do1:= (do1+3.1558464E+009)/86400; // postgres counts seconds elapsed since 1-1-2000
// Now convert the mathematically-correct datetime to the
// illogical windows/delphi/fpc TDateTime:
if (dbl^ <= 0) and (frac(dbl^)<0) then begin
dbl^ := trunc(dbl^)-2-frac(dbl^);
if (do1 <= 0) and (frac(do1)<0) then begin
do1:= trunc(do1)-2-frac(do1);
end;
move(do1,buffer^,sizeof(do1));
end;
ftBCD: begin
result:= getnumeric;
if result then begin
cur := 0;
for tel := 1 to NumericRecord^.Digits do begin
cur := cur + beton(pword(currbuff)^) * intpower(10000,-(tel-1)+
NumericRecord^.weight);
inc(pointer(currbuff),2);
case pqftype(res,x) of
oid_float4: begin
cur:= getfloat4;
end;
oid_float8: begin
cur:= getfloat8;
end;
if NumericRecord^.Sign <> 0 then begin
cur := -cur;
else begin
result:= getnumeric;
if result then begin
cur := 0;
for tel := 1 to NumericRecord^.Digits do begin
cur := cur + beton(pword(currbuff)^) * intpower(10000,-(tel-1)+
NumericRecord^.weight);
inc(pointer(currbuff),2);
end;
if NumericRecord^.Sign <> 0 then begin
cur := -cur;
end;
end;
end;
Move(Cur, Buffer^, sizeof(currency));
end;
Move(Cur, Buffer^, sizeof(cur));
end;
ftBoolean: begin
pwordbool(buffer)^:= CurrBuff[0] <> #0;
wbo1:= CurrBuff[0] <> #0;
move(wbo1,buffer^,sizeof(wbo1));
end;
else begin
result := false;
......
......@@ -22,7 +22,10 @@ uses
mseapplication;
type
databaseoptionty = (dbo_utf8,dbo_noutf8,dbo_utf8message);
databaseoptionty =
(dbo_utf8,dbo_noutf8,dbo_utf8message,
dbo_bcdtofloatif //use ftFloat for scale > 4 instead ftBCD
);
databaseoptionsty = set of databaseoptionty;
tmdbdataset = class;
......
......@@ -1094,7 +1094,7 @@ const
mask: databaseoptionsty = [dbo_utf8,dbo_noutf8];
begin
if foptions <> avalue then begin
tmdatabase1(fowner).checkdisconnected;
// tmdatabase1(fowner).checkdisconnected;
foptions:= databaseoptionsty(setsinglebit(longword(avalue),
longword(foptions),longword(mask)));
end;
......
......@@ -60,6 +60,11 @@ const
intexp10ar: array[0..9] of integer =
(1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000);
int64exp10ar: array[0..19] of int64 =
(1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000,
1000000000,10000000000,100000000000,1000000000000,10000000000000,
100000000000000,1000000000000000,10000000000000000,
100000000000000000,1000000000000000000);
type
int64recty = record
lsw: cardinal;
......@@ -134,6 +139,9 @@ procedure swaprgb1(var value: cardinal);
function swaprgb(const value: cardinal): cardinal;
function roundint(const value: integer; const step: integer): integer;
procedure scaleexp10(var value: int64; const exp: integer); overload;
procedure scaleexp10(var value: integer; const exp: integer); overload;
procedure scaleexp10(var value: currency; const exp: integer); overload;
implementation
......@@ -455,6 +463,36 @@ begin
result:= ((value + int1) div step) * step;
end;
procedure scaleexp10(var value: int64; const exp: integer);
begin
if exp < 0 then begin
value:= value div int64exp10ar[-exp];
end
else begin
value:= value * int64exp10ar[exp];
end;
end;
procedure scaleexp10(var value: integer; const exp: integer);
begin
if exp < 0 then begin
value:= value div intexp10ar[-exp];
end
else begin
value:= value * intexp10ar[exp];
end;
end;
procedure scaleexp10(var value: currency; const exp: integer);
begin
if exp < 0 then begin
int64(value):= int64(value) div int64exp10ar[-exp];
end
else begin
int64(value):= int64(value) * int64exp10ar[exp];
end;
end;
procedure swaprgb1(var value: cardinal);
var
by1: byte;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment