paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-08 09:59:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Fix for ftLargeInt fields from Jesus Reyes

Browse Source 
git-svn-id: trunk@4000 -
This commit is contained in:
joost 2006-06-29 20:01:52 +00:00
parent 3b6b7a5973
commit 8341107c90
3 changed files with 55 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
fcl/db/bufdataset.inc
View File

@ -257,6 +257,7 @@ begin
ftBoolean : result := sizeof(wordbool);
ftBCD : result := sizeof(currency);
ftFloat : result := sizeof(double);
ftLargeInt : result := sizeof(largeint);
ftTime,
ftDate,
ftDateTime : result := sizeof(TDateTime)

9
fcl/db/sqldb/examples/database.ini
View File

@ -9,7 +9,7 @@
# * odbc
# * postgresql
type=interbase
type=oracle
# name
# gives the name of the database that should be used.
@ -17,7 +17,7 @@ type=interbase
# used. More information about how to create a dabatase can be find in the
# documentation of the database-engine.
name=/opt/firebird/examples/employee.fdb
name=//192.168.3.1/xe
# user
# name is the name of a user which must have all rights on the selected
@ -26,11 +26,12 @@ name=/opt/firebird/examples/employee.fdb
# How to set up users and their rights can be found in the database-engine
# documentation.
user=sysdba
user=system
# password
# password is the password of the provided user. If the password is incorrect,
# all or one of the test could fail.
password=masterkey
password=rosivrepus
hostname=

53
fcl/db/sqldb/oracle/oracleconnection.pp
View File

@ -75,6 +75,8 @@ type
implementation
uses math;
ResourceString
SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
SErrHandleAllocFailed = 'The allocation of the error handle failed.';
@ -349,12 +351,23 @@ begin
FieldType := ftFloat;
OFieldType := SQLT_FLT;
OFieldSize:=sizeof(double);
end;
end
else if (oscale <=4) and (OPrecision<=12) then
begin
FieldType := ftBCD;
FieldSize := sizeof(Currency);
OFieldType := SQLT_VNU;
OFieldSize:= 22;
end
else FieldType := ftUnknown;
end;
OCI_TYPECODE_CHAR,
OCI_TYPECODE_VARCHAR,
OCI_TYPECODE_VARCHAR2 : begin FieldType := ftString; inc(OFieldsize) ;FieldSize := OFieldSize; OFieldType:=SQLT_STR end;
OCI_TYPECODE_VARCHAR2 : begin FieldType := ftString; FieldSize := OFieldSize; inc(OFieldsize) ;OFieldType:=SQLT_STR end;
OCI_TYPECODE_DATE : FieldType := ftDate;
OCI_TYPECODE_TIMESTAMP,
OCI_TYPECODE_TIMESTAMP_LTZ,
OCI_TYPECODE_TIMESTAMP_TZ : FieldType := ftDateTime;
else
FieldType := ftUnknown;
end;
@ -394,8 +407,14 @@ end;
function TOracleConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer): boolean;
var dt : TDateTime;
b : pbyte;
var dt : TDateTime;
b : pbyte;
size,i : byte;
exp : shortint;
cur : Currency;
ts : TTimeStamp;
dattim : ^TDateTime;
begin
with cursor as TOracleCursor do if fieldbuffers[FieldDef.FieldNo-1].ind = -1 then
@ -405,6 +424,25 @@ begin
result := True;
case FieldDef.DataType of
ftString : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,FieldDef.Size);
ftBCD : begin
b := fieldbuffers[FieldDef.FieldNo-1].buffer;
size := b[0];
cur := 0;
if (b[1] and $80)=$80 then // then the number is positive
begin
exp := (b[1] and $7f)-65;
for i := 2 to size do
cur := cur + (b[i]-1) * intpower(100,-(i-2)+exp);
end
else
begin
exp := (not(b[1]) and $7f)-65;
for i := 2 to size-1 do
cur := cur + (101-b[i]) * intpower(100,-(i-2)+exp);
cur := -cur;
end;
move(cur,buffer^,FieldDef.Size);
end;
ftFloat : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
ftInteger : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
ftDate : begin
@ -412,6 +450,13 @@ begin
dt := EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]);
move(dt,buffer^,sizeof(dt));
end;
ftDateTime : begin
dattim := fieldbuffers[FieldDef.FieldNo-1].buffer;
// dt := EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]);
// dt := ComposeDateTime(EncodeDate((b[0]-100)*100+(b[1]-100),b[2],b[3]), EncodeTime(b[4],b[5],b[6],0));
move(dt,buffer^,sizeof(dt));
end;
else
Result := False;