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

+ Several patches from Jose A. Rimon

Browse Source 
# Prevents "field not found" error, when use a query without the primary key
Set SQLlen of different data types
 Use AliasName instead of SQLname to avoid "duplicate field name" error, for
example when using "coalesce" more than once
use SQLScale in ftLargeInt to get actual values
 Send query to server with different lines. Provides line info in sqlErrors
and allows single line comments
This commit is contained in:
michael 2005-03-23 08:17:51 +00:00
parent 2a9658aa6c
commit 012392381c
3 changed files with 122 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
fcl/db/fields.inc
View File

@ -2085,12 +2085,7 @@ Var I : longint;
begin
If FindField(Value)<>Nil then
begin
S:=UpperCase(Value);
For I:=0 To FFieldList.Count-1 do
If S=UpperCase(TField(FFieldList[i]).FieldName) Then
DataBaseErrorFmt(SDuplicateFieldName,[Value],FDataset);
end;
DataBaseErrorFmt(SDuplicateFieldName,[Value],FDataset);
end;
Procedure TFields.CheckFieldNames (Const Value : String);
@ -2190,7 +2185,17 @@ end;
{
$Log$
Revision 1.27 2005-03-15 22:44:22 michael
Revision 1.28 2005-03-23 08:17:51 michael
+ Several patches from Jose A. Rimon
# Prevents "field not found" error, when use a query without the primary key
Set SQLlen of different data types
Use AliasName instead of SQLname to avoid "duplicate field name" error, for
example when using "coalesce" more than once
use SQLScale in ftLargeInt to get actual values
Send query to server with different lines. Provides line info in sqlErrors
and allows single line comments
Revision 1.27 2005/03/15 22:44:22 michael
* Patch from Luiz Americo
- fixes a memory leak in TBlobField.GetAsString

94
fcl/db/sqldb/interbase/ibconnection.pp
View File

@ -56,6 +56,7 @@ type
procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
procedure GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
procedure CheckError(ProcName : string; Status : array of ISC_STATUS);
function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
protected
procedure DoInternalConnect; override;
procedure DoInternalDisconnect; override;
@ -79,6 +80,8 @@ type
procedure RollBackRetaining(trans : TSQLHandle); override;
procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
published
property Dialect : integer read FDialect write FDialect;
property DatabaseName;
@ -317,7 +320,7 @@ begin
if (SQLScale >= -4) and (SQLScale <= -1) then //in [-4..-1] then
begin
LensSet := True;
TrLen := SQLScale;
TrLen := SQLLen;
TrType := ftBCD
end
else case (SQLType and not 1) of
@ -364,13 +367,13 @@ begin
SQL_DOUBLE :
begin
LensSet := True;
TrLen := 0;
TrLen := SQLLen;
TrType := ftFloat;
end;
SQL_FLOAT :
begin
LensSet := True;
TrLen := 0;
TrLen := SQLLen;
TrType := ftFloat;
end
else
@ -488,7 +491,7 @@ begin
begin
TranslateFldType(SQLDA^.SQLVar[x].SQLType, SQLDA^.SQLVar[x].SQLLen, SQLDA^.SQLVar[x].SQLScale,
lenset, TransType, TransLen);
FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].SQLName, TransType,
FD := TFieldDef.Create(FieldDefs, SQLDA^.SQLVar[x].AliasName, TransType,
TransLen, False, (x + 1));
if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen;
FD.DisplayName := SQLDA^.SQLVar[x].AliasName;
@ -570,8 +573,12 @@ begin
ftLargeint :
begin
li := 0;
Move(li, Buffer^, sizeof(largeint));
Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
Move(CurrBuff^, li, SQLDA^.SQLVar[x].SQLLen);
if SQLDA^.SQLVar[x].SQLScale > 0 then
li := li * trunc(intpower(10, SQLDA^.SQLVar[x].SQLScale))
else if SQLDA^.SQLVar[x].SQLScale < 0 then
li := li div trunc(intpower(10, -SQLDA^.SQLVar[x].SQLScale));
Move(li, Buffer^, SQLDA^.SQLVar[x].SQLLen);
end;
ftDate, ftTime, ftDateTime:
GetDateTime(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLType);
@ -581,7 +588,13 @@ begin
PChar(Buffer + VarCharLen)^ := #0;
end;
ftFloat :
GetFloat(CurrBuff, Buffer, FieldDef)
GetFloat(CurrBuff, Buffer, FieldDef);
ftBlob : begin // load the BlobIb in field's buffer
li := 0;
Move(li, Buffer^, sizeof(largeint));
Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen);
end
else result := false;
end;
end;
@ -758,5 +771,72 @@ begin
Move(Dbl, Buffer^, 8);
end;
function TIBConnection.getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
var
iscInfoBlobMaxSegment : byte = isc_info_blob_max_segment;
blobInfo : array[0..50] of byte;
begin
if isc_blob_info(@Fstatus, @blobHandle, sizeof(iscInfoBlobMaxSegment), @iscInfoBlobMaxSegment, sizeof(blobInfo) - 2, @blobInfo) <> 0 then
CheckError('isc_blob_info', FStatus);
if blobInfo[0] = isc_info_blob_max_segment then
begin
result := isc_vax_integer(pchar(@blobInfo[3]), isc_vax_integer(pchar(@blobInfo[1]), 2));
end
else
CheckError('isc_blob_info', FStatus);
end;
function TIBConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
const
isc_segstr_eof = 335544367; // It's not defined in ibase60 but in ibase40. Would it be better to define in ibase60?
var
mStream : TMemoryStream;
blobHandle : Isc_blob_Handle;
blobSegment : pointer;
blobSegLen : smallint;
maxBlobSize : longInt;
TransactionHandle : pointer;
blobId : ISC_QUAD;
begin
result := nil;
if mode = bmRead then begin
if not field.getData(@blobId) then
exit;
TransactionHandle := transaction.Handle;
blobHandle := nil;
if isc_open_blob(@FStatus, @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, @blobId) <> 0 then
CheckError('TIBConnection.CreateBlobStream', FStatus);
maxBlobSize := getMaxBlobSize(blobHandle);
blobSegment := AllocMem(maxBlobSize);
mStream := TMemoryStream.create;
while (isc_get_segment(@FStatus, @blobHandle, @blobSegLen, maxBlobSize, blobSegment) = 0) do begin
mStream.writeBuffer(blobSegment^, blobSegLen);
end;
freemem(blobSegment);
mStream.seek(0,soFromBeginning);
if FStatus[1] = isc_segstr_eof then
begin
if isc_close_blob(@FStatus, @blobHandle) <> 0 then
CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
end
else
CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
result := mStream;
end;
end;
end.

28
fcl/db/sqldb/sqldb.pp
View File

@ -86,6 +86,7 @@ type
procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;abstract;
public
property Handle: Pointer read GetHandle;
destructor Destroy; override;
@ -179,6 +180,7 @@ type
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string); virtual;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
published
// redeclared data set properties
property Active;
@ -426,7 +428,7 @@ begin
Buf := '';
for x := 0 to FSQL.Count - 1 do
Buf := Buf + FSQL[x] + ' ';
Buf := Buf + FSQL[x] + ' '#10; // multiline SQl. Provides line info in sqlErrors and allows single line comments
if Buf='' then
begin
@ -617,9 +619,10 @@ begin
if ixPrimary in indexdefs[tel].options then
begin
// Todo: If there is more then one field in the key, that must be parsed
s := indexdefs[tel].fields;
F := fieldbyname(s);
F.ProviderFlags := F.ProviderFlags + [pfInKey];
s := indexdefs[tel].fields;
F := Findfield(s);
if F <> nil then
F.ProviderFlags := F.ProviderFlags + [pfInKey];
end;
end;
end;
@ -883,11 +886,26 @@ begin
end;
function TSQLQuery.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
begin
result := (DataBase as tsqlconnection).CreateBlobStream(Field, Mode);
end;
end.
{
$Log$
Revision 1.14 2005-02-14 17:13:12 peter
Revision 1.15 2005-03-23 08:17:51 michael
+ Several patches from Jose A. Rimon
# Prevents "field not found" error, when use a query without the primary key
Set SQLlen of different data types
Use AliasName instead of SQLname to avoid "duplicate field name" error, for
example when using "coalesce" more than once
use SQLScale in ftLargeInt to get actual values
Send query to server with different lines. Provides line info in sqlErrors
and allows single line comments
Revision 1.14 2005/02/14 17:13:12 peter
* truncate log
Revision 1.13 2005/02/07 11:23:41 joost