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 266 by tony, Wed Dec 26 18:34:32 2018 UTC

# Line 46 | Line 46 | type
46    TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
47    private
48      FAttachmentIntf: Firebird.IAttachment;
49 +    FFirebird30ClientAPI: TFB30ClientAPI;
50    protected
51      procedure CheckHandle; override;
52    public
53 <    constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
53 >    constructor Create(api: TFB30ClientAPI; 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: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
56 >    constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
57        RaiseExceptionOnError: boolean); overload;
58      destructor Destroy; override;
59 +    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
60 +      override;
61      property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
62 +    property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
63  
64    public
65      {IAttachment}
66      procedure Connect;
67      procedure Disconnect(Force: boolean=false); override;
68 <    function IsConnected: boolean;
68 >    function IsConnected: boolean; override;
69      procedure DropDatabase;
70      function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
71      function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
# Line 87 | Line 91 | type
91      function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
92      function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
93        columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
94 <  dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
94 >      dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
95  
96  
97      {Database Information}
98      function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
99      function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
100 <    function GetDBInformation(Requests: array of byte): IDBInformation; overload;
97 <    function GetDBInformation(Request: byte): IDBInformation; overload;
100 >    procedure getFBVersion(version: TStrings);
101    end;
102  
103   implementation
104  
105   uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
106 <  FBOutputBlock, FB30Events;
106 >  FBOutputBlock, FB30Events, IBUtils;
107 >
108 > type
109 >  { TVersionCallback }
110 >
111 >  TVersionCallback = class(Firebird.IVersionCallbackImpl)
112 >  private
113 >    FOutput: TStrings;
114 >  public
115 >    constructor Create(output: TStrings);
116 >    procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
117 >  end;
118 >
119 > { TVersionCallback }
120 >
121 > constructor TVersionCallback.Create(output: TStrings);
122 > begin
123 >  inherited Create;
124 >  FOutput := output;
125 > end;
126 >
127 > procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
128 > begin
129 >  FOutput.Add(text);
130 > end;
131 >
132  
133   { TFB30Attachment }
134  
# Line 110 | Line 138 | begin
138      IBError(ibxeDatabaseClosed,[nil]);
139   end;
140  
141 < constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
141 > constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
142    RaiseExceptionOnConnectError: boolean);
143   begin
144 +  FFirebird30ClientAPI := api;
145    if aDPB = nil then
146    begin
147      if RaiseExceptionOnConnectError then
148         IBError(ibxeNoDPB,[nil]);
149      Exit;
150    end;
151 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
151 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
152    Connect;
153   end;
154  
155 < constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
155 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
156    RaiseExceptionOnError: boolean);
157   var Param: IDPBItem;
158      sql: AnsiString;
159      IsCreateDB: boolean;
160   begin
161 <  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
161 >  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
162 >  FFirebird30ClientAPI := api;
163    IsCreateDB := true;
164    if aDPB <> nil then
165    begin
# Line 138 | Line 168 | begin
168        FSQLDialect := Param.AsByte;
169    end;
170    sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
171 <  with Firebird30ClientAPI do
171 >  with FFirebird30ClientAPI do
172    begin
173      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
174                                         PAnsiChar(sql),FSQLDialect,@IsCreateDB);
# Line 151 | Line 181 | begin
181      begin
182        Disconnect;
183        Connect;
184 <    end;
184 >    end
185 >    else
186 >      GetODSAndConnectionInfo;
187    end;
188   end;
189  
190 < constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
190 > constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
191    RaiseExceptionOnError: boolean);
192   var IsCreateDB: boolean;
161    info: IDBInformation;
162    ConnectionType: integer;
163    SiteName: AnsiString;
193   begin
194 <  inherited Create('',nil,RaiseExceptionOnError);
194 >  inherited Create(api,'',nil,RaiseExceptionOnError);
195 >  FFirebird30ClientAPI := api;
196    FSQLDialect := aSQLDialect;
197 <  with Firebird30ClientAPI do
197 >  with FFirebird30ClientAPI do
198    begin
199      FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
200                                         PAnsiChar(sql),aSQLDialect,@IsCreateDB);
201      if FRaiseExceptionOnConnectError then Check4DataBaseError;
202      if InErrorState then
203        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);
204    end;
205 +  GetODSAndConnectionInfo;
206 +  ExtractConnectString(sql,FDatabaseName);
207 +  DPBFromCreateSQL(sql);
208   end;
209  
210   destructor TFB30Attachment.Destroy;
# Line 186 | Line 214 | begin
214      FAttachmentIntf.release;
215   end;
216  
217 + function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
218 + begin
219 +  Result := TDBInformation.Create(Firebird30ClientAPI);
220 +  with FFirebird30ClientAPI, Result as TDBInformation do
221 +  begin
222 +    FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
223 +                               getBufSize, BytePtr(Buffer));
224 +      Check4DataBaseError;
225 +  end
226 + end;
227 +
228   procedure TFB30Attachment.Connect;
190 var Param: IDPBItem;
229   begin
230 <  with Firebird30ClientAPI do
230 >  with FFirebird30ClientAPI do
231    begin
232      FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
233                           (DPB as TDPB).getDataLength,
# Line 198 | Line 236 | begin
236      if InErrorState then
237        FAttachmentIntf := nil
238      else
239 <    begin
202 <      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;
239 >      GetODSAndConnectionInfo;
240    end;
241   end;
242  
243   procedure TFB30Attachment.Disconnect(Force: boolean);
244   begin
245    if IsConnected then
246 <    with Firebird30ClientAPI do
246 >    with FFirebird30ClientAPI do
247      begin
248        EndAllTransactions;
249        FAttachmentIntf.Detach(StatusIntf);
# Line 235 | Line 264 | end;
264   procedure TFB30Attachment.DropDatabase;
265   begin
266    if IsConnected then
267 <    with Firebird30ClientAPI do
267 >    with FFirebird30ClientAPI do
268      begin
269        EndAllTransactions;
270        FAttachmentIntf.dropDatabase(StatusIntf);
# Line 248 | Line 277 | function TFB30Attachment.StartTransactio
277    DefaultCompletion: TTransactionCompletion): ITransaction;
278   begin
279    CheckHandle;
280 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
280 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
281   end;
282  
283   function TFB30Attachment.StartTransaction(TPB: ITPB;
284    DefaultCompletion: TTransactionCompletion): ITransaction;
285   begin
286    CheckHandle;
287 <  Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
287 >  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
288   end;
289  
290   procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
291    aSQLDialect: integer);
292   begin
293    CheckHandle;
294 <  with Firebird30ClientAPI do
294 >  with FFirebird30ClientAPI do
295    begin
296      FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
297                      Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
# Line 373 | Line 402 | begin
402    Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
403   end;
404  
405 < function TFB30Attachment.GetDBInformation(Requests: array of byte
406 <  ): IDBInformation;
378 < var ReqBuffer: PByte;
379 <    i: integer;
405 > procedure TFB30Attachment.getFBVersion(version: TStrings);
406 > var bufferObj: TVersionCallback;
407   begin
408 <  CheckHandle;
409 <  if Length(Requests) = 1 then
410 <    Result := GetDBInformation(Requests[0])
411 <  else
412 <  begin
413 <    Result := TDBInformation.Create;
387 <    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);
401 <    end;
402 <  end;
403 < end;
404 <
405 < function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
406 < begin
407 <  CheckHandle;
408 <  Result := TDBInformation.Create;
409 <  with Firebird30ClientAPI, Result as TDBInformation do
410 <  begin
411 <    FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
412 <                           getBufSize, BytePtr(Buffer));
413 <      Check4DataBaseError;
408 >  bufferObj := TVersionCallback.Create(version);
409 >  try
410 >    with FFirebird30ClientAPI do
411 >       UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
412 >  finally
413 >    bufferObj.Free;
414    end;
415   end;
416  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines