ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/fbintf/client/2.5/FB25Attachment.pas

Comparing ibx/trunk/fbintf/client/2.5/FB25Attachment.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FB25Attachment;
28	+	{$IFDEF MSWINDOWS}
29	+	{$DEFINE WINDOWS}
30	+	{$ENDIF}
31
32		{$IFDEF FPC}
33	<	{$mode objfpc}{$H+}
33	>	{$mode delphi}
34		{$interfaces COM}
35		{$ENDIF}
36
#	Line 35 | Line 38 | interface
38
39		uses
40		Classes, SysUtils, IB,  FBAttachment, FB25ClientAPI, IBHeader,
41	<	FBParamBlock, FBOutputBlock, FBActivityMonitor, IBExternals;
41	>	FBParamBlock, FBOutputBlock, FBActivityMonitor;
42
43		type
44		{ TFB25Attachment }
#	Line 43 | Line 46 | type
46		TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
47		private
48		FHandle: TISC_DB_HANDLE;
49	+	FFirebird25ClientAPI: TFB25ClientAPI;
50		protected
51		procedure CheckHandle; override;
52		public
53	<	constructor Create(DatabaseName: string; aDPB: IDPB;
53	>	constructor Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54		RaiseExceptionOnConnectError: boolean);
55	<	constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56	<	constructor CreateDatabase(sql: string; aSQLDialect: integer;
55	>	constructor CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56	>	constructor CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
57		RaiseExceptionOnError: boolean); overload;
58	+	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; override;
59		property Handle: TISC_DB_HANDLE read FHandle;
60	+	property Firebird25ClientAPI: TFB25ClientAPI read FFirebird25ClientAPI;
61
62		public
63		{IAttachment}
64		procedure Connect;
65		procedure Disconnect(Force: boolean=false); override;
66	<	function IsConnected: boolean;
66	>	function IsConnected: boolean; override;
67		procedure DropDatabase;
68		function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
69		function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
70	<	procedure ExecImmediate(transaction: ITransaction; sql: string; aSQLDialect: integer); override;
71	<	function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; override;
72	<	function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
73	<	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
70	>	procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
71	>	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
72	>	function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
73	>	aSQLDialect: integer; GenerateParamNames: boolean=false;
74	>	CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
75		function GetEventHandler(Events: TStrings): IEvents; override;
76	<	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: string; BPB: IBPB=nil): IBlob; overload;
70	<	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
76	>	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
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;
73	<	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; override; overload;
78	>	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
79
80	<	function OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
81	<	ArrayID: TISC_QUAD): IArray;
82	<	function CreateArray(transaction: ITransaction; RelationName, ColumnName: string
78	<	): IArray; overload;
79	<	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
80	<	function CreateArrayMetaData(SQLType: cardinal; tableName: string; columnName: string;
80	>	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
81	>	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
82	>	function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
83		Scale: integer; size: cardinal;
84		acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
85		): IArrayMetaData;
86
87		{Database Information}
88
89	<	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
90	<	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
91	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
90	<	function GetDBInformation(Request: byte): IDBInformation; overload;
89	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
90	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
91	>	procedure getFBVersion(version: TStrings);
92		end;
93
94		implementation
95
96		uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
97	<	FB25Statement, FB25Array;
97	>	FB25Statement, FB25Array, IBUtils, IBExternals;
98
99		{ TFB25Attachment }
100
#	Line 103 | Line 104 | begin
104		IBError(ibxeDatabaseClosed,[nil]);
105		end;
106
107	<	constructor TFB25Attachment.Create(DatabaseName: string; aDPB: IDPB;
107	>	constructor TFB25Attachment.Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
108		RaiseExceptionOnConnectError: boolean);
109		begin
110	+	FFirebird25ClientAPI := api;
111		if aDPB = nil then
112		begin
113		if RaiseExceptionOnConnectError then
114		IBError(ibxeNoDPB,[nil]);
115		Exit;
116		end;
117	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
117	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
118		Connect;
119		end;
120
121	<	constructor TFB25Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
121	>	constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
122		RaiseExceptionOnError: boolean);
123	<	var sql: string;
123	>	var sql: AnsiString;
124		tr_handle: TISC_TR_HANDLE;
125		begin
126	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
126	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
127	>	FFirebird25ClientAPI := api;
128		sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
129		tr_handle := nil;
130	<	with Firebird25ClientAPI do
131	<	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
130	>	with FFirebird25ClientAPI do
131	>	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
132		SQLDialect, nil) > 0) and RaiseExceptionOnError then
133		IBDataBaseError;
134		if DPB <> nil then
#	Line 133 | Line 136 | begin
136		begin
137		Disconnect;
138		Connect;
139	<	end;
139	>	end
140	>	else
141	>	GetODSAndConnectionInfo;
142		end;
143
144	<	constructor TFB25Attachment.CreateDatabase(sql: string; aSQLDialect: integer;
144	>	constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
145		RaiseExceptionOnError: boolean);
146		var tr_handle: TISC_TR_HANDLE;
142	–	info: IDBInformation;
143	–	ConnectionType: integer;
144	–	SiteName: string;
147		begin
148	<	inherited Create('',nil,RaiseExceptionOnError);
148	>	inherited Create(api,'',nil,RaiseExceptionOnError);
149	>	FFirebird25ClientAPI := api;
150		FSQLDialect := aSQLDialect;
151		tr_handle := nil;
152	<	with Firebird25ClientAPI do
152	>	with FFirebird25ClientAPI do
153		begin
154	<	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
154	>	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
155		aSQLDialect, nil) > 0) and RaiseExceptionOnError then
156		IBDataBaseError;
157
155	–	FCharSetID := 0;
156	–	FCodePage := CP_NONE;
157	–	FHasDefaultCharSet := false;
158	–	info := GetDBInformation(isc_info_db_id);
159	–	info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
158		end;
159	+	GetODSAndConnectionInfo;
160	+	ExtractConnectString(sql,FDatabaseName);
161	+	DPBFromCreateSQL(sql);
162	+	end;
163	+
164	+	function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
165	+	): IDBInformation;
166	+	begin
167	+	Result := TDBInformation.Create(FFirebird25ClientAPI);
168	+	with FFirebird25ClientAPI, Result as TDBInformation do
169	+	if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
170	+	getBufSize, Buffer) > 0 then
171	+	IBDataBaseError;
172		end;
173
174		procedure TFB25Attachment.Connect;
164	–	var Param: IDPBItem;
175		begin
176		FSQLDialect := 3;
177
178	<	with Firebird25ClientAPI do
178	>	with FFirebird25ClientAPI do
179		if DPB = nil then
180		begin
181		if (isc_attach_database(StatusVector, Length(FDatabaseName),
182	<	PChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
182	>	PAnsiChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
183		IBDatabaseError;
184		end
185		else
186		begin
187		if (isc_attach_database(StatusVector, Length(FDatabaseName),
188	<	PChar(FDatabaseName), @FHandle,
188	>	PAnsiChar(FDatabaseName), @FHandle,
189		(DPB as TDPB).getDataLength,
190		(DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
191		IBDatabaseError;
192
183	–	if IsConnected then
184	–	begin
185	–	Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
186	–	if Param <> nil then
187	–	FSQLDialect := Param.AsByte;
188	–	Param :=  DPB.Find(isc_dpb_lc_ctype);
189	–	FHasDefaultCharSet :=  (Param <> nil) and
190	–	CharSetName2CharSetID(Param.AsString,FCharSetID) and
191	–	CharSetID2CodePage(FCharSetID,FCodePage) and
192	–	(FCharSetID > 1);
193	–	end;
193		end;
194	+	GetODSAndConnectionInfo;
195		end;
196
197		procedure TFB25Attachment.Disconnect(Force: boolean);
#	Line 201 | Line 201 | begin
201
202		EndAllTransactions;
203		{Disconnect}
204	<	with Firebird25ClientAPI do
204	>	with FFirebird25ClientAPI do
205		if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
206		IBDatabaseError;
207		FHandle := nil;
#	Line 219 | Line 219 | procedure TFB25Attachment.DropDatabase;
219		begin
220		CheckHandle;
221		EndAllTransactions;
222	<	with Firebird25ClientAPI do
222	>	with FFirebird25ClientAPI do
223		if isc_drop_database(StatusVector, @FHandle) > 0 then
224		IBDatabaseError;
225		FHandle := nil;
#	Line 229 | Line 229 | function TFB25Attachment.StartTransactio
229		DefaultCompletion: TTransactionCompletion): ITransaction;
230		begin
231		CheckHandle;
232	<	Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
232	>	Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
233		end;
234
235		function TFB25Attachment.StartTransaction(TPB: ITPB;
236		DefaultCompletion: TTransactionCompletion): ITransaction;
237		begin
238		CheckHandle;
239	<	Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
240	<	end;
241	<
242	<	function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
243	<	ColumnName: string; BPB: IBPB): IBlob;
244	<	begin
245	<	CheckHandle;
246	<	Result := TFB25Blob.Create(self,transaction as TFB25transaction,
247	<	TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),BPB);
239	>	Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
240		end;
241
242		function TFB25Attachment.CreateBlob(transaction: ITransaction;
#	Line 261 | Line 253 | begin
253		Result := TFB25Blob.Create(self,transaction as TFB25transaction,SubType,aCharSetID,BPB);
254		end;
255
264	–	function TFB25Attachment.OpenBlob(transaction: ITransaction; RelationName,
265	–	ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
266	–	begin
267	–	CheckHandle;
268	–	Result := TFB25Blob.Create(self,transaction as TFB25transaction,
269	–	TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),
270	–	BlobID,BPB);
271	–	end;
272	–
256		function TFB25Attachment.OpenBlob(transaction: ITransaction;
257		BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
258		begin
#	Line 277 | Line 260 | begin
260		Result :=  TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BlobID,BPB);
261		end;
262
263	<	procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: string;
263	>	procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
264		aSQLDialect: integer);
265		var TRHandle: TISC_TR_HANDLE;
266		begin
267		CheckHandle;
268		TRHandle := (Transaction as TFB25Transaction).Handle;
269	<	with Firebird25ClientAPI do
270	<	if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PChar(sql), aSQLDialect, nil) > 0 then
269	>	with FFirebird25ClientAPI do
270	>	if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PAnsiChar(sql), aSQLDialect, nil) > 0 then
271		IBDatabaseError;
272		SignalActivity;
273		end;
274
275	<	function TFB25Attachment.Prepare(transaction: ITransaction; sql: string;
276	<	aSQLDialect: integer): IStatement;
275	>	function TFB25Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
276	>	aSQLDialect: integer; CursorName: AnsiString): IStatement;
277		begin
278		CheckHandle;
279		Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
280		end;
281
282		function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
283	<	sql: string; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
283	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
284	>	CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
285		begin
286		CheckHandle;
287		Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
288	<	GenerateParamNames);
288	>	GenerateParamNames,CaseSensitiveParams,CursorName);
289		end;
290
291		function TFB25Attachment.GetEventHandler(Events: TStrings): IEvents;
#	Line 310 | Line 294 | begin
294		Result := TFB25Events.Create(self,Events);
295		end;
296
297	<	function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
297	>	function TFB25Attachment.OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData;
298		ArrayID: TISC_QUAD): IArray;
299		begin
300		CheckHandle;
301		Result := TFB25Array.Create(self,transaction as TFB25Transaction,
302	<	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
319	<	end;
320	<
321	<	function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: string): IArray;
322	<	begin
323	<	CheckHandle;
324	<	Result := TFB25Array.Create(self,transaction as TFB25Transaction,
325	<	GetArrayMetaData(transaction,RelationName,ColumnName));
302	>	ArrayMetaData,ArrayID);
303		end;
304
305		function TFB25Attachment.CreateArray(transaction: ITransaction;
#	Line 333 | Line 310 | begin
310		end;
311
312		function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
313	<	tableName: string; columnName: string; Scale: integer; size: cardinal;
313	>	tableName: AnsiString; columnName: AnsiString; Scale: integer; size: cardinal;
314		acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
315		): IArrayMetaData;
316		begin
317	<	Result := TFB25ArrayMetaData.Create(SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
317	>	Result := TFB25ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
318		end;
319
320		function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
321	<	columnName: string): IBlobMetaData;
321	>	columnName: AnsiString): IBlobMetaData;
322		begin
323		CheckHandle;
324		Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
325		end;
326
327		function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
328	<	columnName: string): IArrayMetaData;
328	>	columnName: AnsiString): IArrayMetaData;
329		begin
330		CheckHandle;
331		Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
332		end;
333
334	<	function TFB25Attachment.GetDBInformation(Requests: array of byte
358	<	): IDBInformation;
359	<	var ReqBuffer: PByte;
360	<	i: integer;
334	>	procedure ISCVersionCallback(userArg: pointer; text: PAnsiChar); cdecl;
335		begin
336	<	CheckHandle;
363	<	if Length(Requests) = 1 then
364	<	Result := GetDBInformation(Requests[0])
365	<	else
366	<	begin
367	<	Result := TDBInformation.Create;
368	<	GetMem(ReqBuffer,Length(Requests));
369	<	try
370	<	for i := 0 to Length(Requests) - 1 do
371	<	ReqBuffer[i] := Requests[i];
372	<
373	<	with Firebird25ClientAPI, Result as TDBInformation do
374	<	if isc_database_info(StatusVector, @(FHandle), Length(Requests), PChar(ReqBuffer),
375	<	getBufSize, Buffer) > 0 then
376	<	IBDataBaseError;
377	<
378	<	finally
379	<	FreeMem(ReqBuffer);
380	<	end;
381	<	end;
336	>	TStrings(userArg).Add(text);
337		end;
338
339	<	function TFB25Attachment.GetDBInformation(Request: byte): IDBInformation;
339	>	procedure TFB25Attachment.getFBVersion(version: TStrings);
340	>	var callback: pointer;
341		begin
342	<	CheckHandle;
343	<	Result := TDBInformation.Create;
344	<	with Firebird25ClientAPI, Result as TDBInformation do
345	<	if isc_database_info(StatusVector, @(FHandle), 1, @Request,
346	<	getBufSize, Buffer) > 0 then
391	<	IBDataBaseError;
342	>	callback := @ISCVersionCallback;
343	>	version.Clear;
344	>	with FFirebird25ClientAPI do
345	>	if isc_version(@FHandle,TISC_CALLBACK(callback),PVoid(version)) > 0 then
346	>	IBDataBaseError;
347		end;
348
349		end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines