mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-26 15:10:25 +02:00
* Added checks to TField.Size
* Cleanup and several fixes regarding TField.Size in IBconnection git-svn-id: trunk@8856 -
This commit is contained in:
parent
c384171709
commit
77daccf9e6
@ -397,7 +397,7 @@ type
|
|||||||
property IsNull: Boolean read GetIsNull;
|
property IsNull: Boolean read GetIsNull;
|
||||||
property NewValue: Variant read GetNewValue write SetNewValue;
|
property NewValue: Variant read GetNewValue write SetNewValue;
|
||||||
property Offset: word read FOffset;
|
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 Text: string read GetEditText write SetEditText;
|
||||||
property ValidChars : TFieldChars Read FValidChars;
|
property ValidChars : TFieldChars Read FValidChars;
|
||||||
property Value: variant read GetAsVariant write SetAsVariant;
|
property Value: variant read GetAsVariant write SetAsVariant;
|
||||||
|
@ -950,7 +950,7 @@ begin
|
|||||||
SetDataType(ftString);
|
SetDataType(ftString);
|
||||||
FFixedChar := False;
|
FFixedChar := False;
|
||||||
FTransliterate := False;
|
FTransliterate := False;
|
||||||
Size:=20;
|
FSize:=20;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
class procedure TStringField.CheckTypeSize(AValue: Longint);
|
class procedure TStringField.CheckTypeSize(AValue: Longint);
|
||||||
|
@ -53,12 +53,12 @@ type
|
|||||||
function GetDialect: integer;
|
function GetDialect: integer;
|
||||||
procedure SetDBDialect;
|
procedure SetDBDialect;
|
||||||
procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
|
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);
|
var TrType : TFieldType; var TrLen : word);
|
||||||
// conversion methods
|
// conversion methods
|
||||||
procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
|
procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
|
||||||
procedure SetDateTime(CurrBuff: pointer; PTime : TDateTime; 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 SetFloat(CurrBuff: pointer; Dbl: Double; Size: integer);
|
||||||
procedure CheckError(ProcName : string; Status : PISC_STATUS);
|
procedure CheckError(ProcName : string; Status : PISC_STATUS);
|
||||||
function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
|
function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
|
||||||
@ -403,17 +403,15 @@ begin
|
|||||||
reAllocMem(aSQLDA,0);
|
reAllocMem(aSQLDA,0);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
|
procedure TIBConnection.TranslateFldType(SQLType, SQLLen, SQLScale : integer;
|
||||||
var TrType : TFieldType; var TrLen : word);
|
var TrType : TFieldType; var TrLen : word);
|
||||||
begin
|
begin
|
||||||
LensSet := False;
|
trlen := 0;
|
||||||
|
|
||||||
if SQLScale < 0 then
|
if SQLScale < 0 then
|
||||||
begin
|
begin
|
||||||
if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
|
if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
|
||||||
begin
|
begin
|
||||||
LensSet := True;
|
TrLen := abs(SQLScale);
|
||||||
TrLen := SQLLen;
|
|
||||||
TrType := ftBCD
|
TrType := ftBCD
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
@ -422,13 +420,11 @@ begin
|
|||||||
else case (SQLType and not 1) of
|
else case (SQLType and not 1) of
|
||||||
SQL_VARYING :
|
SQL_VARYING :
|
||||||
begin
|
begin
|
||||||
LensSet := True;
|
|
||||||
TrType := ftString;
|
TrType := ftString;
|
||||||
TrLen := SQLLen;
|
TrLen := SQLLen;
|
||||||
end;
|
end;
|
||||||
SQL_TEXT :
|
SQL_TEXT :
|
||||||
begin
|
begin
|
||||||
LensSet := True;
|
|
||||||
TrType := ftString;
|
TrType := ftString;
|
||||||
TrLen := SQLLen;
|
TrLen := SQLLen;
|
||||||
end;
|
end;
|
||||||
@ -441,45 +437,27 @@ begin
|
|||||||
SQL_ARRAY :
|
SQL_ARRAY :
|
||||||
begin
|
begin
|
||||||
TrType := ftArray;
|
TrType := ftArray;
|
||||||
LensSet := true;
|
|
||||||
TrLen := SQLLen;
|
TrLen := SQLLen;
|
||||||
end;
|
end;
|
||||||
SQL_BLOB :
|
SQL_BLOB :
|
||||||
begin
|
begin
|
||||||
TrType := ftBlob;
|
TrType := ftBlob;
|
||||||
LensSet := True;
|
|
||||||
TrLen := SQLLen;
|
TrLen := SQLLen;
|
||||||
end;
|
end;
|
||||||
SQL_SHORT :
|
SQL_SHORT :
|
||||||
TrType := ftSmallint;
|
TrType := ftSmallint;
|
||||||
SQL_LONG :
|
SQL_LONG :
|
||||||
begin
|
|
||||||
LensSet := True;
|
|
||||||
TrLen := 0;
|
|
||||||
TrType := ftInteger;
|
TrType := ftInteger;
|
||||||
end;
|
|
||||||
SQL_INT64 :
|
SQL_INT64 :
|
||||||
TrType := ftLargeInt;
|
TrType := ftLargeInt;
|
||||||
SQL_DOUBLE :
|
SQL_DOUBLE :
|
||||||
begin
|
|
||||||
LensSet := True;
|
|
||||||
TrLen := SQLLen;
|
|
||||||
TrType := ftFloat;
|
TrType := ftFloat;
|
||||||
end;
|
|
||||||
SQL_FLOAT :
|
SQL_FLOAT :
|
||||||
begin
|
|
||||||
LensSet := True;
|
|
||||||
TrLen := SQLLen;
|
|
||||||
TrType := ftFloat;
|
TrType := ftFloat;
|
||||||
end
|
|
||||||
else
|
else
|
||||||
begin
|
|
||||||
LensSet := True;
|
|
||||||
TrLen := 0;
|
|
||||||
TrType := ftUnknown;
|
TrType := ftUnknown;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
|
||||||
|
|
||||||
Function TIBConnection.AllocateCursorHandle : TSQLCursor;
|
Function TIBConnection.AllocateCursorHandle : TSQLCursor;
|
||||||
|
|
||||||
@ -633,7 +611,6 @@ end;
|
|||||||
procedure TIBConnection.AddFieldDefs(cursor: TSQLCursor;FieldDefs : TfieldDefs);
|
procedure TIBConnection.AddFieldDefs(cursor: TSQLCursor;FieldDefs : TfieldDefs);
|
||||||
var
|
var
|
||||||
x : integer;
|
x : integer;
|
||||||
lenset : boolean;
|
|
||||||
TransLen : word;
|
TransLen : word;
|
||||||
TransType : TFieldType;
|
TransType : TFieldType;
|
||||||
FD : TFieldDef;
|
FD : TFieldDef;
|
||||||
@ -646,7 +623,7 @@ begin
|
|||||||
for x := 0 to SQLDA^.SQLD - 1 do
|
for x := 0 to SQLDA^.SQLD - 1 do
|
||||||
begin
|
begin
|
||||||
TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
|
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,
|
FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].AliasName, TransType,
|
||||||
TransLen, False, (x + 1));
|
TransLen, False, (x + 1));
|
||||||
if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
|
if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
|
||||||
@ -854,7 +831,7 @@ begin
|
|||||||
PChar(Buffer + VarCharLen)^ := #0;
|
PChar(Buffer + VarCharLen)^ := #0;
|
||||||
end;
|
end;
|
||||||
ftFloat :
|
ftFloat :
|
||||||
GetFloat(CurrBuff, Buffer, FieldDef);
|
GetFloat(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLLen);
|
||||||
ftBlob : begin // load the BlobIb in field's buffer
|
ftBlob : begin // load the BlobIb in field's buffer
|
||||||
FillByte(buffer^,sizeof(TBufBlobField),0);
|
FillByte(buffer^,sizeof(TBufBlobField),0);
|
||||||
Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
|
Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
|
||||||
@ -1066,13 +1043,13 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
|
procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Size : byte);
|
||||||
var
|
var
|
||||||
Ext : extended;
|
Ext : extended;
|
||||||
Dbl : double;
|
Dbl : double;
|
||||||
Sin : single;
|
Sin : single;
|
||||||
begin
|
begin
|
||||||
case Field.Size of
|
case Size of
|
||||||
4 :
|
4 :
|
||||||
begin
|
begin
|
||||||
Move(CurrBuff^, Sin, 4);
|
Move(CurrBuff^, Sin, 4);
|
||||||
|
Loading…
Reference in New Issue
Block a user