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

Comparing ibx/trunk/fbintf/client/2.5/FB25Attachment.pas (file contents):
Revision 117 by tony, Mon Jan 22 13:58:11 2018 UTC vs.
Revision 352 by tony, Thu Oct 21 12:17:43 2021 UTC

# Line 46 | Line 46 | type
46    TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
47    private
48      FHandle: TISC_DB_HANDLE;
49 +    FFirebird25ClientAPI: TFB25ClientAPI;
50    protected
51      procedure CheckHandle; override;
52    public
53 <    constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
53 >    constructor Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54        RaiseExceptionOnConnectError: boolean);
55 <    constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56 <    constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
55 >    constructor CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56 >    constructor CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
57        RaiseExceptionOnError: boolean); overload;
58 +    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; override;
59      property Handle: TISC_DB_HANDLE read FHandle;
60 +    property Firebird25ClientAPI: TFB25ClientAPI read FFirebird25ClientAPI;
61  
62    public
63      {IAttachment}
# Line 65 | Line 68 | type
68      function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
69      function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
70      procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
71 <    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
71 >    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
72      function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
73 <                       aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
73 >                       aSQLDialect: integer; GenerateParamNames: boolean=false;
74 >                       CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
75      function GetEventHandler(Events: TStrings): IEvents; override;
76 <    function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
73 <    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
76 >    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
77      function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
75    function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
78      function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
79  
80 <    function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
81 <      ArrayID: TISC_QUAD): IArray;
80 <    function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
81 <      ): IArray; overload;
82 <    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
80 >    function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
81 >    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
82      function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
83        Scale: integer; size: cardinal;
84        acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
# Line 87 | Line 86 | type
86  
87      {Database Information}
88  
89 <    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
90 <    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
91 <    function GetDBInformation(Requests: array of byte): IDBInformation; overload; override;
92 <    function GetDBInformation(Request: byte): IDBInformation; overload; override;
89 >    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
90 >    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
91 >    procedure getFBVersion(version: TStrings);
92 >    function HasScollableCursors: boolean;
93    end;
94  
95   implementation
96  
97   uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
98 <  FB25Statement, FB25Array, IBUtils;
98 >  FB25Statement, FB25Array, IBUtils, IBExternals;
99  
100    { TFB25Attachment }
101  
# Line 106 | Line 105 | begin
105      IBError(ibxeDatabaseClosed,[nil]);
106   end;
107  
108 < constructor TFB25Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
108 > constructor TFB25Attachment.Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
109    RaiseExceptionOnConnectError: boolean);
110   begin
111 +  FFirebird25ClientAPI := api;
112    if aDPB = nil then
113    begin
114      if RaiseExceptionOnConnectError then
115         IBError(ibxeNoDPB,[nil]);
116      Exit;
117    end;
118 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
118 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
119    Connect;
120   end;
121  
122 < constructor TFB25Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
122 > constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
123    RaiseExceptionOnError: boolean);
124   var sql: AnsiString;
125      tr_handle: TISC_TR_HANDLE;
126   begin
127 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
127 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
128 >  FFirebird25ClientAPI := api;
129    sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
130    tr_handle := nil;
131 <  with Firebird25ClientAPI do
131 >  with FFirebird25ClientAPI do
132    if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
133                                    SQLDialect, nil) > 0) and RaiseExceptionOnError then
134      IBDataBaseError;
# Line 141 | Line 142 | begin
142      GetODSAndConnectionInfo;
143   end;
144  
145 < constructor TFB25Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
145 > constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
146      RaiseExceptionOnError: boolean);
147   var tr_handle: TISC_TR_HANDLE;
148   begin
149 <  inherited Create('',nil,RaiseExceptionOnError);
149 >  inherited Create(api,'',nil,RaiseExceptionOnError);
150 >  FFirebird25ClientAPI := api;
151    FSQLDialect := aSQLDialect;
152    tr_handle := nil;
153 <  with Firebird25ClientAPI do
153 >  with FFirebird25ClientAPI do
154    begin
155      if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
156                                    aSQLDialect, nil) > 0) and RaiseExceptionOnError then
# Line 160 | Line 162 | begin
162    DPBFromCreateSQL(sql);
163   end;
164  
165 + function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
166 +  ): IDBInformation;
167 + begin
168 +  Result := TDBInformation.Create(FFirebird25ClientAPI);
169 +  with FFirebird25ClientAPI, Result as TDBInformation do
170 +     if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
171 +                               getBufSize, Buffer) > 0 then
172 +          IBDataBaseError;
173 + end;
174 +
175   procedure TFB25Attachment.Connect;
176   begin
177    FSQLDialect := 3;
178  
179 <  with Firebird25ClientAPI do
179 >  with FFirebird25ClientAPI do
180    if DPB = nil then
181    begin
182      if (isc_attach_database(StatusVector, Length(FDatabaseName),
# Line 190 | Line 202 | begin
202  
203    EndAllTransactions;
204    {Disconnect}
205 <  with Firebird25ClientAPI do
205 >  with FFirebird25ClientAPI do
206      if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
207        IBDatabaseError;
208    FHandle := nil;
# Line 208 | Line 220 | procedure TFB25Attachment.DropDatabase;
220   begin
221    CheckHandle;
222    EndAllTransactions;
223 <  with Firebird25ClientAPI do
223 >  with FFirebird25ClientAPI do
224      if isc_drop_database(StatusVector, @FHandle) > 0 then
225        IBDatabaseError;
226    FHandle := nil;
# Line 218 | Line 230 | function TFB25Attachment.StartTransactio
230    DefaultCompletion: TTransactionCompletion): ITransaction;
231   begin
232    CheckHandle;
233 <  Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
233 >  Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
234   end;
235  
236   function TFB25Attachment.StartTransaction(TPB: ITPB;
237    DefaultCompletion: TTransactionCompletion): ITransaction;
238   begin
239    CheckHandle;
240 <  Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
229 < end;
230 <
231 < function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
232 <  ColumnName: AnsiString; BPB: IBPB): IBlob;
233 < begin
234 <  CheckHandle;
235 <  Result := TFB25Blob.Create(self,transaction as TFB25transaction,
236 <                TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),BPB);
240 >  Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
241   end;
242  
243   function TFB25Attachment.CreateBlob(transaction: ITransaction;
# Line 250 | Line 254 | begin
254    Result := TFB25Blob.Create(self,transaction as TFB25transaction,SubType,aCharSetID,BPB);
255   end;
256  
253 function TFB25Attachment.OpenBlob(transaction: ITransaction; RelationName,
254  ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
255 begin
256  CheckHandle;
257  Result := TFB25Blob.Create(self,transaction as TFB25transaction,
258                TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),
259                BlobID,BPB);
260 end;
261
257   function TFB25Attachment.OpenBlob(transaction: ITransaction;
258    BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
259   begin
# Line 272 | Line 267 | var TRHandle: TISC_TR_HANDLE;
267   begin
268    CheckHandle;
269    TRHandle := (Transaction as TFB25Transaction).Handle;
270 <  with Firebird25ClientAPI do
270 >  with FFirebird25ClientAPI do
271      if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PAnsiChar(sql), aSQLDialect, nil) > 0 then
272        IBDatabaseError;
273    SignalActivity;
274   end;
275  
276   function TFB25Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
277 <  aSQLDialect: integer): IStatement;
277 >  aSQLDialect: integer; CursorName: AnsiString): IStatement;
278   begin
279    CheckHandle;
280    Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
281   end;
282  
283   function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
284 <  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
284 >  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
285 >  CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
286   begin
287    CheckHandle;
288    Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
289 <         GenerateParamNames);
289 >         GenerateParamNames,CaseSensitiveParams,CursorName);
290   end;
291  
292   function TFB25Attachment.GetEventHandler(Events: TStrings): IEvents;
# Line 299 | Line 295 | begin
295    Result := TFB25Events.Create(self,Events);
296   end;
297  
298 < function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
298 > function TFB25Attachment.OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData;
299    ArrayID: TISC_QUAD): IArray;
300   begin
301    CheckHandle;
302    Result := TFB25Array.Create(self,transaction as TFB25Transaction,
303 <                    GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
308 < end;
309 <
310 < function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray;
311 < begin
312 <  CheckHandle;
313 <  Result := TFB25Array.Create(self,transaction as TFB25Transaction,
314 <                    GetArrayMetaData(transaction,RelationName,ColumnName));
303 >                    ArrayMetaData,ArrayID);
304   end;
305  
306   function TFB25Attachment.CreateArray(transaction: ITransaction;
# Line 343 | Line 332 | begin
332    Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
333   end;
334  
335 < function TFB25Attachment.GetDBInformation(Requests: array of byte
347 <  ): IDBInformation;
348 < var ReqBuffer: PByte;
349 <    i: integer;
335 > procedure ISCVersionCallback(userArg: pointer; text: PAnsiChar); cdecl;
336   begin
337 <  CheckHandle;
352 <  if Length(Requests) = 1 then
353 <    Result := GetDBInformation(Requests[0])
354 <  else
355 <  begin
356 <    Result := TDBInformation.Create;
357 <    GetMem(ReqBuffer,Length(Requests));
358 <    try
359 <      for i := 0 to Length(Requests) - 1 do
360 <        ReqBuffer[i] := Requests[i];
361 <
362 <      with Firebird25ClientAPI, Result as TDBInformation do
363 <          if isc_database_info(StatusVector, @(FHandle), Length(Requests), ReqBuffer,
364 <                                 getBufSize, Buffer) > 0 then
365 <            IBDataBaseError;
366 <
367 <    finally
368 <      FreeMem(ReqBuffer);
369 <    end;
370 <  end;
337 >  TStrings(userArg).Add(text);
338   end;
339  
340 < function TFB25Attachment.GetDBInformation(Request: byte): IDBInformation;
340 > procedure TFB25Attachment.getFBVersion(version: TStrings);
341 > var callback: pointer;
342   begin
343 <  CheckHandle;
344 <  Result := TDBInformation.Create;
345 <  with Firebird25ClientAPI, Result as TDBInformation do
346 <    if isc_database_info(StatusVector, @(FHandle), 1, @Request,
347 <                           getBufSize, Buffer) > 0 then
348 <      IBDataBaseError;
343 >  callback := @ISCVersionCallback;
344 >  version.Clear;
345 >  with FFirebird25ClientAPI do
346 >    if isc_version(@FHandle,TISC_CALLBACK(callback),PVoid(version)) > 0 then
347 >       IBDataBaseError;
348 > end;
349 >
350 > function TFB25Attachment.HasScollableCursors: boolean;
351 > begin
352 >  Result := false;
353   end;
354  
355   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines