client/3.0/FB30Attachment.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FB30Attachment;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, FBAttachment, FBClientAPI, FB30ClientAPI, Firebird, IB,
  FBActivityMonitor, FBParamBlock;

type

  { TFB30Attachment }

  TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
  private
    FAttachmentIntf: Firebird.IAttachment;
    FFirebird30ClientAPI: TFB30ClientAPI;
    FTimeZoneServices: ITimeZoneServices;
    FUsingRemoteICU: boolean;
    procedure SetUseRemoteICU(aValue: boolean);
  protected
    procedure CheckHandle; override;
  public
    constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
          RaiseExceptionOnConnectError: boolean);
    constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
    constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
      RaiseExceptionOnError: boolean); overload;
    destructor Destroy; override;
    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
      override;
    property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
    property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;

  public
    {IAttachment}
    procedure Connect;
    procedure Disconnect(Force: boolean=false); override;
    function IsConnected: boolean; override;
    procedure DropDatabase;
    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
    procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
    function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
                       aSQLDialect: integer; GenerateParamNames: boolean=false;
                       CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;

    {Events}
    function GetEventHandler(Events: TStrings): IEvents; override;

    {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}

    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
    function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
    function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload; override;

    {Array}
    function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
    function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
      columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
      dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;


    {Database Information}
    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
    procedure getFBVersion(version: TStrings);
    function HasDecFloatSupport: boolean; override;
    function HasBatchMode: boolean; override;
    function HasScollableCursors: boolean;

    {Time Zone Support}
    function GetTimeZoneServices: ITimeZoneServices; override;
    function HasTimeZoneSupport: boolean; override;
  end;

implementation

uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
  FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;

type
  { TVersionCallback }

  TVersionCallback = class(Firebird.IVersionCallbackImpl)
  private
    FOutput: TStrings;
    FFirebirdClientAPI: TFBClientAPI;
  public
    constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
    procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
  end;

{ TVersionCallback }

constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
  output: TStrings);
begin
  inherited Create;
  FFirebirdClientAPI := FirebirdClientAPI;
  FOutput := output;
end;

procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
var StatusObj: TFB30StatusObject;
begin
  if ((status.getState and status.STATE_ERRORS) <> 0) then
  begin
    StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
    try
      raise EIBInterBaseError.Create(StatusObj);
    finally
      StatusObj.Free;
    end;
  end;
  FOutput.Add(text);
end;


{ TFB30Attachment }

procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
begin
  if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
  begin
    if aValue then
      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
    else
      ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
    FUsingRemoteICU := aValue;
  end;
end;

procedure TFB30Attachment.CheckHandle;
begin
  if FAttachmentIntf = nil then
    IBError(ibxeDatabaseClosed,[nil]);
end;

constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
  RaiseExceptionOnConnectError: boolean);
begin
  FFirebird30ClientAPI := api;
  if aDPB = nil then
  begin
    if RaiseExceptionOnConnectError then
       IBError(ibxeNoDPB,[nil]);
    Exit;
  end;
  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
  Connect;
end;

constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
  RaiseExceptionOnError: boolean);
var Param: IDPBItem;
    sql: AnsiString;
    IsCreateDB: boolean;
begin
  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
  FFirebird30ClientAPI := api;
  IsCreateDB := true;
  if aDPB <> nil then
  begin
    Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
    if Param <> nil then
      FSQLDialect := Param.AsByte;
  end;
  sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
                                       PAnsiChar(sql),FSQLDialect,@IsCreateDB);
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil
    else
    if aDPB <> nil then
    {Connect using known parameters}
    begin
      Disconnect;
      Connect;
    end
    else
      GetODSAndConnectionInfo;
  end;
end;

constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
  RaiseExceptionOnError: boolean);
var IsCreateDB: boolean;
begin
  inherited Create(api,'',nil,RaiseExceptionOnError);
  FFirebird30ClientAPI := api;
  FSQLDialect := aSQLDialect;
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
                                       PAnsiChar(sql),aSQLDialect,@IsCreateDB);
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil;
  end;
  GetODSAndConnectionInfo;
  ExtractConnectString(sql,FDatabaseName);
  DPBFromCreateSQL(sql);
end;

destructor TFB30Attachment.Destroy;
begin
  inherited Destroy;
  if assigned(FAttachmentIntf) then
    FAttachmentIntf.release;
end;

function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
begin
  Result := TDBInformation.Create(Firebird30ClientAPI);
  with FFirebird30ClientAPI, Result as TDBInformation do
  begin
    FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
                               getBufSize, BytePtr(Buffer));
      Check4DataBaseError;
  end
end;

procedure TFB30Attachment.Connect;
begin
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
                         (DPB as TDPB).getDataLength,
                         BytePtr((DPB as TDPB).getBuffer));
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil
    else
      GetODSAndConnectionInfo;

  end;
end;

procedure TFB30Attachment.Disconnect(Force: boolean);
begin
  if IsConnected then
    with FFirebird30ClientAPI do
    begin
      EndAllTransactions;
      FAttachmentIntf.Detach(StatusIntf);
      if not Force and InErrorState then
        IBDataBaseError;
      FAttachmentIntf := nil;
      FHasDefaultCharSet := false;
      FCodePage := CP_NONE;
      FCharSetID := 0;
      FTimeZoneServices := nil;
    end;
end;

function TFB30Attachment.IsConnected: boolean;
begin
  Result := FAttachmentIntf <> nil;
end;

procedure TFB30Attachment.DropDatabase;
begin
  if IsConnected then
    with FFirebird30ClientAPI do
    begin
      EndAllTransactions;
      FAttachmentIntf.dropDatabase(StatusIntf);
      Check4DataBaseError;
      FAttachmentIntf := nil;
    end;
end;

function TFB30Attachment.StartTransaction(TPB: array of byte;
  DefaultCompletion: TTransactionCompletion): ITransaction;
begin
  CheckHandle;
  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
end;

function TFB30Attachment.StartTransaction(TPB: ITPB;
  DefaultCompletion: TTransactionCompletion): ITransaction;
begin
  CheckHandle;
  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
end;

procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
  aSQLDialect: integer);
begin
  CheckHandle;
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
                    Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
    Check4DataBaseError;
  end;
end;

function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
  aSQLDialect: integer; CursorName: AnsiString): IStatement;
begin
  CheckHandle;
  Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
end;

function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
  CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
begin
  CheckHandle;
  Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
         GenerateParamNames,CaseSensitiveParams,CursorName);
end;

function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
begin
  CheckHandle;
  Result := TFB30Events.Create(self,Events);
end;

function TFB30Attachment.CreateBlob(transaction: ITransaction;
  BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
end;

function TFB30Attachment.CreateBlob(transaction: ITransaction;
  SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
end;

function TFB30Attachment.OpenBlob(transaction: ITransaction;
  BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
end;

function TFB30Attachment.OpenArray(transaction: ITransaction;
  ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
begin
  CheckHandle;
  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
                    ArrayMetaData,ArrayID);
end;

function TFB30Attachment.CreateArray(transaction: ITransaction;
  ArrayMetaData: IArrayMetaData): IArray;
begin
  CheckHandle;
  Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
end;

function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
  Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
  bounds: TArrayBounds): IArrayMetaData;
begin
  Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
end;

function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
  columnName: AnsiString): IBlobMetaData;
begin
  CheckHandle;
  Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
end;

function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
  columnName: AnsiString): IArrayMetaData;
begin
  CheckHandle;
  Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
end;

procedure TFB30Attachment.getFBVersion(version: TStrings);
var bufferObj: TVersionCallback;
begin
  version.Clear;
  bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
  try
    with FFirebird30ClientAPI do
    begin
       UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
       Check4DataBaseError;
    end;
  finally
    bufferObj.Free;
  end;
end;

function TFB30Attachment.HasDecFloatSupport: boolean;
begin
  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
   (GetODSMajorVersion >= 13);
end;

function TFB30Attachment.HasBatchMode: boolean;
begin
  Result := FFirebird30ClientAPI.Firebird4orLater and
     (GetODSMajorVersion >= 13);
end;

function TFB30Attachment.HasScollableCursors: boolean;
begin
  Result := (GetODSMajorVersion >= 12);
end;

function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
begin
  if not HasTimeZoneSupport then
    IBError(ibxeNotSupported,[]);

  if FTimeZoneServices = nil then
    FTimeZoneServices := TFB30TimeZoneServices.Create(self);
  Result := FTimeZoneServices;
end;

function TFB30Attachment.HasTimeZoneSupport: boolean;
begin
  Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
   (GetODSMajorVersion >= 13);
end;

end.

Revision:	359
Committed:	Tue Dec 7 09:37:32 2021 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	15188 byte(s)
Log Message:	Fixes Merged
#	Content
1	(*
2	* Firebird Interface (fbintf). The fbintf components provide a set of
3	* Pascal language bindings for the Firebird API.
4	*
5	* The contents of this file are subject to the Initial Developer's
6	* Public License Version 1.0 (the "License"); you may not use this
7	* file except in compliance with the License. You may obtain a copy
8	* of the License here:
9	*
10	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11	*
12	* Software distributed under the License is distributed on an "AS
13	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14	* implied. See the License for the specific language governing rights
15	* and limitations under the License.
16	*
17	* The Initial Developer of the Original Code is Tony Whyman.
18	*
19	* The Original Code is (C) 2016 Tony Whyman, MWA Software
20	* (http://www.mwasoftware.co.uk).
21	*
22	* All Rights Reserved.
23	*
24	* Contributor(s): ______________________________________.
25	*
26	*)
27	unit FB30Attachment;
28	{$IFDEF MSWINDOWS}
29	{$DEFINE WINDOWS}
30	{$ENDIF}
31
32	{$IFDEF FPC}
33	{$mode delphi}
34	{$interfaces COM}
35	{$ENDIF}
36
37	interface
38
39	uses
40	Classes, SysUtils, FBAttachment, FBClientAPI, FB30ClientAPI, Firebird, IB,
41	FBActivityMonitor, FBParamBlock;
42
43	type
44
45	{ TFB30Attachment }
46
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(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
58	RaiseExceptionOnConnectError: boolean);
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; 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; CursorName: AnsiString=''): IStatement; override;
78	function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
79	aSQLDialect: integer; GenerateParamNames: boolean=false;
80	CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): 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; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
88	function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; 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; 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;
97
98
99	{Database Information}
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	function HasScollableCursors: boolean;
106
107	{Time Zone Support}
108	function GetTimeZoneServices: ITimeZoneServices; override;
109	function HasTimeZoneSupport: boolean; override;
110	end;
111
112	implementation
113
114	uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
115	FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
116
117	type
118	{ TVersionCallback }
119
120	TVersionCallback = class(Firebird.IVersionCallbackImpl)
121	private
122	FOutput: TStrings;
123	FFirebirdClientAPI: TFBClientAPI;
124	public
125	constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
126	procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
127	end;
128
129	{ TVersionCallback }
130
131	constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
132	output: TStrings);
133	begin
134	inherited Create;
135	FFirebirdClientAPI := FirebirdClientAPI;
136	FOutput := output;
137	end;
138
139	procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
140	var StatusObj: TFB30StatusObject;
141	begin
142	if ((status.getState and status.STATE_ERRORS) <> 0) then
143	begin
144	StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
145	try
146	raise EIBInterBaseError.Create(StatusObj);
147	finally
148	StatusObj.Free;
149	end;
150	end;
151	FOutput.Add(text);
152	end;
153
154
155	{ TFB30Attachment }
156
157	procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
158	begin
159	if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
160	begin
161	if aValue then
162	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
163	else
164	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
165	FUsingRemoteICU := aValue;
166	end;
167	end;
168
169	procedure TFB30Attachment.CheckHandle;
170	begin
171	if FAttachmentIntf = nil then
172	IBError(ibxeDatabaseClosed,[nil]);
173	end;
174
175	constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
176	RaiseExceptionOnConnectError: boolean);
177	begin
178	FFirebird30ClientAPI := api;
179	if aDPB = nil then
180	begin
181	if RaiseExceptionOnConnectError then
182	IBError(ibxeNoDPB,[nil]);
183	Exit;
184	end;
185	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
186	Connect;
187	end;
188
189	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
190	RaiseExceptionOnError: boolean);
191	var Param: IDPBItem;
192	sql: AnsiString;
193	IsCreateDB: boolean;
194	begin
195	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
196	FFirebird30ClientAPI := api;
197	IsCreateDB := true;
198	if aDPB <> nil then
199	begin
200	Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
201	if Param <> nil then
202	FSQLDialect := Param.AsByte;
203	end;
204	sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
205	with FFirebird30ClientAPI do
206	begin
207	FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
208	PAnsiChar(sql),FSQLDialect,@IsCreateDB);
209	if FRaiseExceptionOnConnectError then Check4DataBaseError;
210	if InErrorState then
211	FAttachmentIntf := nil
212	else
213	if aDPB <> nil then
214	{Connect using known parameters}
215	begin
216	Disconnect;
217	Connect;
218	end
219	else
220	GetODSAndConnectionInfo;
221	end;
222	end;
223
224	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
225	RaiseExceptionOnError: boolean);
226	var IsCreateDB: boolean;
227	begin
228	inherited Create(api,'',nil,RaiseExceptionOnError);
229	FFirebird30ClientAPI := api;
230	FSQLDialect := aSQLDialect;
231	with FFirebird30ClientAPI do
232	begin
233	FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
234	PAnsiChar(sql),aSQLDialect,@IsCreateDB);
235	if FRaiseExceptionOnConnectError then Check4DataBaseError;
236	if InErrorState then
237	FAttachmentIntf := nil;
238	end;
239	GetODSAndConnectionInfo;
240	ExtractConnectString(sql,FDatabaseName);
241	DPBFromCreateSQL(sql);
242	end;
243
244	destructor TFB30Attachment.Destroy;
245	begin
246	inherited Destroy;
247	if assigned(FAttachmentIntf) then
248	FAttachmentIntf.release;
249	end;
250
251	function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
252	begin
253	Result := TDBInformation.Create(Firebird30ClientAPI);
254	with FFirebird30ClientAPI, Result as TDBInformation do
255	begin
256	FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
257	getBufSize, BytePtr(Buffer));
258	Check4DataBaseError;
259	end
260	end;
261
262	procedure TFB30Attachment.Connect;
263	begin
264	with FFirebird30ClientAPI do
265	begin
266	FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
267	(DPB as TDPB).getDataLength,
268	BytePtr((DPB as TDPB).getBuffer));
269	if FRaiseExceptionOnConnectError then Check4DataBaseError;
270	if InErrorState then
271	FAttachmentIntf := nil
272	else
273	GetODSAndConnectionInfo;
274
275	end;
276	end;
277
278	procedure TFB30Attachment.Disconnect(Force: boolean);
279	begin
280	if IsConnected then
281	with FFirebird30ClientAPI do
282	begin
283	EndAllTransactions;
284	FAttachmentIntf.Detach(StatusIntf);
285	if not Force and InErrorState then
286	IBDataBaseError;
287	FAttachmentIntf := nil;
288	FHasDefaultCharSet := false;
289	FCodePage := CP_NONE;
290	FCharSetID := 0;
291	FTimeZoneServices := nil;
292	end;
293	end;
294
295	function TFB30Attachment.IsConnected: boolean;
296	begin
297	Result := FAttachmentIntf <> nil;
298	end;
299
300	procedure TFB30Attachment.DropDatabase;
301	begin
302	if IsConnected then
303	with FFirebird30ClientAPI do
304	begin
305	EndAllTransactions;
306	FAttachmentIntf.dropDatabase(StatusIntf);
307	Check4DataBaseError;
308	FAttachmentIntf := nil;
309	end;
310	end;
311
312	function TFB30Attachment.StartTransaction(TPB: array of byte;
313	DefaultCompletion: TTransactionCompletion): ITransaction;
314	begin
315	CheckHandle;
316	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
317	end;
318
319	function TFB30Attachment.StartTransaction(TPB: ITPB;
320	DefaultCompletion: TTransactionCompletion): ITransaction;
321	begin
322	CheckHandle;
323	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
324	end;
325
326	procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
327	aSQLDialect: integer);
328	begin
329	CheckHandle;
330	with FFirebird30ClientAPI do
331	begin
332	FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
333	Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
334	Check4DataBaseError;
335	end;
336	end;
337
338	function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
339	aSQLDialect: integer; CursorName: AnsiString): IStatement;
340	begin
341	CheckHandle;
342	Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
343	end;
344
345	function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
346	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
347	CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
348	begin
349	CheckHandle;
350	Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
351	GenerateParamNames,CaseSensitiveParams,CursorName);
352	end;
353
354	function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
355	begin
356	CheckHandle;
357	Result := TFB30Events.Create(self,Events);
358	end;
359
360	function TFB30Attachment.CreateBlob(transaction: ITransaction;
361	BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
362	begin
363	CheckHandle;
364	Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
365	end;
366
367	function TFB30Attachment.CreateBlob(transaction: ITransaction;
368	SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
369	begin
370	CheckHandle;
371	Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
372	end;
373
374	function TFB30Attachment.OpenBlob(transaction: ITransaction;
375	BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
376	begin
377	CheckHandle;
378	Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
379	end;
380
381	function TFB30Attachment.OpenArray(transaction: ITransaction;
382	ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
383	begin
384	CheckHandle;
385	Result := TFB30Array.Create(self,transaction as TFB30Transaction,
386	ArrayMetaData,ArrayID);
387	end;
388
389	function TFB30Attachment.CreateArray(transaction: ITransaction;
390	ArrayMetaData: IArrayMetaData): IArray;
391	begin
392	CheckHandle;
393	Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
394	end;
395
396	function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
397	Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
398	bounds: TArrayBounds): IArrayMetaData;
399	begin
400	Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
401	end;
402
403	function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
404	columnName: AnsiString): IBlobMetaData;
405	begin
406	CheckHandle;
407	Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
408	end;
409
410	function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
411	columnName: AnsiString): IArrayMetaData;
412	begin
413	CheckHandle;
414	Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
415	end;
416
417	procedure TFB30Attachment.getFBVersion(version: TStrings);
418	var bufferObj: TVersionCallback;
419	begin
420	version.Clear;
421	bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
422	try
423	with FFirebird30ClientAPI do
424	begin
425	UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
426	Check4DataBaseError;
427	end;
428	finally
429	bufferObj.Free;
430	end;
431	end;
432
433	function TFB30Attachment.HasDecFloatSupport: boolean;
434	begin
435	Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
436	(GetODSMajorVersion >= 13);
437	end;
438
439	function TFB30Attachment.HasBatchMode: boolean;
440	begin
441	Result := FFirebird30ClientAPI.Firebird4orLater and
442	(GetODSMajorVersion >= 13);
443	end;
444
445	function TFB30Attachment.HasScollableCursors: boolean;
446	begin
447	Result := (GetODSMajorVersion >= 12);
448	end;
449
450	function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
451	begin
452	if not HasTimeZoneSupport then
453	IBError(ibxeNotSupported,[]);
454
455	if FTimeZoneServices = nil then
456	FTimeZoneServices := TFB30TimeZoneServices.Create(self);
457	Result := FTimeZoneServices;
458	end;
459
460	function TFB30Attachment.HasTimeZoneSupport: boolean;
461	begin
462	Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
463	(GetODSMajorVersion >= 13);
464	end;
465
466	end.
467