ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/3.0/FB30Attachment.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/3.0/FB30Attachment.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 359 by tony, Tue Dec 7 09:37:32 2021 UTC

# Line 37 | Line 37 | unit FB30Attachment;
37   interface
38  
39   uses
40 <  Classes, SysUtils, FBAttachment, FB30ClientAPI, Firebird, IB, FBActivityMonitor, FBParamBlock;
40 >  Classes, SysUtils, FBAttachment, FBClientAPI, FB30ClientAPI, Firebird, IB,
41 >  FBActivityMonitor, FBParamBlock;
42  
43   type
44  
# Line 47 | Line 48 | type
48    private
49      FAttachmentIntf: Firebird.IAttachment;
50      FFirebird30ClientAPI: TFB30ClientAPI;
51 +    FTimeZoneServices: ITimeZoneServices;
52 +    FUsingRemoteICU: boolean;
53 +    procedure SetUseRemoteICU(aValue: boolean);
54    protected
55      procedure CheckHandle; override;
56    public
# Line 70 | Line 74 | type
74      function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
75      function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
76      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
77 <    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
77 >    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
78      function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
79 <                       aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
79 >                       aSQLDialect: integer; GenerateParamNames: boolean=false;
80 >                       CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
81  
82      {Events}
83      function GetEventHandler(Events: TStrings): IEvents; override;
84  
85      {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
86  
87 <    function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
83 <    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
87 >    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
88      function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
85    function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
89      function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload; override;
90  
91      {Array}
92 <    function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
93 <    function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
91 <    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
92 >    function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
93 >    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
94      function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
95        columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
96        dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
97  
98  
99      {Database Information}
100 <    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
101 <    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
100 >    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
101 >    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
102 >    procedure getFBVersion(version: TStrings);
103 >    function HasDecFloatSupport: boolean; override;
104 >    function HasBatchMode: boolean; override;
105 >    function HasScollableCursors: boolean;
106 >
107 >    {Time Zone Support}
108 >    function GetTimeZoneServices: ITimeZoneServices; override;
109 >    function HasTimeZoneSupport: boolean; override;
110    end;
111  
112   implementation
113  
114   uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
115 <  FBOutputBlock, FB30Events, IBUtils;
115 >  FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
116 >
117 > type
118 >  { TVersionCallback }
119 >
120 >  TVersionCallback = class(Firebird.IVersionCallbackImpl)
121 >  private
122 >    FOutput: TStrings;
123 >    FFirebirdClientAPI: TFBClientAPI;
124 >  public
125 >    constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
126 >    procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
127 >  end;
128 >
129 > { TVersionCallback }
130 >
131 > constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
132 >  output: TStrings);
133 > begin
134 >  inherited Create;
135 >  FFirebirdClientAPI := FirebirdClientAPI;
136 >  FOutput := output;
137 > end;
138 >
139 > procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
140 > var StatusObj: TFB30StatusObject;
141 > begin
142 >  if ((status.getState and status.STATE_ERRORS) <> 0) then
143 >  begin
144 >    StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
145 >    try
146 >      raise EIBInterBaseError.Create(StatusObj);
147 >    finally
148 >      StatusObj.Free;
149 >    end;
150 >  end;
151 >  FOutput.Add(text);
152 > end;
153 >
154  
155   { TFB30Attachment }
156  
157 + procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
158 + begin
159 +  if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
160 +  begin
161 +    if aValue then
162 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
163 +    else
164 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
165 +    FUsingRemoteICU := aValue;
166 +  end;
167 + end;
168 +
169   procedure TFB30Attachment.CheckHandle;
170   begin
171    if FAttachmentIntf = nil then
# Line 211 | Line 271 | begin
271        FAttachmentIntf := nil
272      else
273        GetODSAndConnectionInfo;
274 +
275    end;
276   end;
277  
# Line 227 | Line 288 | begin
288        FHasDefaultCharSet := false;
289        FCodePage := CP_NONE;
290        FCharSetID := 0;
291 +      FTimeZoneServices := nil;
292      end;
293   end;
294  
# Line 274 | Line 336 | begin
336   end;
337  
338   function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
339 <  aSQLDialect: integer): IStatement;
339 >  aSQLDialect: integer; CursorName: AnsiString): IStatement;
340   begin
341    CheckHandle;
342 <  Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
342 >  Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
343   end;
344  
345   function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
346 <  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
346 >  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
347 >  CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
348   begin
349    CheckHandle;
350    Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
351 <         GenerateParamNames);
351 >         GenerateParamNames,CaseSensitiveParams,CursorName);
352   end;
353  
354   function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
# Line 294 | Line 357 | begin
357    Result := TFB30Events.Create(self,Events);
358   end;
359  
297 function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
298  ColumnName: AnsiString; BPB: IBPB): IBlob;
299 begin
300  CheckHandle;
301  Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
302              TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
303 end;
304
360   function TFB30Attachment.CreateBlob(transaction: ITransaction;
361    BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
362   begin
# Line 316 | Line 371 | begin
371    Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
372   end;
373  
319 function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
320  ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
321 begin
322  CheckHandle;
323  Result := TFB30Blob.Create(self,transaction as TFB30transaction,
324                TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
325                BlobID,BPB);
326 end;
327
374   function TFB30Attachment.OpenBlob(transaction: ITransaction;
375    BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
376   begin
# Line 332 | Line 378 | begin
378    Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
379   end;
380  
381 < function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
382 <  ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
337 < begin
338 <  CheckHandle;
339 <  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
340 <                    GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
341 < end;
342 <
343 < function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
344 <  ColumnName: AnsiString): IArray;
381 > function TFB30Attachment.OpenArray(transaction: ITransaction;
382 >  ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
383   begin
384    CheckHandle;
385    Result := TFB30Array.Create(self,transaction as TFB30Transaction,
386 <                    GetArrayMetaData(transaction,RelationName,ColumnName));
386 >                    ArrayMetaData,ArrayID);
387   end;
388  
389   function TFB30Attachment.CreateArray(transaction: ITransaction;
# Line 376 | Line 414 | begin
414    Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
415   end;
416  
417 + procedure TFB30Attachment.getFBVersion(version: TStrings);
418 + var bufferObj: TVersionCallback;
419 + begin
420 +  version.Clear;
421 +  bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
422 +  try
423 +    with FFirebird30ClientAPI do
424 +    begin
425 +       UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
426 +       Check4DataBaseError;
427 +    end;
428 +  finally
429 +    bufferObj.Free;
430 +  end;
431 + end;
432 +
433 + function TFB30Attachment.HasDecFloatSupport: boolean;
434 + begin
435 +  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
436 +   (GetODSMajorVersion >= 13);
437 + end;
438 +
439 + function TFB30Attachment.HasBatchMode: boolean;
440 + begin
441 +  Result := FFirebird30ClientAPI.Firebird4orLater and
442 +     (GetODSMajorVersion >= 13);
443 + end;
444 +
445 + function TFB30Attachment.HasScollableCursors: boolean;
446 + begin
447 +  Result := (GetODSMajorVersion >= 12);
448 + end;
449 +
450 + function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
451 + begin
452 +  if not HasTimeZoneSupport then
453 +    IBError(ibxeNotSupported,[]);
454 +
455 +  if FTimeZoneServices = nil then
456 +    FTimeZoneServices := TFB30TimeZoneServices.Create(self);
457 +  Result := FTimeZoneServices;
458 + end;
459 +
460 + function TFB30Attachment.HasTimeZoneSupport: boolean;
461 + begin
462 +  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
463 +   (GetODSMajorVersion >= 13);
464 + end;
465 +
466   end.
467  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines