Browse Source

+ 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

michael 20 years ago
parent
commit
012392381c
3 changed files with 122 additions and 19 deletions
  1. 12 7
      fcl/db/fields.inc
  2. 87 7
      fcl/db/sqldb/interbase/ibconnection.pp
  3. 23 5
      fcl/db/sqldb/sqldb.pp

+ 12 - 7
fcl/db/fields.inc

@@ -2085,12 +2085,7 @@ Var I : longint;
 
 
 begin
 begin
   If FindField(Value)<>Nil then
   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;
 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
 
 

+ 87 - 7
fcl/db/sqldb/interbase/ibconnection.pp

@@ -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^, 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;
           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.
 
 

+ 23 - 5
fcl/db/sqldb/sqldb.pp

@@ -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;
-              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;
             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