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 FPC}
{$mode objfpc}{$H+}
{$interfaces COM}
{$ENDIF}

interface

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

type

  { TFB30Attachment }

  TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
  private
    FAttachmentIntf: Firebird.IAttachment;
  protected
    procedure CheckHandle; override;
  public
    constructor Create(DatabaseName: string; aDPB: IDPB;
          RaiseExceptionOnConnectError: boolean);
    constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
    constructor CreateDatabase(sql: string; aSQLDialect: integer;
      RaiseExceptionOnError: boolean); overload;
    destructor Destroy; override;
    property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;

  public
    {IAttachment}
    procedure Connect;
    procedure Disconnect(Force: boolean=false); override;
    function IsConnected: boolean;
    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: string; aSQLDialect: integer); override;
    function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; override;
    function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
                       aSQLDialect: integer; GenerateParamNames: boolean=false): 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; RelationName, ColumnName: string; BPB: IBPB=nil): IBlob; overload;
    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
    function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
    function OpenBlob(transaction: ITransaction; RelationName, ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
    function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; override; overload;

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


    {Database Information}
    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
    function GetDBInformation(Requests: array of byte): IDBInformation; overload;
    function GetDBInformation(Request: byte): IDBInformation; overload;
  end;

implementation

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

{ TFB30Attachment }

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

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

constructor TFB30Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
  RaiseExceptionOnError: boolean);
var Param: IDPBItem;
    sql: string;
    IsCreateDB: boolean;
begin
  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
  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 Firebird30ClientAPI 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;
  end;
end;

constructor TFB30Attachment.CreateDatabase(sql: string; aSQLDialect: integer;
  RaiseExceptionOnError: boolean);
var IsCreateDB: boolean;
    info: IDBInformation;
    ConnectionType: integer;
    SiteName: string;
begin
  inherited Create('',nil,RaiseExceptionOnError);
  FSQLDialect := aSQLDialect;
  with Firebird30ClientAPI do
  begin
    FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
                                       PAnsiChar(sql),aSQLDialect,@IsCreateDB);
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil;
    FCharSetID := 0;
    FCodePage := CP_NONE;
    FHasDefaultCharSet := false;
    info := GetDBInformation(isc_info_db_id);
    info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
  end;
end;

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

procedure TFB30Attachment.Connect;
var Param: IDPBItem;
begin
  with Firebird30ClientAPI 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
    begin
      Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
      if Param <> nil then
        FSQLDialect := Param.AsByte;
      Param :=  DPB.Find(isc_dpb_lc_ctype);
      FHasDefaultCharSet :=  (Param <> nil) and
                             CharSetName2CharSetID(Param.AsString,FCharSetID) and
                             CharSetID2CodePage(FCharSetID,FCodePage) and
                             (FCharSetID > 1);
    end;
  end;
end;

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

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

procedure TFB30Attachment.DropDatabase;
begin
  if IsConnected then
    with Firebird30ClientAPI 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(self,TPB,DefaultCompletion);
end;

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

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

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

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

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

function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
  ColumnName: string; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
              TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
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; RelationName,
  ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30transaction,
                TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
                BlobID,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; RelationName,
  ColumnName: string; ArrayID: TISC_QUAD): IArray;
begin
  CheckHandle;
  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
                    GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
end;

function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
  ColumnName: string): IArray;
begin
  CheckHandle;
  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
                    GetArrayMetaData(transaction,RelationName,ColumnName));
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: string; columnName: string;
  Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
  bounds: TArrayBounds): IArrayMetaData;
begin
  Result := TFB30ArrayMetaData.Create(SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
end;

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

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

function TFB30Attachment.GetDBInformation(Requests: array of byte
  ): IDBInformation;
var ReqBuffer: PByte;
    i: integer;
begin
  CheckHandle;
  if Length(Requests) = 1 then
    Result := GetDBInformation(Requests[0])
  else
  begin
    Result := TDBInformation.Create;
    GetMem(ReqBuffer,Length(Requests));
    try
      for i := 0 to Length(Requests) - 1 do
        ReqBuffer[i] := Requests[i];

      with Firebird30ClientAPI, Result as TDBInformation do
      begin
        FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
                                 getBufSize, BytePtr(Buffer));
          Check4DataBaseError;
      end

    finally
      FreeMem(ReqBuffer);
    end;
  end;
end;

function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
begin
  CheckHandle;
  Result := TDBInformation.Create;
  with Firebird30ClientAPI, Result as TDBInformation do
  begin
    FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
                           getBufSize, BytePtr(Buffer));
      Check4DataBaseError;
  end;
end;

end.

Revision:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 3 months ago) by tony
Content type:	text/x-pascal
Original Path:	*ibx/trunk/fbintf/client/3.0/FB30Attachment.pas*
File size:	13917 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	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
29			{$IFDEF FPC}
30			{$mode objfpc}{$H+}
31			{$interfaces COM}
32			{$ENDIF}
33
34			interface
35
36			uses
37			Classes, SysUtils, FBAttachment, FB30ClientAPI, Firebird, IB, FBActivityMonitor, FBParamBlock;
38
39			type
40
41			{ TFB30Attachment }
42
43			TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
44			private
45			FAttachmentIntf: Firebird.IAttachment;
46			protected
47			procedure CheckHandle; override;
48			public
49			constructor Create(DatabaseName: string; aDPB: IDPB;
50			RaiseExceptionOnConnectError: boolean);
51	tony	47	constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
52			constructor CreateDatabase(sql: string; aSQLDialect: integer;
53			RaiseExceptionOnError: boolean); overload;
54	tony	45	destructor Destroy; override;
55			property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
56
57			public
58			{IAttachment}
59			procedure Connect;
60			procedure Disconnect(Force: boolean=false); override;
61			function IsConnected: boolean;
62			procedure DropDatabase;
63			function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
64			function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
65			procedure ExecImmediate(transaction: ITransaction; sql: string; aSQLDialect: integer); override;
66			function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; override;
67			function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
68			aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
69
70			{Events}
71			function GetEventHandler(Events: TStrings): IEvents; override;
72
73			{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
74
75			function CreateBlob(transaction: ITransaction; RelationName, ColumnName: string; BPB: IBPB=nil): IBlob; overload;
76			function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
77			function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
78			function OpenBlob(transaction: ITransaction; RelationName, ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
79			function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; override; overload;
80
81			{Array}
82			function OpenArray(transaction: ITransaction; RelationName, ColumnName: string; ArrayID: TISC_QUAD): IArray;
83			function CreateArray(transaction: ITransaction; RelationName, ColumnName: string): IArray; overload;
84			function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
85	tony	47	function CreateArrayMetaData(SQLType: cardinal; tableName: string;
86			columnName: string; Scale: integer; size: cardinal; aCharSetID: cardinal;
87			dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
88	tony	45
89	tony	47
90	tony	45	{Database Information}
91			function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
92			function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
93			function GetDBInformation(Requests: array of byte): IDBInformation; overload;
94			function GetDBInformation(Request: byte): IDBInformation; overload;
95			end;
96
97			implementation
98
99			uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
100			FBOutputBlock, FB30Events;
101
102			{ TFB30Attachment }
103
104			procedure TFB30Attachment.CheckHandle;
105			begin
106			if FAttachmentIntf = nil then
107			IBError(ibxeDatabaseClosed,[nil]);
108			end;
109
110			constructor TFB30Attachment.Create(DatabaseName: string; aDPB: IDPB;
111			RaiseExceptionOnConnectError: boolean);
112			begin
113			if aDPB = nil then
114			begin
115			if RaiseExceptionOnConnectError then
116			IBError(ibxeNoDPB,[nil]);
117			Exit;
118			end;
119			inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
120			Connect;
121			end;
122
123			constructor TFB30Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
124			RaiseExceptionOnError: boolean);
125			var Param: IDPBItem;
126			sql: string;
127			IsCreateDB: boolean;
128			begin
129			inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
130			IsCreateDB := true;
131			if aDPB <> nil then
132			begin
133			Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
134			if Param <> nil then
135			FSQLDialect := Param.AsByte;
136			end;
137			sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
138			with Firebird30ClientAPI do
139			begin
140			FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
141			PAnsiChar(sql),FSQLDialect,@IsCreateDB);
142			if FRaiseExceptionOnConnectError then Check4DataBaseError;
143			if InErrorState then
144			FAttachmentIntf := nil
145			else
146			if aDPB <> nil then
147			{Connect using known parameters}
148			begin
149			Disconnect;
150			Connect;
151			end;
152			end;
153			end;
154
155	tony	47	constructor TFB30Attachment.CreateDatabase(sql: string; aSQLDialect: integer;
156			RaiseExceptionOnError: boolean);
157			var IsCreateDB: boolean;
158			info: IDBInformation;
159			ConnectionType: integer;
160			SiteName: string;
161			begin
162			inherited Create('',nil,RaiseExceptionOnError);
163			FSQLDialect := aSQLDialect;
164			with Firebird30ClientAPI do
165			begin
166			FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
167			PAnsiChar(sql),aSQLDialect,@IsCreateDB);
168			if FRaiseExceptionOnConnectError then Check4DataBaseError;
169			if InErrorState then
170			FAttachmentIntf := nil;
171			FCharSetID := 0;
172			FCodePage := CP_NONE;
173			FHasDefaultCharSet := false;
174			info := GetDBInformation(isc_info_db_id);
175			info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
176			end;
177			end;
178
179	tony	45	destructor TFB30Attachment.Destroy;
180			begin
181			inherited Destroy;
182			if assigned(FAttachmentIntf) then
183			FAttachmentIntf.release;
184			end;
185
186			procedure TFB30Attachment.Connect;
187			var Param: IDPBItem;
188			begin
189			with Firebird30ClientAPI do
190			begin
191			FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
192			(DPB as TDPB).getDataLength,
193			BytePtr((DPB as TDPB).getBuffer));
194			if FRaiseExceptionOnConnectError then Check4DataBaseError;
195			if InErrorState then
196			FAttachmentIntf := nil
197			else
198			begin
199			Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
200			if Param <> nil then
201			FSQLDialect := Param.AsByte;
202			Param := DPB.Find(isc_dpb_lc_ctype);
203			FHasDefaultCharSet := (Param <> nil) and
204			CharSetName2CharSetID(Param.AsString,FCharSetID) and
205			CharSetID2CodePage(FCharSetID,FCodePage) and
206			(FCharSetID > 1);
207			end;
208			end;
209			end;
210
211			procedure TFB30Attachment.Disconnect(Force: boolean);
212			begin
213			if IsConnected then
214			with Firebird30ClientAPI do
215			begin
216			EndAllTransactions;
217			FAttachmentIntf.Detach(StatusIntf);
218			if not Force and InErrorState then
219			IBDataBaseError;
220			FAttachmentIntf := nil;
221			FHasDefaultCharSet := false;
222			FCodePage := CP_NONE;
223			FCharSetID := 0;
224			end;
225			end;
226
227			function TFB30Attachment.IsConnected: boolean;
228			begin
229			Result := FAttachmentIntf <> nil;
230			end;
231
232			procedure TFB30Attachment.DropDatabase;
233			begin
234			if IsConnected then
235			with Firebird30ClientAPI do
236			begin
237			EndAllTransactions;
238			FAttachmentIntf.dropDatabase(StatusIntf);
239			Check4DataBaseError;
240			FAttachmentIntf := nil;
241			end;
242			end;
243
244			function TFB30Attachment.StartTransaction(TPB: array of byte;
245			DefaultCompletion: TTransactionCompletion): ITransaction;
246			begin
247			CheckHandle;
248			Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
249			end;
250
251			function TFB30Attachment.StartTransaction(TPB: ITPB;
252			DefaultCompletion: TTransactionCompletion): ITransaction;
253			begin
254			CheckHandle;
255			Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
256			end;
257
258			procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: string;
259			aSQLDialect: integer);
260			begin
261			CheckHandle;
262			with Firebird30ClientAPI do
263			begin
264			FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
265			Length(sql),PChar(sql),aSQLDialect,nil,nil,nil,nil);
266			Check4DataBaseError;
267			end;
268			end;
269
270			function TFB30Attachment.Prepare(transaction: ITransaction; sql: string;
271			aSQLDialect: integer): IStatement;
272			begin
273			CheckHandle;
274			Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
275			end;
276
277			function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
278			sql: string; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
279			begin
280			CheckHandle;
281			Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
282			GenerateParamNames);
283			end;
284
285			function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
286			begin
287			CheckHandle;
288			Result := TFB30Events.Create(self,Events);
289			end;
290
291			function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
292			ColumnName: string; BPB: IBPB): IBlob;
293			begin
294			CheckHandle;
295			Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
296			TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
297			end;
298
299			function TFB30Attachment.CreateBlob(transaction: ITransaction;
300			BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
301			begin
302			CheckHandle;
303			Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
304			end;
305
306			function TFB30Attachment.CreateBlob(transaction: ITransaction;
307			SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
308			begin
309			CheckHandle;
310			Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
311			end;
312
313			function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
314			ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
315			begin
316			CheckHandle;
317			Result := TFB30Blob.Create(self,transaction as TFB30transaction,
318			TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
319			BlobID,BPB);
320			end;
321
322			function TFB30Attachment.OpenBlob(transaction: ITransaction;
323			BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
324			begin
325			CheckHandle;
326			Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
327			end;
328
329			function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
330			ColumnName: string; ArrayID: TISC_QUAD): IArray;
331			begin
332			CheckHandle;
333			Result := TFB30Array.Create(self,transaction as TFB30Transaction,
334			GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
335			end;
336
337			function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
338			ColumnName: string): IArray;
339			begin
340			CheckHandle;
341			Result := TFB30Array.Create(self,transaction as TFB30Transaction,
342			GetArrayMetaData(transaction,RelationName,ColumnName));
343			end;
344
345			function TFB30Attachment.CreateArray(transaction: ITransaction;
346			ArrayMetaData: IArrayMetaData): IArray;
347			begin
348			CheckHandle;
349			Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
350			end;
351
352	tony	47	function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: string; columnName: string;
353			Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
354			bounds: TArrayBounds): IArrayMetaData;
355			begin
356			Result := TFB30ArrayMetaData.Create(SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
357			end;
358
359	tony	45	function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
360			columnName: string): IBlobMetaData;
361			begin
362			CheckHandle;
363			Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
364			end;
365
366			function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
367			columnName: string): IArrayMetaData;
368			begin
369			CheckHandle;
370			Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
371			end;
372
373			function TFB30Attachment.GetDBInformation(Requests: array of byte
374			): IDBInformation;
375			var ReqBuffer: PByte;
376			i: integer;
377			begin
378			CheckHandle;
379			if Length(Requests) = 1 then
380			Result := GetDBInformation(Requests[0])
381			else
382			begin
383			Result := TDBInformation.Create;
384			GetMem(ReqBuffer,Length(Requests));
385			try
386			for i := 0 to Length(Requests) - 1 do
387			ReqBuffer[i] := Requests[i];
388
389			with Firebird30ClientAPI, Result as TDBInformation do
390			begin
391			FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
392			getBufSize, BytePtr(Buffer));
393			Check4DataBaseError;
394			end
395
396			finally
397			FreeMem(ReqBuffer);
398			end;
399			end;
400			end;
401
402			function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
403			begin
404			CheckHandle;
405			Result := TDBInformation.Create;
406			with Firebird30ClientAPI, Result as TDBInformation do
407			begin
408			FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
409			getBufSize, BytePtr(Buffer));
410			Check4DataBaseError;
411			end;
412			end;
413
414			end.
415