mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 20:59:42 +02:00
+ Patch from Bram Kuijvenhoven to implement blob field and more verbose errors
git-svn-id: trunk@3458 -
This commit is contained in:
michael
parent
ab1660c9c2
commit
c8fb11776d
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user