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;
    FOwnsAttachmentHandle: boolean;
    procedure SetAttachmentIntf(AValue: Firebird.IAttachment);
    procedure SetUseRemoteICU(aValue: boolean);
  protected
    procedure CheckHandle; override;
    function GetAttachment: IAttachment; override;
  public
    constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
          RaiseExceptionOnConnectError: boolean); overload;
    constructor Create(api: TFB30ClientAPI;
      attachment: Firebird.IAttachment; aDatabaseName: AnsiString); overload;
    constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
    constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
      RaiseExceptionOnError: boolean); overload;
    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
      override;
    property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf write SetAttachmentIntf;
    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.SetAttachmentIntf(AValue: Firebird.IAttachment);
begin
  if FAttachmentIntf = AValue then Exit;
  if FAttachmentIntf <> nil then
  try
    FAttachmentIntf.release;
  except {ignore - forced release}
  end;
  FOwnsAttachmentHandle := false;
  FHasDefaultCharSet := false;
  FCodePage := CP_NONE;
  FCharSetID := 0;
  FTimeZoneServices := nil;
  FAttachmentIntf := AValue;
  if FAttachmentIntf <> nil then
  begin
    FAttachmentIntf.AddRef;
    GetODSAndConnectionInfo;
  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;
    Intf: Firebird.IAttachment;
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
    Intf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
                                       PAnsiChar(sql),FSQLDialect,@IsCreateDB);
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if not InErrorState then
    begin
      if aDPB <> nil then
      {Connect using known parameters}
      begin
        Intf.Detach(StatusIntf); {releases interface}
        Check4DataBaseError;
        Connect;
      end
      else
        AttachmentIntf := Intf;
      FOwnsAttachmentHandle:= true;
    end;
  end;
end;

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

constructor TFB30Attachment.Create(api: TFB30ClientAPI;
  attachment: Firebird.IAttachment; aDatabaseName: AnsiString);
begin
  inherited Create(api,aDatabaseName,nil,false);
  FFirebird30ClientAPI := api;
  AttachmentIntf := attachment;
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;
var Intf: Firebird.IAttachment;
begin
  with FFirebird30ClientAPI do
  begin
    Intf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
                         (DPB as TDPB).getDataLength,
                         BytePtr((DPB as TDPB).getBuffer));
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if not InErrorState then
    begin
      AttachmentIntf := Intf;
      FOwnsAttachmentHandle := true;
    end;
  end;
end;

procedure TFB30Attachment.Disconnect(Force: boolean);
begin
  inherited Disconnect(Force);
  if IsConnected then
  begin
    if FOwnsAttachmentHandle then
    with FFirebird30ClientAPI do
    begin
      EndAllTransactions;
      FAttachmentIntf.Detach(StatusIntf);
      if not Force and InErrorState then
        IBDataBaseError;
    end;
    AttachmentIntf := nil;
  end;
end;

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

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