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 117 by tony, Mon Jan 22 13:58:11 2018 UTC vs.
ibx/branches/journaling/fbintf/client/3.0/FB30Attachment.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 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 46 | Line 47 | type
47    TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
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 +    function GetAttachment: IAttachment; override;
57    public
58 <    constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
58 >    constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
59            RaiseExceptionOnConnectError: boolean);
60 <    constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
61 <    constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
60 >    constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
61 >    constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
62        RaiseExceptionOnError: boolean); overload;
63      destructor Destroy; override;
64 +    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
65 +      override;
66      property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
67 +    property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
68  
69    public
70      {IAttachment}
# Line 63 | Line 72 | type
72      procedure Disconnect(Force: boolean=false); override;
73      function IsConnected: boolean; override;
74      procedure DropDatabase;
75 <    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
76 <    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
75 >    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
76 >    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
77      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
78 <    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
78 >    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
79      function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
80 <                       aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
80 >                       aSQLDialect: integer; GenerateParamNames: boolean=false;
81 >                       CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
82  
83      {Events}
84      function GetEventHandler(Events: TStrings): IEvents; override;
85  
86      {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
87  
88 <    function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
79 <    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
88 >    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
89      function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
81 –    function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
90      function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload; override;
91  
92      {Array}
93 <    function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
94 <    function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
87 <    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
93 >    function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
94 >    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
95      function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
96        columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
97 <  dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
97 >      dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
98  
99  
100      {Database Information}
101 <    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
102 <    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
103 <    function GetDBInformation(Requests: array of byte): IDBInformation; overload; override;
104 <    function GetDBInformation(Request: byte): IDBInformation; overload; override;
101 >    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
102 >    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
103 >    procedure getFBVersion(version: TStrings);
104 >    function HasDecFloatSupport: boolean; override;
105 >    function HasBatchMode: boolean; override;
106 >    function HasScollableCursors: boolean;
107 >
108 >    {Time Zone Support}
109 >    function GetTimeZoneServices: ITimeZoneServices; override;
110 >    function HasTimeZoneSupport: boolean; override;
111    end;
112  
113   implementation
114  
115   uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
116 <  FBOutputBlock, FB30Events, IBUtils;
116 >  FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
117 >
118 > type
119 >  { TVersionCallback }
120 >
121 >  TVersionCallback = class(Firebird.IVersionCallbackImpl)
122 >  private
123 >    FOutput: TStrings;
124 >    FFirebirdClientAPI: TFBClientAPI;
125 >  public
126 >    constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
127 >    procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
128 >  end;
129 >
130 > { TVersionCallback }
131 >
132 > constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
133 >  output: TStrings);
134 > begin
135 >  inherited Create;
136 >  FFirebirdClientAPI := FirebirdClientAPI;
137 >  FOutput := output;
138 > end;
139 >
140 > procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
141 > var StatusObj: TFB30StatusObject;
142 > begin
143 >  if ((status.getState and status.STATE_ERRORS) <> 0) then
144 >  begin
145 >    StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
146 >    try
147 >      raise EIBInterBaseError.Create(StatusObj);
148 >    finally
149 >      StatusObj.Free;
150 >    end;
151 >  end;
152 >  FOutput.Add(text);
153 > end;
154 >
155  
156   { TFB30Attachment }
157  
158 + procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
159 + begin
160 +  if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
161 +  begin
162 +    if aValue then
163 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
164 +    else
165 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
166 +    FUsingRemoteICU := aValue;
167 +  end;
168 + end;
169 +
170   procedure TFB30Attachment.CheckHandle;
171   begin
172    if FAttachmentIntf = nil then
173      IBError(ibxeDatabaseClosed,[nil]);
174   end;
175  
176 < constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
176 > function TFB30Attachment.GetAttachment: IAttachment;
177 > begin
178 >  Result := self;
179 > end;
180 >
181 > constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
182    RaiseExceptionOnConnectError: boolean);
183   begin
184 +  FFirebird30ClientAPI := api;
185    if aDPB = nil then
186    begin
187      if RaiseExceptionOnConnectError then
188         IBError(ibxeNoDPB,[nil]);
189      Exit;
190    end;
191 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
191 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
192    Connect;
193   end;
194  
195 < constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
195 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
196    RaiseExceptionOnError: boolean);
197   var Param: IDPBItem;
198      sql: AnsiString;
199      IsCreateDB: boolean;
200   begin
201 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
201 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
202 >  FFirebird30ClientAPI := api;
203    IsCreateDB := true;
204    if aDPB <> nil then
205    begin
# Line 138 | Line 208 | begin
208        FSQLDialect := Param.AsByte;
209    end;
210    sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
211 <  with Firebird30ClientAPI do
211 >  with FFirebird30ClientAPI do
212    begin
213      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
214                                         PAnsiChar(sql),FSQLDialect,@IsCreateDB);
# Line 157 | Line 227 | begin
227    end;
228   end;
229  
230 < constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
230 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
231    RaiseExceptionOnError: boolean);
232   var IsCreateDB: boolean;
233   begin
234 <  inherited Create('',nil,RaiseExceptionOnError);
234 >  inherited Create(api,'',nil,RaiseExceptionOnError);
235 >  FFirebird30ClientAPI := api;
236    FSQLDialect := aSQLDialect;
237 <  with Firebird30ClientAPI do
237 >  with FFirebird30ClientAPI do
238    begin
239      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
240                                         PAnsiChar(sql),aSQLDialect,@IsCreateDB);
# Line 183 | Line 254 | begin
254      FAttachmentIntf.release;
255   end;
256  
257 + function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
258 + begin
259 +  Result := TDBInformation.Create(Firebird30ClientAPI);
260 +  with FFirebird30ClientAPI, Result as TDBInformation do
261 +  begin
262 +    FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
263 +                               getBufSize, BytePtr(Buffer));
264 +      Check4DataBaseError;
265 +  end
266 + end;
267 +
268   procedure TFB30Attachment.Connect;
269   begin
270 <  with Firebird30ClientAPI do
270 >  with FFirebird30ClientAPI do
271    begin
272      FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
273                           (DPB as TDPB).getDataLength,
# Line 195 | Line 277 | begin
277        FAttachmentIntf := nil
278      else
279        GetODSAndConnectionInfo;
280 +
281    end;
282   end;
283  
284   procedure TFB30Attachment.Disconnect(Force: boolean);
285   begin
286 +  inherited Disconnect(Force);
287    if IsConnected then
288 <    with Firebird30ClientAPI do
288 >    with FFirebird30ClientAPI do
289      begin
290        EndAllTransactions;
291        FAttachmentIntf.Detach(StatusIntf);
# Line 211 | Line 295 | begin
295        FHasDefaultCharSet := false;
296        FCodePage := CP_NONE;
297        FCharSetID := 0;
298 +      FTimeZoneServices := nil;
299      end;
300   end;
301  
# Line 222 | Line 307 | end;
307   procedure TFB30Attachment.DropDatabase;
308   begin
309    if IsConnected then
310 <    with Firebird30ClientAPI do
310 >    with FFirebird30ClientAPI do
311      begin
312        EndAllTransactions;
313 +      EndSession(false);
314        FAttachmentIntf.dropDatabase(StatusIntf);
315        Check4DataBaseError;
316        FAttachmentIntf := nil;
# Line 232 | Line 318 | begin
318   end;
319  
320   function TFB30Attachment.StartTransaction(TPB: array of byte;
321 <  DefaultCompletion: TTransactionCompletion): ITransaction;
321 >  DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
322   begin
323    CheckHandle;
324 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
324 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion, aName);
325   end;
326  
327   function TFB30Attachment.StartTransaction(TPB: ITPB;
328 <  DefaultCompletion: TTransactionCompletion): ITransaction;
328 >  DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
329   begin
330    CheckHandle;
331 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
331 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion,aName);
332   end;
333  
334   procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
335    aSQLDialect: integer);
336   begin
337    CheckHandle;
338 <  with Firebird30ClientAPI do
338 >  with FFirebird30ClientAPI do
339    begin
340      FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
341                      Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
# Line 258 | Line 344 | begin
344   end;
345  
346   function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
347 <  aSQLDialect: integer): IStatement;
347 >  aSQLDialect: integer; CursorName: AnsiString): IStatement;
348   begin
349    CheckHandle;
350 <  Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
350 >  Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
351   end;
352  
353   function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
354 <  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
354 >  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
355 >  CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
356   begin
357    CheckHandle;
358    Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
359 <         GenerateParamNames);
359 >         GenerateParamNames,CaseSensitiveParams,CursorName);
360   end;
361  
362   function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
# Line 278 | Line 365 | begin
365    Result := TFB30Events.Create(self,Events);
366   end;
367  
281 – function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
282 –  ColumnName: AnsiString; BPB: IBPB): IBlob;
283 – begin
284 –  CheckHandle;
285 –  Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
286 –              TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
287 – end;
288 –
368   function TFB30Attachment.CreateBlob(transaction: ITransaction;
369    BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
370   begin
# Line 300 | Line 379 | begin
379    Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
380   end;
381  
303 – function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
304 –  ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
305 – begin
306 –  CheckHandle;
307 –  Result := TFB30Blob.Create(self,transaction as TFB30transaction,
308 –                TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
309 –                BlobID,BPB);
310 – end;
311 –
382   function TFB30Attachment.OpenBlob(transaction: ITransaction;
383    BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
384   begin
# Line 316 | Line 386 | begin
386    Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
387   end;
388  
389 < function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
390 <  ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
321 < begin
322 <  CheckHandle;
323 <  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
324 <                    GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
325 < end;
326 <
327 < function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
328 <  ColumnName: AnsiString): IArray;
389 > function TFB30Attachment.OpenArray(transaction: ITransaction;
390 >  ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
391   begin
392    CheckHandle;
393    Result := TFB30Array.Create(self,transaction as TFB30Transaction,
394 <                    GetArrayMetaData(transaction,RelationName,ColumnName));
394 >                    ArrayMetaData,ArrayID);
395   end;
396  
397   function TFB30Attachment.CreateArray(transaction: ITransaction;
# Line 360 | Line 422 | begin
422    Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
423   end;
424  
425 < function TFB30Attachment.GetDBInformation(Requests: array of byte
426 <  ): IDBInformation;
365 < var ReqBuffer: PByte;
366 <    i: integer;
425 > procedure TFB30Attachment.getFBVersion(version: TStrings);
426 > var bufferObj: TVersionCallback;
427   begin
428 <  CheckHandle;
429 <  if Length(Requests) = 1 then
430 <    Result := GetDBInformation(Requests[0])
431 <  else
432 <  begin
433 <    Result := TDBInformation.Create;
434 <    GetMem(ReqBuffer,Length(Requests));
375 <    try
376 <      for i := 0 to Length(Requests) - 1 do
377 <        ReqBuffer[i] := Requests[i];
378 <
379 <      with Firebird30ClientAPI, Result as TDBInformation do
380 <      begin
381 <        FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
382 <                                 getBufSize, BytePtr(Buffer));
383 <          Check4DataBaseError;
384 <      end
385 <
386 <    finally
387 <      FreeMem(ReqBuffer);
428 >  version.Clear;
429 >  bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
430 >  try
431 >    with FFirebird30ClientAPI do
432 >    begin
433 >       UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
434 >       Check4DataBaseError;
435      end;
436 +  finally
437 +    bufferObj.Free;
438    end;
439   end;
440  
441 < function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
441 > function TFB30Attachment.HasDecFloatSupport: boolean;
442   begin
443 <  CheckHandle;
444 <  Result := TDBInformation.Create;
445 <  with Firebird30ClientAPI, Result as TDBInformation do
446 <  begin
447 <    FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
448 <                           getBufSize, BytePtr(Buffer));
449 <      Check4DataBaseError;
450 <  end;
443 >  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
444 >   (GetODSMajorVersion >= 13);
445 > end;
446 >
447 > function TFB30Attachment.HasBatchMode: boolean;
448 > begin
449 >  Result := FFirebird30ClientAPI.Firebird4orLater and
450 >     (GetODSMajorVersion >= 13);
451 > end;
452 >
453 > function TFB30Attachment.HasScollableCursors: boolean;
454 > begin
455 >  Result := (GetODSMajorVersion >= 12);
456 > end;
457 >
458 > function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
459 > begin
460 >  if not HasTimeZoneSupport then
461 >    IBError(ibxeNotSupported,[]);
462 >
463 >  if FTimeZoneServices = nil then
464 >    FTimeZoneServices := TFB30TimeZoneServices.Create(self);
465 >  Result := FTimeZoneServices;
466 > end;
467 >
468 > function TFB30Attachment.HasTimeZoneSupport: boolean;
469 > begin
470 >  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
471 >   (GetODSMajorVersion >= 13);
472   end;
473  
474   end.

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines