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

Comparing ibx/trunk/fbintf/client/3.0/FB30Attachment.pas (file contents):
Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 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}
70      procedure Connect;
71      procedure Disconnect(Force: boolean=false); override;
72 <    function IsConnected: boolean;
72 >    function IsConnected: boolean; override;
73      procedure DropDatabase;
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;
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;
103 <    function GetDBInformation(Request: byte): IDBInformation; overload;
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 >
105 >    {Time Zone Support}
106 >    function GetTimeZoneServices: ITimeZoneServices; override;
107 >    function HasTimeZoneSupport: boolean; override;
108    end;
109  
110   implementation
111  
112   uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
113 <  FBOutputBlock, FB30Events;
113 >  FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
114 >
115 > type
116 >  { TVersionCallback }
117 >
118 >  TVersionCallback = class(Firebird.IVersionCallbackImpl)
119 >  private
120 >    FOutput: TStrings;
121 >    FFirebirdClientAPI: TFBClientAPI;
122 >  public
123 >    constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
124 >    procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
125 >  end;
126 >
127 > { TVersionCallback }
128 >
129 > constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
130 >  output: TStrings);
131 > begin
132 >  inherited Create;
133 >  FFirebirdClientAPI := FirebirdClientAPI;
134 >  FOutput := output;
135 > end;
136 >
137 > procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
138 > var StatusObj: TFB30StatusObject;
139 > begin
140 >  if ((status.getState and status.STATE_ERRORS) <> 0) then
141 >  begin
142 >    StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
143 >    try
144 >      raise EIBInterBaseError.Create(StatusObj);
145 >    finally
146 >      StatusObj.Free;
147 >    end;
148 >  end;
149 >  FOutput.Add(text);
150 > end;
151 >
152  
153   { TFB30Attachment }
154  
155 + procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
156 + begin
157 +  if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
158 +  begin
159 +    if aValue then
160 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
161 +    else
162 +      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
163 +    FUsingRemoteICU := aValue;
164 +  end;
165 + end;
166 +
167   procedure TFB30Attachment.CheckHandle;
168   begin
169    if FAttachmentIntf = nil then
170      IBError(ibxeDatabaseClosed,[nil]);
171   end;
172  
173 < constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
173 > constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
174    RaiseExceptionOnConnectError: boolean);
175   begin
176 +  FFirebird30ClientAPI := api;
177    if aDPB = nil then
178    begin
179      if RaiseExceptionOnConnectError then
180         IBError(ibxeNoDPB,[nil]);
181      Exit;
182    end;
183 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
183 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
184    Connect;
185   end;
186  
187 < constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
187 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
188    RaiseExceptionOnError: boolean);
189   var Param: IDPBItem;
190      sql: AnsiString;
191      IsCreateDB: boolean;
192   begin
193 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
193 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
194 >  FFirebird30ClientAPI := api;
195    IsCreateDB := true;
196    if aDPB <> nil then
197    begin
# Line 138 | Line 200 | begin
200        FSQLDialect := Param.AsByte;
201    end;
202    sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
203 <  with Firebird30ClientAPI do
203 >  with FFirebird30ClientAPI do
204    begin
205      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
206                                         PAnsiChar(sql),FSQLDialect,@IsCreateDB);
# Line 151 | Line 213 | begin
213      begin
214        Disconnect;
215        Connect;
216 <    end;
216 >    end
217 >    else
218 >      GetODSAndConnectionInfo;
219    end;
220   end;
221  
222 < constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
222 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
223    RaiseExceptionOnError: boolean);
224   var IsCreateDB: boolean;
161 –    info: IDBInformation;
162 –    ConnectionType: integer;
163 –    SiteName: AnsiString;
225   begin
226 <  inherited Create('',nil,RaiseExceptionOnError);
226 >  inherited Create(api,'',nil,RaiseExceptionOnError);
227 >  FFirebird30ClientAPI := api;
228    FSQLDialect := aSQLDialect;
229 <  with Firebird30ClientAPI do
229 >  with FFirebird30ClientAPI do
230    begin
231      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
232                                         PAnsiChar(sql),aSQLDialect,@IsCreateDB);
233      if FRaiseExceptionOnConnectError then Check4DataBaseError;
234      if InErrorState then
235        FAttachmentIntf := nil;
174 –    FCharSetID := 0;
175 –    FCodePage := CP_NONE;
176 –    FHasDefaultCharSet := false;
177 –    info := GetDBInformation(isc_info_db_id);
178 –    info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
236    end;
237 +  GetODSAndConnectionInfo;
238 +  ExtractConnectString(sql,FDatabaseName);
239 +  DPBFromCreateSQL(sql);
240   end;
241  
242   destructor TFB30Attachment.Destroy;
# Line 186 | Line 246 | begin
246      FAttachmentIntf.release;
247   end;
248  
249 + function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
250 + begin
251 +  Result := TDBInformation.Create(Firebird30ClientAPI);
252 +  with FFirebird30ClientAPI, Result as TDBInformation do
253 +  begin
254 +    FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
255 +                               getBufSize, BytePtr(Buffer));
256 +      Check4DataBaseError;
257 +  end
258 + end;
259 +
260   procedure TFB30Attachment.Connect;
190 – var Param: IDPBItem;
261   begin
262 <  with Firebird30ClientAPI do
262 >  with FFirebird30ClientAPI do
263    begin
264      FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
265                           (DPB as TDPB).getDataLength,
# Line 198 | Line 268 | begin
268      if InErrorState then
269        FAttachmentIntf := nil
270      else
271 <    begin
272 <      Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
203 <      if Param <> nil then
204 <        FSQLDialect := Param.AsByte;
205 <      Param :=  DPB.Find(isc_dpb_lc_ctype);
206 <      FHasDefaultCharSet :=  (Param <> nil) and
207 <                             CharSetName2CharSetID(Param.AsString,FCharSetID) and
208 <                             CharSetID2CodePage(FCharSetID,FCodePage) and
209 <                             (FCharSetID > 1);
210 <    end;
271 >      GetODSAndConnectionInfo;
272 >
273    end;
274   end;
275  
276   procedure TFB30Attachment.Disconnect(Force: boolean);
277   begin
278    if IsConnected then
279 <    with Firebird30ClientAPI do
279 >    with FFirebird30ClientAPI do
280      begin
281        EndAllTransactions;
282        FAttachmentIntf.Detach(StatusIntf);
# Line 224 | Line 286 | begin
286        FHasDefaultCharSet := false;
287        FCodePage := CP_NONE;
288        FCharSetID := 0;
289 +      FTimeZoneServices := nil;
290      end;
291   end;
292  
# Line 235 | Line 298 | end;
298   procedure TFB30Attachment.DropDatabase;
299   begin
300    if IsConnected then
301 <    with Firebird30ClientAPI do
301 >    with FFirebird30ClientAPI do
302      begin
303        EndAllTransactions;
304        FAttachmentIntf.dropDatabase(StatusIntf);
# Line 248 | Line 311 | function TFB30Attachment.StartTransactio
311    DefaultCompletion: TTransactionCompletion): ITransaction;
312   begin
313    CheckHandle;
314 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
314 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
315   end;
316  
317   function TFB30Attachment.StartTransaction(TPB: ITPB;
318    DefaultCompletion: TTransactionCompletion): ITransaction;
319   begin
320    CheckHandle;
321 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
321 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
322   end;
323  
324   procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
325    aSQLDialect: integer);
326   begin
327    CheckHandle;
328 <  with Firebird30ClientAPI do
328 >  with FFirebird30ClientAPI do
329    begin
330      FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
331                      Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
# Line 278 | Line 341 | begin
341   end;
342  
343   function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
344 <  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
344 >  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
345 >  CaseSensitiveParams: boolean): IStatement;
346   begin
347    CheckHandle;
348    Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
349 <         GenerateParamNames);
349 >         GenerateParamNames,CaseSensitiveParams);
350   end;
351  
352   function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
# Line 291 | Line 355 | begin
355    Result := TFB30Events.Create(self,Events);
356   end;
357  
294 – function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
295 –  ColumnName: AnsiString; BPB: IBPB): IBlob;
296 – begin
297 –  CheckHandle;
298 –  Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
299 –              TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
300 – end;
301 –
358   function TFB30Attachment.CreateBlob(transaction: ITransaction;
359    BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
360   begin
# Line 313 | Line 369 | begin
369    Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
370   end;
371  
316 – function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
317 –  ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
318 – begin
319 –  CheckHandle;
320 –  Result := TFB30Blob.Create(self,transaction as TFB30transaction,
321 –                TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
322 –                BlobID,BPB);
323 – end;
324 –
372   function TFB30Attachment.OpenBlob(transaction: ITransaction;
373    BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
374   begin
# Line 329 | Line 376 | begin
376    Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
377   end;
378  
379 < function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
380 <  ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
334 < begin
335 <  CheckHandle;
336 <  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
337 <                    GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
338 < end;
339 <
340 < function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
341 <  ColumnName: AnsiString): IArray;
379 > function TFB30Attachment.OpenArray(transaction: ITransaction;
380 >  ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
381   begin
382    CheckHandle;
383    Result := TFB30Array.Create(self,transaction as TFB30Transaction,
384 <                    GetArrayMetaData(transaction,RelationName,ColumnName));
384 >                    ArrayMetaData,ArrayID);
385   end;
386  
387   function TFB30Attachment.CreateArray(transaction: ITransaction;
# Line 373 | Line 412 | begin
412    Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
413   end;
414  
415 < function TFB30Attachment.GetDBInformation(Requests: array of byte
416 <  ): IDBInformation;
378 < var ReqBuffer: PByte;
379 <    i: integer;
415 > procedure TFB30Attachment.getFBVersion(version: TStrings);
416 > var bufferObj: TVersionCallback;
417   begin
418 <  CheckHandle;
419 <  if Length(Requests) = 1 then
420 <    Result := GetDBInformation(Requests[0])
421 <  else
422 <  begin
423 <    Result := TDBInformation.Create;
424 <    GetMem(ReqBuffer,Length(Requests));
388 <    try
389 <      for i := 0 to Length(Requests) - 1 do
390 <        ReqBuffer[i] := Requests[i];
391 <
392 <      with Firebird30ClientAPI, Result as TDBInformation do
393 <      begin
394 <        FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
395 <                                 getBufSize, BytePtr(Buffer));
396 <          Check4DataBaseError;
397 <      end
398 <
399 <    finally
400 <      FreeMem(ReqBuffer);
418 >  version.Clear;
419 >  bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
420 >  try
421 >    with FFirebird30ClientAPI do
422 >    begin
423 >       UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
424 >       Check4DataBaseError;
425      end;
426 +  finally
427 +    bufferObj.Free;
428    end;
429   end;
430  
431 < function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
431 > function TFB30Attachment.HasDecFloatSupport: boolean;
432   begin
433 <  CheckHandle;
434 <  Result := TDBInformation.Create;
435 <  with Firebird30ClientAPI, Result as TDBInformation do
436 <  begin
437 <    FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
438 <                           getBufSize, BytePtr(Buffer));
439 <      Check4DataBaseError;
440 <  end;
433 >  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
434 >   (GetODSMajorVersion >= 13);
435 > end;
436 >
437 > function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
438 > begin
439 >  if not HasTimeZoneSupport then
440 >    IBError(ibxeNotSupported,[]);
441 >
442 >  if FTimeZoneServices = nil then
443 >    FTimeZoneServices := TFB30TimeZoneServices.Create(self);
444 >  Result := FTimeZoneServices;
445 > end;
446 >
447 > function TFB30Attachment.HasTimeZoneSupport: boolean;
448 > begin
449 >  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
450 >   (GetODSMajorVersion >= 13);
451   end;
452  
453   end.

Diff Legend

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