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;
    function GetAttachment: IAttachment; 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; aName: AnsiString=''): ITransaction; override;
    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): 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;

function TFB30Attachment.GetAttachment: IAttachment;
begin
  Result := self;
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
  inherited Disconnect(Force);
  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;
      EndSession(false);
      FAttachmentIntf.dropDatabase(StatusIntf);
      Check4DataBaseError;
      FAttachmentIntf := nil;
    end;
end;

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

function TFB30Attachment.StartTransaction(TPB: ITPB;
  DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
begin
  CheckHandle;
  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion,aName);
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:	363
Committed:	Tue Dec 7 13:30:05 2021 UTC (2 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	15473 byte(s)
Log Message:	add fbintf
#	User	Rev	Content
1	tony	45	(*
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	tony	56	{$IFDEF MSWINDOWS}
29			{$DEFINE WINDOWS}
30			{$ENDIF}
31	tony	45
32			{$IFDEF FPC}
33	tony	56	{$mode delphi}
34	tony	45	{$interfaces COM}
35			{$ENDIF}
36
37			interface
38
39			uses
40	tony	315	Classes, SysUtils, FBAttachment, FBClientAPI, FB30ClientAPI, Firebird, IB,
41			FBActivityMonitor, FBParamBlock;
42	tony	45
43			type
44
45			{ TFB30Attachment }
46
47			TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
48			private
49			FAttachmentIntf: Firebird.IAttachment;
50	tony	263	FFirebird30ClientAPI: TFB30ClientAPI;
51	tony	315	FTimeZoneServices: ITimeZoneServices;
52			FUsingRemoteICU: boolean;
53			procedure SetUseRemoteICU(aValue: boolean);
54	tony	45	protected
55			procedure CheckHandle; override;
56	tony	363	function GetAttachment: IAttachment; override;
57	tony	45	public
58	tony	263	constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
59	tony	45	RaiseExceptionOnConnectError: boolean);
60	tony	263	constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
61			constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
62	tony	47	RaiseExceptionOnError: boolean); overload;
63	tony	45	destructor Destroy; override;
64	tony	143	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
65			override;
66	tony	45	property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
67	tony	263	property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
68	tony	45
69			public
70			{IAttachment}
71			procedure Connect;
72			procedure Disconnect(Force: boolean=false); override;
73	tony	117	function IsConnected: boolean; override;
74	tony	45	procedure DropDatabase;
75	tony	363	function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
76			function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
77	tony	56	procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
78	tony	350	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
79	tony	56	function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
80	tony	270	aSQLDialect: integer; GenerateParamNames: boolean=false;
81	tony	350	CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
82	tony	45
83			{Events}
84			function GetEventHandler(Events: TStrings): IEvents; override;
85
86			{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
87
88	tony	291	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
89	tony	45	function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
90	tony	56	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
91	tony	45
92			{Array}
93	tony	291	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
94			function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
95	tony	56	function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
96			columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
97	tony	263	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
98	tony	45
99	tony	47
100	tony	45	{Database Information}
101	tony	291	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
102			function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
103	tony	266	procedure getFBVersion(version: TStrings);
104	tony	315	function HasDecFloatSupport: boolean; override;
105	tony	345	function HasBatchMode: boolean; override;
106	tony	352	function HasScollableCursors: boolean;
107	tony	315
108			{Time Zone Support}
109			function GetTimeZoneServices: ITimeZoneServices; override;
110			function HasTimeZoneSupport: boolean; override;
111	tony	45	end;
112
113			implementation
114
115			uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
116	tony	315	FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
117	tony	45
118	tony	266	type
119			{ TVersionCallback }
120
121			TVersionCallback = class(Firebird.IVersionCallbackImpl)
122			private
123			FOutput: TStrings;
124	tony	315	FFirebirdClientAPI: TFBClientAPI;
125	tony	266	public
126	tony	315	constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
127	tony	266	procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
128			end;
129
130			{ TVersionCallback }
131
132	tony	315	constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
133			output: TStrings);
134	tony	266	begin
135			inherited Create;
136	tony	315	FFirebirdClientAPI := FirebirdClientAPI;
137	tony	266	FOutput := output;
138			end;
139
140			procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
141	tony	315	var StatusObj: TFB30StatusObject;
142	tony	266	begin
143	tony	315	if ((status.getState and status.STATE_ERRORS) <> 0) then
144			begin
145			StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
146			try
147			raise EIBInterBaseError.Create(StatusObj);
148			finally
149			StatusObj.Free;
150			end;
151			end;
152	tony	266	FOutput.Add(text);
153			end;
154
155
156	tony	45	{ TFB30Attachment }
157
158	tony	315	procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
159			begin
160			if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
161			begin
162			if aValue then
163			ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
164			else
165			ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
166			FUsingRemoteICU := aValue;
167			end;
168			end;
169
170	tony	45	procedure TFB30Attachment.CheckHandle;
171			begin
172			if FAttachmentIntf = nil then
173			IBError(ibxeDatabaseClosed,[nil]);
174			end;
175
176	tony	363	function TFB30Attachment.GetAttachment: IAttachment;
177			begin
178			Result := self;
179			end;
180
181	tony	263	constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
182	tony	45	RaiseExceptionOnConnectError: boolean);
183			begin
184	tony	263	FFirebird30ClientAPI := api;
185	tony	45	if aDPB = nil then
186			begin
187			if RaiseExceptionOnConnectError then
188			IBError(ibxeNoDPB,[nil]);
189			Exit;
190			end;
191	tony	263	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
192	tony	45	Connect;
193			end;
194
195	tony	263	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
196	tony	45	RaiseExceptionOnError: boolean);
197			var Param: IDPBItem;
198	tony	56	sql: AnsiString;
199	tony	45	IsCreateDB: boolean;
200			begin
201	tony	263	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
202			FFirebird30ClientAPI := api;
203	tony	45	IsCreateDB := true;
204			if aDPB <> nil then
205			begin
206			Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
207			if Param <> nil then
208			FSQLDialect := Param.AsByte;
209			end;
210			sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
211	tony	263	with FFirebird30ClientAPI do
212	tony	45	begin
213			FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
214			PAnsiChar(sql),FSQLDialect,@IsCreateDB);
215			if FRaiseExceptionOnConnectError then Check4DataBaseError;
216			if InErrorState then
217			FAttachmentIntf := nil
218			else
219			if aDPB <> nil then
220			{Connect using known parameters}
221			begin
222			Disconnect;
223			Connect;
224	tony	117	end
225			else
226			GetODSAndConnectionInfo;
227	tony	45	end;
228			end;
229
230	tony	263	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
231	tony	47	RaiseExceptionOnError: boolean);
232			var IsCreateDB: boolean;
233			begin
234	tony	263	inherited Create(api,'',nil,RaiseExceptionOnError);
235			FFirebird30ClientAPI := api;
236	tony	47	FSQLDialect := aSQLDialect;
237	tony	263	with FFirebird30ClientAPI do
238	tony	47	begin
239			FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
240			PAnsiChar(sql),aSQLDialect,@IsCreateDB);
241			if FRaiseExceptionOnConnectError then Check4DataBaseError;
242			if InErrorState then
243			FAttachmentIntf := nil;
244			end;
245	tony	117	GetODSAndConnectionInfo;
246			ExtractConnectString(sql,FDatabaseName);
247			DPBFromCreateSQL(sql);
248	tony	47	end;
249
250	tony	45	destructor TFB30Attachment.Destroy;
251			begin
252			inherited Destroy;
253			if assigned(FAttachmentIntf) then
254			FAttachmentIntf.release;
255			end;
256
257	tony	143	function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
258			begin
259	tony	263	Result := TDBInformation.Create(Firebird30ClientAPI);
260			with FFirebird30ClientAPI, Result as TDBInformation do
261	tony	143	begin
262			FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
263			getBufSize, BytePtr(Buffer));
264			Check4DataBaseError;
265			end
266			end;
267
268	tony	45	procedure TFB30Attachment.Connect;
269			begin
270	tony	263	with FFirebird30ClientAPI do
271	tony	45	begin
272			FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
273			(DPB as TDPB).getDataLength,
274			BytePtr((DPB as TDPB).getBuffer));
275			if FRaiseExceptionOnConnectError then Check4DataBaseError;
276			if InErrorState then
277			FAttachmentIntf := nil
278			else
279	tony	117	GetODSAndConnectionInfo;
280	tony	315
281	tony	45	end;
282			end;
283
284			procedure TFB30Attachment.Disconnect(Force: boolean);
285			begin
286	tony	363	inherited Disconnect(Force);
287	tony	45	if IsConnected then
288	tony	263	with FFirebird30ClientAPI do
289	tony	45	begin
290			EndAllTransactions;
291			FAttachmentIntf.Detach(StatusIntf);
292			if not Force and InErrorState then
293			IBDataBaseError;
294			FAttachmentIntf := nil;
295			FHasDefaultCharSet := false;
296			FCodePage := CP_NONE;
297			FCharSetID := 0;
298	tony	315	FTimeZoneServices := nil;
299	tony	45	end;
300			end;
301
302			function TFB30Attachment.IsConnected: boolean;
303			begin
304			Result := FAttachmentIntf <> nil;
305			end;
306
307			procedure TFB30Attachment.DropDatabase;
308			begin
309			if IsConnected then
310	tony	263	with FFirebird30ClientAPI do
311	tony	45	begin
312			EndAllTransactions;
313	tony	363	EndSession(false);
314	tony	45	FAttachmentIntf.dropDatabase(StatusIntf);
315			Check4DataBaseError;
316			FAttachmentIntf := nil;
317			end;
318			end;
319
320			function TFB30Attachment.StartTransaction(TPB: array of byte;
321	tony	363	DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
322	tony	45	begin
323			CheckHandle;
324	tony	363	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion, aName);
325	tony	45	end;
326
327			function TFB30Attachment.StartTransaction(TPB: ITPB;
328	tony	363	DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
329	tony	45	begin
330			CheckHandle;
331	tony	363	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion,aName);
332	tony	45	end;
333
334	tony	56	procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
335	tony	45	aSQLDialect: integer);
336			begin
337			CheckHandle;
338	tony	263	with FFirebird30ClientAPI do
339	tony	45	begin
340			FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
341	tony	56	Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
342	tony	45	Check4DataBaseError;
343			end;
344			end;
345
346	tony	56	function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
347	tony	350	aSQLDialect: integer; CursorName: AnsiString): IStatement;
348	tony	45	begin
349			CheckHandle;
350	tony	350	Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
351	tony	45	end;
352
353			function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
354	tony	270	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
355	tony	350	CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
356	tony	45	begin
357			CheckHandle;
358			Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
359	tony	350	GenerateParamNames,CaseSensitiveParams,CursorName);
360	tony	45	end;
361
362			function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
363			begin
364			CheckHandle;
365			Result := TFB30Events.Create(self,Events);
366			end;
367
368			function TFB30Attachment.CreateBlob(transaction: ITransaction;
369			BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
370			begin
371			CheckHandle;
372			Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
373			end;
374
375			function TFB30Attachment.CreateBlob(transaction: ITransaction;
376			SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
377			begin
378			CheckHandle;
379			Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
380			end;
381
382			function TFB30Attachment.OpenBlob(transaction: ITransaction;
383			BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
384			begin
385			CheckHandle;
386			Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
387			end;
388
389	tony	291	function TFB30Attachment.OpenArray(transaction: ITransaction;
390			ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
391	tony	45	begin
392			CheckHandle;
393			Result := TFB30Array.Create(self,transaction as TFB30Transaction,
394	tony	291	ArrayMetaData,ArrayID);
395	tony	45	end;
396
397			function TFB30Attachment.CreateArray(transaction: ITransaction;
398			ArrayMetaData: IArrayMetaData): IArray;
399			begin
400			CheckHandle;
401			Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
402			end;
403
404	tony	56	function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
405	tony	47	Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
406			bounds: TArrayBounds): IArrayMetaData;
407			begin
408	tony	60	Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
409	tony	47	end;
410
411	tony	45	function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
412	tony	56	columnName: AnsiString): IBlobMetaData;
413	tony	45	begin
414			CheckHandle;
415			Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
416			end;
417
418			function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
419	tony	56	columnName: AnsiString): IArrayMetaData;
420	tony	45	begin
421			CheckHandle;
422			Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
423			end;
424
425	tony	266	procedure TFB30Attachment.getFBVersion(version: TStrings);
426			var bufferObj: TVersionCallback;
427			begin
428	tony	267	version.Clear;
429	tony	315	bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
430	tony	266	try
431			with FFirebird30ClientAPI do
432	tony	267	begin
433	tony	266	UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
434	tony	267	Check4DataBaseError;
435			end;
436	tony	266	finally
437			bufferObj.Free;
438			end;
439			end;
440
441	tony	315	function TFB30Attachment.HasDecFloatSupport: boolean;
442			begin
443			Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
444			(GetODSMajorVersion >= 13);
445			end;
446
447	tony	345	function TFB30Attachment.HasBatchMode: boolean;
448			begin
449			Result := FFirebird30ClientAPI.Firebird4orLater and
450			(GetODSMajorVersion >= 13);
451			end;
452
453	tony	352	function TFB30Attachment.HasScollableCursors: boolean;
454			begin
455	tony	359	Result := (GetODSMajorVersion >= 12);
456	tony	352	end;
457
458	tony	315	function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
459			begin
460			if not HasTimeZoneSupport then
461			IBError(ibxeNotSupported,[]);
462
463			if FTimeZoneServices = nil then
464			FTimeZoneServices := TFB30TimeZoneServices.Create(self);
465			Result := FTimeZoneServices;
466			end;
467
468			function TFB30Attachment.HasTimeZoneSupport: boolean;
469			begin
470			Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
471			(GetODSMajorVersion >= 13);
472			end;
473
474	tony	45	end.
475