From 012392381c7e6b73f9b69f7116c0f4ae6a2fceb8 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 23 Mar 2005 08:17:51 +0000 Subject: [PATCH] + 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 --- fcl/db/fields.inc | 19 ++++-- fcl/db/sqldb/interbase/ibconnection.pp | 94 ++++++++++++++++++++++++-- fcl/db/sqldb/sqldb.pp | 28 ++++++-- 3 files changed, 122 insertions(+), 19 deletions(-) diff --git a/fcl/db/fields.inc b/fcl/db/fields.inc index 006df0adce..9c2b5c8b88 100644 --- a/fcl/db/fields.inc +++ b/fcl/db/fields.inc @@ -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 diff --git a/fcl/db/sqldb/interbase/ibconnection.pp b/fcl/db/sqldb/interbase/ibconnection.pp index 25264d5e49..eaa3964361 100644 --- a/fcl/db/sqldb/interbase/ibconnection.pp +++ b/fcl/db/sqldb/interbase/ibconnection.pp @@ -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. diff --git a/fcl/db/sqldb/sqldb.pp b/fcl/db/sqldb/sqldb.pp index c3129d744b..9dc161c947 100644 --- a/fcl/db/sqldb/sqldb.pp +++ b/fcl/db/sqldb/sqldb.pp @@ -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