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.
Revision 345 by tony, Mon Aug 23 14:22:29 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    public
57 <    constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
57 >    constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
58            RaiseExceptionOnConnectError: boolean);
59 <    constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
60 <    constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
59 >    constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
60 >    constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
61        RaiseExceptionOnError: boolean); overload;
62      destructor Destroy; override;
63 +    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
64 +      override;
65      property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
66 +    property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
67  
68    public
69      {IAttachment}
# Line 68 | Line 76 | type
76      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
77      function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): 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): 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;
79 <    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;
81 –    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;
87 <    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;
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;
102 <    function GetDBInformation(Requests: array of byte): IDBInformation; overload; override;
103 <    function GetDBInformation(Request: byte): IDBInformation; overload; override;
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 >
106 >    {Time Zone Support}
107 >    function GetTimeZoneServices: ITimeZoneServices; override;
108 >    function HasTimeZoneSupport: boolean; override;
109    end;
110  
111   implementation
112  
113   uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
114 <  FBOutputBlock, FB30Events, IBUtils;
114 >  FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
115 >
116 > type
117 >  { TVersionCallback }
118 >
119 >  TVersionCallback = class(Firebird.IVersionCallbackImpl)
120 >  private
121 >    FOutput: TStrings;
122 >    FFirebirdClientAPI: TFBClientAPI;
123 >  public
124 >    constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
125 >    procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
126 >  end;
127 >
128 > { TVersionCallback }
129 >
130 > constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
131 >  output: TStrings);
132 > begin
133 >  inherited Create;
134 >  FFirebirdClientAPI := FirebirdClientAPI;
135 >  FOutput := output;
136 > end;
137 >
138 > procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
139 > var StatusObj: TFB30StatusObject;
140 > begin
141 >  if ((status.getState and status.STATE_ERRORS) <> 0) then
142 >  begin
143 >    StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
144 >    try
145 >      raise EIBInterBaseError.Create(StatusObj);
146 >    finally
147 >      StatusObj.Free;
148 >    end;
149 >  end;
150 >  FOutput.Add(text);
151 > end;
152 >
153  
154   { TFB30Attachment }
155  
156 + procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
157 + begin
158 +  if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
159 +  begin
160 +    if aValue then
161 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
162 +    else
163 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
164 +    FUsingRemoteICU := aValue;
165 +  end;
166 + end;
167 +
168   procedure TFB30Attachment.CheckHandle;
169   begin
170    if FAttachmentIntf = nil then
171      IBError(ibxeDatabaseClosed,[nil]);
172   end;
173  
174 < constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
174 > constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
175    RaiseExceptionOnConnectError: boolean);
176   begin
177 +  FFirebird30ClientAPI := api;
178    if aDPB = nil then
179    begin
180      if RaiseExceptionOnConnectError then
181         IBError(ibxeNoDPB,[nil]);
182      Exit;
183    end;
184 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
184 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
185    Connect;
186   end;
187  
188 < constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
188 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
189    RaiseExceptionOnError: boolean);
190   var Param: IDPBItem;
191      sql: AnsiString;
192      IsCreateDB: boolean;
193   begin
194 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
194 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
195 >  FFirebird30ClientAPI := api;
196    IsCreateDB := true;
197    if aDPB <> nil then
198    begin
# Line 138 | Line 201 | begin
201        FSQLDialect := Param.AsByte;
202    end;
203    sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
204 <  with Firebird30ClientAPI do
204 >  with FFirebird30ClientAPI do
205    begin
206      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
207                                         PAnsiChar(sql),FSQLDialect,@IsCreateDB);
# Line 157 | Line 220 | begin
220    end;
221   end;
222  
223 < constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
223 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
224    RaiseExceptionOnError: boolean);
225   var IsCreateDB: boolean;
226   begin
227 <  inherited Create('',nil,RaiseExceptionOnError);
227 >  inherited Create(api,'',nil,RaiseExceptionOnError);
228 >  FFirebird30ClientAPI := api;
229    FSQLDialect := aSQLDialect;
230 <  with Firebird30ClientAPI do
230 >  with FFirebird30ClientAPI do
231    begin
232      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
233                                         PAnsiChar(sql),aSQLDialect,@IsCreateDB);
# Line 183 | Line 247 | begin
247      FAttachmentIntf.release;
248   end;
249  
250 + function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
251 + begin
252 +  Result := TDBInformation.Create(Firebird30ClientAPI);
253 +  with FFirebird30ClientAPI, Result as TDBInformation do
254 +  begin
255 +    FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
256 +                               getBufSize, BytePtr(Buffer));
257 +      Check4DataBaseError;
258 +  end
259 + end;
260 +
261   procedure TFB30Attachment.Connect;
262   begin
263 <  with Firebird30ClientAPI do
263 >  with FFirebird30ClientAPI do
264    begin
265      FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
266                           (DPB as TDPB).getDataLength,
# Line 195 | Line 270 | begin
270        FAttachmentIntf := nil
271      else
272        GetODSAndConnectionInfo;
273 +
274    end;
275   end;
276  
277   procedure TFB30Attachment.Disconnect(Force: boolean);
278   begin
279    if IsConnected then
280 <    with Firebird30ClientAPI do
280 >    with FFirebird30ClientAPI do
281      begin
282        EndAllTransactions;
283        FAttachmentIntf.Detach(StatusIntf);
# Line 211 | Line 287 | begin
287        FHasDefaultCharSet := false;
288        FCodePage := CP_NONE;
289        FCharSetID := 0;
290 +      FTimeZoneServices := nil;
291      end;
292   end;
293  
# Line 222 | Line 299 | end;
299   procedure TFB30Attachment.DropDatabase;
300   begin
301    if IsConnected then
302 <    with Firebird30ClientAPI do
302 >    with FFirebird30ClientAPI do
303      begin
304        EndAllTransactions;
305        FAttachmentIntf.dropDatabase(StatusIntf);
# Line 235 | Line 312 | function TFB30Attachment.StartTransactio
312    DefaultCompletion: TTransactionCompletion): ITransaction;
313   begin
314    CheckHandle;
315 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
315 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
316   end;
317  
318   function TFB30Attachment.StartTransaction(TPB: ITPB;
319    DefaultCompletion: TTransactionCompletion): ITransaction;
320   begin
321    CheckHandle;
322 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
322 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
323   end;
324  
325   procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
326    aSQLDialect: integer);
327   begin
328    CheckHandle;
329 <  with Firebird30ClientAPI do
329 >  with FFirebird30ClientAPI do
330    begin
331      FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
332                      Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
# Line 265 | Line 342 | begin
342   end;
343  
344   function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
345 <  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
345 >  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
346 >  CaseSensitiveParams: boolean): IStatement;
347   begin
348    CheckHandle;
349    Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
350 <         GenerateParamNames);
350 >         GenerateParamNames,CaseSensitiveParams);
351   end;
352  
353   function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
# Line 278 | Line 356 | begin
356    Result := TFB30Events.Create(self,Events);
357   end;
358  
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 –
359   function TFB30Attachment.CreateBlob(transaction: ITransaction;
360    BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
361   begin
# Line 300 | Line 370 | begin
370    Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
371   end;
372  
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 –
373   function TFB30Attachment.OpenBlob(transaction: ITransaction;
374    BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
375   begin
# Line 316 | Line 377 | begin
377    Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
378   end;
379  
380 < function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
381 <  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;
380 > function TFB30Attachment.OpenArray(transaction: ITransaction;
381 >  ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
382   begin
383    CheckHandle;
384    Result := TFB30Array.Create(self,transaction as TFB30Transaction,
385 <                    GetArrayMetaData(transaction,RelationName,ColumnName));
385 >                    ArrayMetaData,ArrayID);
386   end;
387  
388   function TFB30Attachment.CreateArray(transaction: ITransaction;
# Line 360 | Line 413 | begin
413    Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
414   end;
415  
416 < function TFB30Attachment.GetDBInformation(Requests: array of byte
417 <  ): IDBInformation;
365 < var ReqBuffer: PByte;
366 <    i: integer;
416 > procedure TFB30Attachment.getFBVersion(version: TStrings);
417 > var bufferObj: TVersionCallback;
418   begin
419 <  CheckHandle;
420 <  if Length(Requests) = 1 then
421 <    Result := GetDBInformation(Requests[0])
422 <  else
423 <  begin
424 <    Result := TDBInformation.Create;
425 <    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);
419 >  version.Clear;
420 >  bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
421 >  try
422 >    with FFirebird30ClientAPI do
423 >    begin
424 >       UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
425 >       Check4DataBaseError;
426      end;
427 +  finally
428 +    bufferObj.Free;
429    end;
430   end;
431  
432 < function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
432 > function TFB30Attachment.HasDecFloatSupport: boolean;
433   begin
434 <  CheckHandle;
435 <  Result := TDBInformation.Create;
436 <  with Firebird30ClientAPI, Result as TDBInformation do
437 <  begin
438 <    FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
439 <                           getBufSize, BytePtr(Buffer));
440 <      Check4DataBaseError;
441 <  end;
434 >  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
435 >   (GetODSMajorVersion >= 13);
436 > end;
437 >
438 > function TFB30Attachment.HasBatchMode: boolean;
439 > begin
440 >  Result := FFirebird30ClientAPI.Firebird4orLater and
441 >     (GetODSMajorVersion >= 13);
442 > end;
443 >
444 > function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
445 > begin
446 >  if not HasTimeZoneSupport then
447 >    IBError(ibxeNotSupported,[]);
448 >
449 >  if FTimeZoneServices = nil then
450 >    FTimeZoneServices := TFB30TimeZoneServices.Create(self);
451 >  Result := FTimeZoneServices;
452 > end;
453 >
454 > function TFB30Attachment.HasTimeZoneSupport: boolean;
455 > begin
456 >  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
457 >   (GetODSMajorVersion >= 13);
458   end;
459  
460   end.

Diff Legend

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