+ 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:
michael 2005-03-23 08:17:51 +00:00
parent 2a9658aa6c
commit 012392381c
3 changed files with 122 additions and 19 deletions

View File

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

View File

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

View File

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