+ Patch from Bram Kuijvenhoven to implement blob field and more verbose errors

git-svn-id: trunk@3458 -

fcl/db/sqldb/odbc/odbcconn.pas

@@ -31,6 +31,7 @@ type
     FQuery:string;        // last prepared query, with :ParamName converted to ?
     FParamIndex:TParamBinding; // maps the i-th parameter in the query to the TParams passed to PrepareStatement
     FParamBuf:array of pointer; // buffers that can be used to bind the i-th parameter in the query
+    FBlobStreams:TList;   // list of Blob TMemoryStreams stored in field buffers (we need this currently as we can't hook into the freeing of TBufDataset buffers)
   public
     constructor Create(Connection:TODBCConnection);
     destructor Destroy; override;
@@ -126,7 +127,7 @@ type
 implementation
 
 uses
-  Math; // for the Min proc
+  Math, DBConst;
 
 const
   DefaultEnvironment:TODBCEnvironment = nil;
@@ -351,7 +352,8 @@ var
   OutConnectionString:string;
   ActualLength:SQLSMALLINT;
 begin
-  inherited DoInternalConnect;
+  // Do not call the inherited method as it checks for a non-empty DatabaseName, and we don't even use DatabaseName!
+  // inherited DoInternalConnect;
 
   // make sure we have an environment
   if not Assigned(FEnvironment) then
@@ -382,7 +384,7 @@ begin
     SQL_HANDLE_DBC,FDBCHandle,Format('Could not connect with connection string "%s".',[ConnectionString])
   );
 
-// commented out as the OutConenctionString is not used further at the moment
+// commented out as the OutConnectionString is not used further at the moment
 //  if ActualLength<BufferLength-1 then
 //    SetLength(OutConnectionString,ActualLength); // fix completed connection string length
 
@@ -520,6 +522,8 @@ begin
 end;
 
 function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer): boolean;
+const
+  DEFAULT_BLOB_BUFFER_SIZE = 1024;
 var
   ODBCCursor:TODBCCursor;
   StrLenOrInd:SQLINTEGER;
@@ -527,6 +531,9 @@ var
   ODBCTimeStruct:SQL_TIME_STRUCT;
   ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
   DateTime:TDateTime;
+  BlobBuffer:pointer;
+  BlobBufferSize,BytesRead:SQLINTEGER;
+  BlobMemoryStream:TMemoryStream;
   Res:SQLRETURN;
 begin
   ODBCCursor:=cursor as TODBCCursor;
@@ -578,27 +585,86 @@ begin
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
     ftVarBytes:           // mapped to TVarBytesField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
+    ftBlob, ftMemo:       // BLOBs
+    begin
+      // Try to discover BLOB data length
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, 0, @StrLenOrInd);
+      ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get field data for field ''%s'' (index %d).',[FieldDef.Name, FieldDef.Index+1]));
+      // Read the data if not NULL
+      if StrLenOrInd<>SQL_NULL_DATA then
+      begin
+        // Determine size of buffer to use
+        if StrLenOrInd<>SQL_NO_TOTAL then
+          BlobBufferSize:=StrLenOrInd
+        else
+          BlobBufferSize:=DEFAULT_BLOB_BUFFER_SIZE;
+        try
+          // Allocate the buffer and memorystream
+          BlobBuffer:=GetMem(BlobBufferSize);
+          BlobMemoryStream:=TMemoryStream.Create;
+          if BlobBufferSize>0 then
+          begin
+            // Retrieve data in parts (or effectively in one part if StrLenOrInd<>SQL_NO_TOTAL above)
+            repeat
+              Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, BlobBuffer, BlobBufferSize, @StrLenOrInd);
+              ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get field data for field ''%s'' (index %d).',[FieldDef.Name, FieldDef.Index+1]));
+              // Append data in buffer to memorystream
+              if (StrLenOrInd=SQL_NO_TOTAL) or (StrLenOrInd>BlobBufferSize) then
+                BytesRead:=BlobBufferSize
+              else
+                BytesRead:=StrLenOrInd;
+              BlobMemoryStream.Write(BlobBuffer^, BytesRead);
+            until Res=SQL_SUCCESS;
+          end;
+          // Store memorystream pointer in Field buffer and in the cursor's FBlobStreams list
+          TObject(buffer^):=BlobMemoryStream;
+          ODBCCursor.FBlobStreams.Add(BlobMemoryStream);
+          // Set BlobMemoryStream to nil, so it won't get freed in the finally block below
+          BlobMemoryStream:=nil;
+        finally
+          BlobMemoryStream.Free;
+          Freemem(BlobBuffer,BlobBufferSize);
+        end;
+      end;
+    end;
     // TODO: Loading of other field types
   else
     raise EODBCException.CreateFmt('Tried to load field of unsupported field type %s',[Fieldtypenames[FieldDef.DataType]]);
   end;
-  ODBCCheckResult(Res,SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get field data for field ''%s'' (index %d).',[FieldDef.Name, FieldDef.Index+1]));
+  ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get field data for field ''%s'' (index %d).',[FieldDef.Name, FieldDef.Index+1]));
   Result:=StrLenOrInd<>SQL_NULL_DATA; // Result indicates whether the value is non-null
 
 //  writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
 end;
 
 function TODBCConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
+var
+  ODBCCursor: TODBCCursor;
+  BlobMemoryStream, BlobMemoryStreamCopy: TMemoryStream;
 begin
   // TODO: implement TODBCConnection.CreateBlobStream
-  Result:=nil;
+  if Mode=bmRead then
+  begin
+    Field.GetData(@BlobMemoryStream);
+    BlobMemoryStreamCopy:=TMemoryStream.Create;
+    BlobMemoryStreamCopy.LoadFromStream(BlobMemoryStream);
+    Result:=BlobMemoryStreamCopy;
+  end
+  else
+    Result:=nil;
 end;
 
 procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);
 var
   ODBCCursor:TODBCCursor;
+  i: integer;
 begin
   ODBCCursor:=cursor as TODBCCursor;
+  
+  // Free TMemoryStreams in cursor.FBlobStreams and clear it
+  for i:=0 to ODBCCursor.FBlobStreams.Count-1 do
+    TObject(ODBCCursor.FBlobStreams[i]).Free;
+  ODBCCursor.FBlobStreams.Clear;
 
   ODBCCheckResult(
     SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE),
@@ -608,14 +674,15 @@ end;
 
 procedure TODBCConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
 const
-  ColNameDefaultLength = 40; // should be > 0, because an ansistring of length 0 is a nil pointer instead of a pointer to a #0
+  ColNameDefaultLength  = 40; // should be > 0, because an ansistring of length 0 is a nil pointer instead of a pointer to a #0
+  TypeNameDefaultLength = 80; // idem
 var
   ODBCCursor:TODBCCursor;
   ColumnCount:SQLSMALLINT;
   i:integer;
-  ColNameLength,DataType,DecimalDigits,Nullable:SQLSMALLINT;
+  ColNameLength,TypeNameLength,DataType,DecimalDigits,Nullable:SQLSMALLINT;
   ColumnSize:SQLUINTEGER;
-  ColName:string;
+  ColName,TypeName:string;
   FieldType:TFieldType;
   FieldSize:word;
 begin
@@ -668,10 +735,10 @@ begin
     case DataType of
       SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize+1; end;
       SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize+1; end;
-      SQL_LONGVARCHAR:   begin FieldType:=ftString;     FieldSize:=ColumnSize+1; end; // no fixed maximum length; make ftMemo when blobs are supported
+      SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=sizeof(pointer); end; // is a blob
       SQL_WCHAR:         begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end;
       SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end;
-      SQL_WLONGVARCHAR:  begin FieldType:=ftWideString; FieldSize:=ColumnSize+1; end; // no fixed maximum length; make ftMemo when blobs are supported
+      SQL_WLONGVARCHAR:  begin FieldType:=ftMemo;       FieldSize:=sizeof(pointer); end; // is a blob
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_NUMERIC:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_SMALLINT:      begin FieldType:=ftSmallint;   FieldSize:=0; end;
@@ -684,12 +751,12 @@ begin
       SQL_BIGINT:        begin FieldType:=ftLargeint;   FieldSize:=0; end;
       SQL_BINARY:        begin FieldType:=ftBytes;      FieldSize:=ColumnSize; end;
       SQL_VARBINARY:     begin FieldType:=ftVarBytes;   FieldSize:=ColumnSize; end;
-      SQL_LONGVARBINARY: begin FieldType:=ftBlob;       FieldSize:=ColumnSize; end;
+      SQL_LONGVARBINARY: begin FieldType:=ftBlob;       FieldSize:=sizeof(pointer); end; // is a blob
       SQL_TYPE_DATE:     begin FieldType:=ftDate;       FieldSize:=0; end;
       SQL_TYPE_TIME:     begin FieldType:=ftTime;       FieldSize:=0; end;
       SQL_TYPE_TIMESTAMP:begin FieldType:=ftDateTime;   FieldSize:=0; end;
 {      SQL_TYPE_UTCDATETIME:FieldType:=ftUnknown;}
-{      SQL_TYPE_UTCTIME:   FieldType:=ftUnknown; }
+{      SQL_TYPE_UTCTIME:    FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MONTH:           FieldType:=ftUnknown;}
 {      SQL_INTERVAL_YEAR:            FieldType:=ftUnknown;}
 {      SQL_INTERVAL_YEAR_TO_MONTH:   FieldType:=ftUnknown;}
@@ -707,12 +774,48 @@ begin
     else
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
     end;
-    
+
     if (FieldType in [ftString,ftFixedChar]) and // field types mapped to TStringField
        (FieldSize >= dsMaxStringSize) then
     begin
       FieldSize:=dsMaxStringSize-1;
     end;
+    
+    if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
+    begin
+      SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness
+      
+      ODBCCheckResult(
+        SQLColAttribute(ODBCCursor.FSTMTHandle,  // statement handle
+                        i,                       // column number
+                        SQL_DESC_TYPE_NAME,      // FieldIdentifier indicating the datasource dependent data type name (useful for diagnostics)
+                        @(TypeName[1]),          // default buffer
+                        TypeNameDefaultLength+1, // and its length; we include the #0 terminating any ansistring of Length > 0 in the buffer
+                        @TypeNameLength,         // actual type name length
+                        nil                      // no need for a pointer to return a numeric attribute at
+        ),
+        SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get datasource dependent type name for column %s.',[ColName])
+      );
+      // truncate buffer or make buffer long enough for entire column name (note: the call is the same for both cases!)
+      SetLength(TypeName,TypeNameLength);
+      // check whether entire column name was returned
+      if TypeNameLength>TypeNameDefaultLength then
+      begin
+        // request column name with buffer that is long enough
+        ODBCCheckResult(
+          SQLColAttribute(ODBCCursor.FSTMTHandle, // statement handle
+                        i,                        // column number
+                        SQL_DESC_TYPE_NAME,       // FieldIdentifier indicating the datasource dependent data type name (useful for diagnostics)
+                        @(TypeName[1]),           // buffer
+                        TypeNameLength+1,         // buffer size
+                        @TypeNameLength,          // actual length
+                        nil),                     // no need for a pointer to return a numeric attribute at
+          SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get datasource dependent type name for column %s.',[ColName])
+        );
+      end;
+
+      DatabaseErrorFmt('Column %s has an unknown or unsupported column type. Datasource dependent type name: %s. ODBC SQL data type code: %d.', [ColName, TypeName, DataType]);
+    end;
 
     // add FieldDef
     TFieldDef.Create(FieldDefs, ColName, FieldType, FieldSize, False, i);
@@ -773,6 +876,9 @@ begin
     SQLAllocHandle(SQL_HANDLE_STMT, Connection.FDBCHandle, FSTMTHandle),
     SQL_HANDLE_DBC, Connection.FDBCHandle, 'Could not allocate ODBC Statement handle.'
   );
+  
+  // allocate FBlobStreams
+  FBlobStreams:=TList.Create;
 end;
 
 destructor TODBCCursor.Destroy;
@@ -780,6 +886,8 @@ var
   Res:SQLRETURN;
 begin
   inherited Destroy;
+  
+  FBlobStreams.Free;
 
   if FSTMTHandle<>SQL_INVALID_HANDLE then
   begin

packages/base/odbc/odbcsql.inc

@@ -964,10 +964,38 @@ const
 {$ifdef ODBCVER3}
   SQL_COLUMN_DRIVER_START        = 1000;
 {$endif} { ODBCVER >= 0x0300 }
-  SQL_DESC_AUTO_UNIQUE_VALUE     = SQL_COLUMN_AUTO_INCREMENT;
-  SQL_DESC_BASE_COLUMN_NAME        = 22;
-  SQL_DESC_BASE_TABLE_NAME         = 23;
-  SQL_DESC_TABLE_NAME              = SQL_COLUMN_TABLE_NAME;
+
+ { SQLColAttribute defines }
+{$ifdef ODBCVER3}
+  SQL_DESC_ARRAY_SIZE	     = 20;
+  SQL_DESC_ARRAY_STATUS_PTR  = 21;
+  SQL_DESC_AUTO_UNIQUE_VALUE = SQL_COLUMN_AUTO_INCREMENT;
+  SQL_DESC_BASE_COLUMN_NAME  = 22;
+  SQL_DESC_BASE_TABLE_NAME   = 23;
+  SQL_DESC_BIND_OFFSET_PTR   = 24;
+  SQL_DESC_BIND_TYPE         = 25;
+  SQL_DESC_CASE_SENSITIVE    = SQL_COLUMN_CASE_SENSITIVE;
+  SQL_DESC_CATALOG_NAME      = SQL_COLUMN_QUALIFIER_NAME;
+  SQL_DESC_CONCISE_TYPE      = SQL_COLUMN_TYPE;
+  SQL_DESC_DATETIME_INTERVAL_PRECISION = 26;
+  SQL_DESC_DISPLAY_SIZE      = SQL_COLUMN_DISPLAY_SIZE;
+  SQL_DESC_FIXED_PREC_SCALE  = SQL_COLUMN_MONEY;
+  SQL_DESC_LABEL             = SQL_COLUMN_LABEL;
+  SQL_DESC_LITERAL_PREFIX    = 27;
+  SQL_DESC_LITERAL_SUFFIX    = 28;
+  SQL_DESC_LOCAL_TYPE_NAME   = 29;
+  SQL_DESC_MAXIMUM_SCALE     = 30;
+  SQL_DESC_MINIMUM_SCALE     = 31;
+  SQL_DESC_NUM_PREC_RADIX    = 32;
+  SQL_DESC_PARAMETER_TYPE    = 33;
+  SQL_DESC_ROWS_PROCESSED_PTR = 34;
+  SQL_DESC_SCHEMA_NAME       = SQL_COLUMN_OWNER_NAME;
+  SQL_DESC_SEARCHABLE        = SQL_COLUMN_SEARCHABLE;
+  SQL_DESC_TYPE_NAME         = SQL_COLUMN_TYPE_NAME;
+  SQL_DESC_TABLE_NAME        = SQL_COLUMN_TABLE_NAME;
+  SQL_DESC_UNSIGNED          = SQL_COLUMN_UNSIGNED;
+  SQL_DESC_UPDATABLE         = SQL_COLUMN_UPDATABLE;
+{$endif}
 
 //* SQLEndTran() options */
   SQL_COMMIT    = 0;