mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 05:11:34 +01:00 
			
		
		
		
	+ 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
This commit is contained in:
		
							parent
							
								
									2a9658aa6c
								
							
						
					
					
						commit
						012392381c
					
				| @ -2085,12 +2085,7 @@ Var I : longint; | |||||||
| 
 | 
 | ||||||
| begin | begin | ||||||
|   If FindField(Value)<>Nil then |   If FindField(Value)<>Nil then | ||||||
|     begin |     DataBaseErrorFmt(SDuplicateFieldName,[Value],FDataset); | ||||||
|     S:=UpperCase(Value); |  | ||||||
|     For I:=0 To FFieldList.Count-1 do |  | ||||||
|       If S=UpperCase(TField(FFieldList[i]).FieldName) Then |  | ||||||
|         DataBaseErrorFmt(SDuplicateFieldName,[Value],FDataset); |  | ||||||
|     end; |  | ||||||
| end; | end; | ||||||
| 
 | 
 | ||||||
| Procedure TFields.CheckFieldNames (Const Value : String); | Procedure TFields.CheckFieldNames (Const Value : String); | ||||||
| @ -2190,7 +2185,17 @@ end; | |||||||
| 
 | 
 | ||||||
| { | { | ||||||
|   $Log$ |   $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 |     * Patch from Luiz Americo | ||||||
|       - fixes a memory leak in TBlobField.GetAsString |       - fixes a memory leak in TBlobField.GetAsString | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -56,6 +56,7 @@ type | |||||||
|     procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer); |     procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer); | ||||||
|     procedure GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef); |     procedure GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef); | ||||||
|     procedure CheckError(ProcName : string; Status : array of ISC_STATUS); |     procedure CheckError(ProcName : string; Status : array of ISC_STATUS); | ||||||
|  |     function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt; | ||||||
|   protected |   protected | ||||||
|     procedure DoInternalConnect; override; |     procedure DoInternalConnect; override; | ||||||
|     procedure DoInternalDisconnect; override; |     procedure DoInternalDisconnect; override; | ||||||
| @ -79,6 +80,8 @@ type | |||||||
|     procedure RollBackRetaining(trans : TSQLHandle); override; |     procedure RollBackRetaining(trans : TSQLHandle); override; | ||||||
|     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override; |     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override; | ||||||
|     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override; |     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override; | ||||||
|  |     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; | ||||||
|  | 
 | ||||||
|   published |   published | ||||||
|     property Dialect  : integer read FDialect write FDialect; |     property Dialect  : integer read FDialect write FDialect; | ||||||
|     property DatabaseName; |     property DatabaseName; | ||||||
| @ -317,7 +320,7 @@ 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; |     LensSet := True; | ||||||
|     TrLen := SQLScale; |     TrLen := SQLLen; | ||||||
|     TrType := ftBCD |     TrType := ftBCD | ||||||
|     end |     end | ||||||
|   else case (SQLType and not 1) of |   else case (SQLType and not 1) of | ||||||
| @ -364,13 +367,13 @@ begin | |||||||
|     SQL_DOUBLE : |     SQL_DOUBLE : | ||||||
|       begin |       begin | ||||||
|         LensSet := True; |         LensSet := True; | ||||||
|         TrLen := 0; |         TrLen := SQLLen; | ||||||
|         TrType := ftFloat; |         TrType := ftFloat; | ||||||
|       end; |       end; | ||||||
|     SQL_FLOAT : |     SQL_FLOAT : | ||||||
|       begin |       begin | ||||||
|         LensSet := True; |         LensSet := True; | ||||||
|         TrLen := 0; |         TrLen := SQLLen; | ||||||
|         TrType := ftFloat; |         TrType := ftFloat; | ||||||
|       end |       end | ||||||
|     else |     else | ||||||
| @ -488,7 +491,7 @@ begin | |||||||
|       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); |         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)); |          TransLen, False, (x + 1)); | ||||||
|       if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen; |       if TransType = ftBCD then FD.precision := SQLDA^.SQLVar[x].SQLLen; | ||||||
|       FD.DisplayName := SQLDA^.SQLVar[x].AliasName; |       FD.DisplayName := SQLDA^.SQLVar[x].AliasName; | ||||||
| @ -570,8 +573,12 @@ begin | |||||||
|         ftLargeint : |         ftLargeint : | ||||||
|           begin |           begin | ||||||
|             li := 0; |             li := 0; | ||||||
|             Move(li, Buffer^, sizeof(largeint)); |             Move(CurrBuff^, li, SQLDA^.SQLVar[x].SQLLen); | ||||||
|             Move(CurrBuff^, Buffer^, 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; |           end; | ||||||
|         ftDate, ftTime, ftDateTime: |         ftDate, ftTime, ftDateTime: | ||||||
|           GetDateTime(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLType); |           GetDateTime(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLType); | ||||||
| @ -581,7 +588,13 @@ begin | |||||||
|             PChar(Buffer + VarCharLen)^ := #0; |             PChar(Buffer + VarCharLen)^ := #0; | ||||||
|           end; |           end; | ||||||
|         ftFloat   : |         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; |       else result := false; | ||||||
|       end; |       end; | ||||||
|       end; |       end; | ||||||
| @ -758,5 +771,72 @@ begin | |||||||
|   Move(Dbl, Buffer^, 8); |   Move(Dbl, Buffer^, 8); | ||||||
| end; | 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. | end. | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -86,6 +86,7 @@ type | |||||||
|     procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract; |     procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract; | ||||||
|     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual; |     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual; | ||||||
|     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual; |     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual; | ||||||
|  |     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;abstract; | ||||||
|   public |   public | ||||||
|     property Handle: Pointer read GetHandle; |     property Handle: Pointer read GetHandle; | ||||||
|     destructor Destroy; override; |     destructor Destroy; override; | ||||||
| @ -179,6 +180,7 @@ type | |||||||
|     constructor Create(AOwner : TComponent); override; |     constructor Create(AOwner : TComponent); override; | ||||||
|     destructor Destroy; override; |     destructor Destroy; override; | ||||||
|     procedure SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string); virtual; |     procedure SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string); virtual; | ||||||
|  |     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; | ||||||
|   published |   published | ||||||
|     // redeclared data set properties |     // redeclared data set properties | ||||||
|     property Active; |     property Active; | ||||||
| @ -426,7 +428,7 @@ begin | |||||||
| 
 | 
 | ||||||
|   Buf := ''; |   Buf := ''; | ||||||
|   for x := 0 to FSQL.Count - 1 do |   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 |   if Buf='' then | ||||||
|     begin |     begin | ||||||
| @ -617,9 +619,10 @@ begin | |||||||
|             if ixPrimary in indexdefs[tel].options then |             if ixPrimary in indexdefs[tel].options then | ||||||
|               begin |               begin | ||||||
|               // Todo: If there is more then one field in the key, that must be parsed |               // Todo: If there is more then one field in the key, that must be parsed | ||||||
|               s := indexdefs[tel].fields; |                 s := indexdefs[tel].fields; | ||||||
|               F := fieldbyname(s); |                 F := Findfield(s); | ||||||
|               F.ProviderFlags := F.ProviderFlags + [pfInKey]; |                 if F <> nil then | ||||||
|  |                   F.ProviderFlags := F.ProviderFlags + [pfInKey]; | ||||||
|               end; |               end; | ||||||
|             end; |             end; | ||||||
|           end; |           end; | ||||||
| @ -883,11 +886,26 @@ begin | |||||||
| end; | end; | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
|  | function TSQLQuery.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; | ||||||
|  | begin | ||||||
|  |   result := (DataBase as tsqlconnection).CreateBlobStream(Field, Mode); | ||||||
|  | end; | ||||||
|  | 
 | ||||||
| end. | end. | ||||||
| 
 | 
 | ||||||
| { | { | ||||||
|   $Log$ |   $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 |     * truncate log | ||||||
| 
 | 
 | ||||||
|   Revision 1.13  2005/02/07 11:23:41  joost |   Revision 1.13  2005/02/07 11:23:41  joost | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 michael
						michael