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

* Added checks to TField.Size

Browse Source 
* Cleanup and several fixes regarding TField.Size in IBconnection

git-svn-id: trunk@8856 -
This commit is contained in:
joost 2007-10-19 22:07:56 +00:00
parent c384171709
commit 77daccf9e6
3 changed files with 14 additions and 37 deletions
packages/fcl-db/src
db.pasfields.inc
sqldb/interbase
ibconnection.pp

2
packages/fcl-db/src/db.pas
View File

@ -397,7 +397,7 @@ type
property IsNull: Boolean read GetIsNull;
property NewValue: Variant read GetNewValue write SetNewValue;
property Offset: word read FOffset;
property Size: Word read FSize write FSize;
property Size: Word read FSize write SetSize;
property Text: string read GetEditText write SetEditText;
property ValidChars : TFieldChars Read FValidChars;
property Value: variant read GetAsVariant write SetAsVariant;

2
packages/fcl-db/src/fields.inc
View File

@ -950,7 +950,7 @@ begin
SetDataType(ftString);
FFixedChar := False;
FTransliterate := False;
Size:=20;
FSize:=20;
end;
class procedure TStringField.CheckTypeSize(AValue: Longint);

47
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -53,12 +53,12 @@ type
function GetDialect: integer;
procedure SetDBDialect;
procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer;
var TrType : TFieldType; var TrLen : word);
// conversion methods
procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
procedure SetDateTime(CurrBuff: pointer; PTime : TDateTime; AType : integer);
procedure GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
procedure GetFloat(CurrBuff, Buffer : pointer; Size : Byte);
procedure SetFloat(CurrBuff: pointer; Dbl: Double; Size: integer);
procedure CheckError(ProcName : string; Status : PISC_STATUS);
function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
@ -403,17 +403,15 @@ begin
reAllocMem(aSQLDA,0);
end;
procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
var TrType : TFieldType; var TrLen : word);
procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer;
var TrType : TFieldType; var TrLen : word);
begin
LensSet := False;
trlen := 0;
if SQLScale < 0 then
begin
if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
begin
LensSet := True;
TrLen := SQLLen;
TrLen := abs(SQLScale);
TrType := ftBCD
end
else
@ -422,13 +420,11 @@ begin
else case (SQLType and not 1) of
SQL_VARYING :
begin
LensSet := True;
TrType := ftString;
TrLen := SQLLen;
end;
SQL_TEXT :
begin
LensSet := True;
TrType := ftString;
TrLen := SQLLen;
end;
@ -441,43 +437,25 @@ begin
SQL_ARRAY :
begin
TrType := ftArray;
LensSet := true;
TrLen := SQLLen;
end;
SQL_BLOB :
begin
TrType := ftBlob;
LensSet := True;
TrLen := SQLLen;
TrType := ftBlob;
TrLen := SQLLen;
end;
SQL_SHORT :
TrType := ftSmallint;
SQL_LONG :
begin
LensSet := True;
TrLen := 0;
TrType := ftInteger;
end;
SQL_INT64 :
TrType := ftLargeInt;
SQL_DOUBLE :
begin
LensSet := True;
TrLen := SQLLen;
TrType := ftFloat;
end;
SQL_FLOAT :
begin
LensSet := True;
TrLen := SQLLen;
TrType := ftFloat;
end
else
begin
LensSet := True;
TrLen := 0;
TrType := ftUnknown;
end;
end;
end;
@ -633,7 +611,6 @@ end;
procedure TIBConnection.AddFieldDefs(cursor: TSQLCursor;FieldDefs : TfieldDefs);
var
x : integer;
lenset : boolean;
TransLen : word;
TransType : TFieldType;
FD : TFieldDef;
@ -646,7 +623,7 @@ begin
for x := 0 to SQLDA^.SQLD - 1 do
begin
TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
lenset, TransType, TransLen);
TransType, TransLen);
FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].AliasName, TransType,
TransLen, False, (x + 1));
if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
@ -854,7 +831,7 @@ begin
PChar(Buffer + VarCharLen)^ := #0;
end;
ftFloat :
GetFloat(CurrBuff, Buffer, FieldDef);
GetFloat(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLLen);
ftBlob : begin // load the BlobIb in field's buffer
FillByte(buffer^,sizeof(TBufBlobField),0);
Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
@ -1066,13 +1043,13 @@ begin
end;
end;
procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Size : byte);
var
Ext : extended;
Dbl : double;
Sin : single;
begin
case Field.Size of
case Size of
4 :
begin
Move(CurrBuff^, Sin, 4);