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 263 by tony, Thu Dec 6 15:55:01 2018 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;
70	>	procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
71	>	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
72	>	function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
73		aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
74		function GetEventHandler(Events: TStrings): IEvents; override;
75	<	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: string; BPB: IBPB=nil): IBlob; overload;
75	>	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; 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;
78	>	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
79	>	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
80
81	<	function OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
81	>	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
82		ArrayID: TISC_QUAD): IArray;
83	<	function CreateArray(transaction: ITransaction; RelationName, ColumnName: string
83	>	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
84		): IArray; overload;
85		function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
86	<	function CreateArrayMetaData(SQLType: cardinal; tableName: string; columnName: string;
86	>	function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
87		Scale: integer; size: cardinal;
88		acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
89		): IArrayMetaData;
90
91		{Database Information}
92
93	<	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
94	<	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
89	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
90	<	function GetDBInformation(Request: byte): IDBInformation; overload;
93	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
94	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
95		end;
96
97		implementation
98
99		uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
100	<	FB25Statement, FB25Array;
100	>	FB25Statement, FB25Array, IBUtils;
101
102		{ TFB25Attachment }
103
#	Line 103 | Line 107 | begin
107		IBError(ibxeDatabaseClosed,[nil]);
108		end;
109
110	<	constructor TFB25Attachment.Create(DatabaseName: string; aDPB: IDPB;
110	>	constructor TFB25Attachment.Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
111		RaiseExceptionOnConnectError: boolean);
112		begin
113	+	FFirebird25ClientAPI := api;
114		if aDPB = nil then
115		begin
116		if RaiseExceptionOnConnectError then
117		IBError(ibxeNoDPB,[nil]);
118		Exit;
119		end;
120	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
120	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
121		Connect;
122		end;
123
124	<	constructor TFB25Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
124	>	constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
125		RaiseExceptionOnError: boolean);
126	<	var sql: string;
126	>	var sql: AnsiString;
127		tr_handle: TISC_TR_HANDLE;
128		begin
129	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
129	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
130	>	FFirebird25ClientAPI := api;
131		sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
132		tr_handle := nil;
133	<	with Firebird25ClientAPI do
134	<	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
133	>	with FFirebird25ClientAPI do
134	>	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
135		SQLDialect, nil) > 0) and RaiseExceptionOnError then
136		IBDataBaseError;
137		if DPB <> nil then
#	Line 133 | Line 139 | begin
139		begin
140		Disconnect;
141		Connect;
142	<	end;
142	>	end
143	>	else
144	>	GetODSAndConnectionInfo;
145		end;
146
147	<	constructor TFB25Attachment.CreateDatabase(sql: string; aSQLDialect: integer;
147	>	constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
148		RaiseExceptionOnError: boolean);
149		var tr_handle: TISC_TR_HANDLE;
142	–	info: IDBInformation;
143	–	ConnectionType: integer;
144	–	SiteName: string;
150		begin
151	<	inherited Create('',nil,RaiseExceptionOnError);
151	>	inherited Create(api,'',nil,RaiseExceptionOnError);
152	>	FFirebird25ClientAPI := api;
153		FSQLDialect := aSQLDialect;
154		tr_handle := nil;
155	<	with Firebird25ClientAPI do
155	>	with FFirebird25ClientAPI do
156		begin
157	<	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
157	>	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
158		aSQLDialect, nil) > 0) and RaiseExceptionOnError then
159		IBDataBaseError;
160
155	–	FCharSetID := 0;
156	–	FCodePage := CP_NONE;
157	–	FHasDefaultCharSet := false;
158	–	info := GetDBInformation(isc_info_db_id);
159	–	info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
161		end;
162	+	GetODSAndConnectionInfo;
163	+	ExtractConnectString(sql,FDatabaseName);
164	+	DPBFromCreateSQL(sql);
165	+	end;
166	+
167	+	function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
168	+	): IDBInformation;
169	+	begin
170	+	Result := TDBInformation.Create(FFirebird25ClientAPI);
171	+	with FFirebird25ClientAPI, Result as TDBInformation do
172	+	if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
173	+	getBufSize, Buffer) > 0 then
174	+	IBDataBaseError;
175		end;
176
177		procedure TFB25Attachment.Connect;
164	–	var Param: IDPBItem;
178		begin
179		FSQLDialect := 3;
180
181	<	with Firebird25ClientAPI do
181	>	with FFirebird25ClientAPI do
182		if DPB = nil then
183		begin
184		if (isc_attach_database(StatusVector, Length(FDatabaseName),
185	<	PChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
185	>	PAnsiChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
186		IBDatabaseError;
187		end
188		else
189		begin
190		if (isc_attach_database(StatusVector, Length(FDatabaseName),
191	<	PChar(FDatabaseName), @FHandle,
191	>	PAnsiChar(FDatabaseName), @FHandle,
192		(DPB as TDPB).getDataLength,
193		(DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
194		IBDatabaseError;
195
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;
196		end;
197	+	GetODSAndConnectionInfo;
198		end;
199
200		procedure TFB25Attachment.Disconnect(Force: boolean);
#	Line 201 | Line 204 | begin
204
205		EndAllTransactions;
206		{Disconnect}
207	<	with Firebird25ClientAPI do
207	>	with FFirebird25ClientAPI do
208		if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
209		IBDatabaseError;
210		FHandle := nil;
#	Line 219 | Line 222 | procedure TFB25Attachment.DropDatabase;
222		begin
223		CheckHandle;
224		EndAllTransactions;
225	<	with Firebird25ClientAPI do
225	>	with FFirebird25ClientAPI do
226		if isc_drop_database(StatusVector, @FHandle) > 0 then
227		IBDatabaseError;
228		FHandle := nil;
#	Line 229 | Line 232 | function TFB25Attachment.StartTransactio
232		DefaultCompletion: TTransactionCompletion): ITransaction;
233		begin
234		CheckHandle;
235	<	Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
235	>	Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
236		end;
237
238		function TFB25Attachment.StartTransaction(TPB: ITPB;
239		DefaultCompletion: TTransactionCompletion): ITransaction;
240		begin
241		CheckHandle;
242	<	Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
242	>	Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
243		end;
244
245		function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
246	<	ColumnName: string; BPB: IBPB): IBlob;
246	>	ColumnName: AnsiString; BPB: IBPB): IBlob;
247		begin
248		CheckHandle;
249		Result := TFB25Blob.Create(self,transaction as TFB25transaction,
#	Line 262 | Line 265 | begin
265		end;
266
267		function TFB25Attachment.OpenBlob(transaction: ITransaction; RelationName,
268	<	ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
268	>	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
269		begin
270		CheckHandle;
271		Result := TFB25Blob.Create(self,transaction as TFB25transaction,
#	Line 277 | Line 280 | begin
280		Result :=  TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BlobID,BPB);
281		end;
282
283	<	procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: string;
283	>	procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
284		aSQLDialect: integer);
285		var TRHandle: TISC_TR_HANDLE;
286		begin
287		CheckHandle;
288		TRHandle := (Transaction as TFB25Transaction).Handle;
289	<	with Firebird25ClientAPI do
290	<	if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PChar(sql), aSQLDialect, nil) > 0 then
289	>	with FFirebird25ClientAPI do
290	>	if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PAnsiChar(sql), aSQLDialect, nil) > 0 then
291		IBDatabaseError;
292		SignalActivity;
293		end;
294
295	<	function TFB25Attachment.Prepare(transaction: ITransaction; sql: string;
295	>	function TFB25Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
296		aSQLDialect: integer): IStatement;
297		begin
298		CheckHandle;
#	Line 297 | Line 300 | begin
300		end;
301
302		function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
303	<	sql: string; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
303	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
304		begin
305		CheckHandle;
306		Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
#	Line 310 | Line 313 | begin
313		Result := TFB25Events.Create(self,Events);
314		end;
315
316	<	function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
316	>	function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
317		ArrayID: TISC_QUAD): IArray;
318		begin
319		CheckHandle;
#	Line 318 | Line 321 | begin
321		GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
322		end;
323
324	<	function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: string): IArray;
324	>	function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray;
325		begin
326		CheckHandle;
327		Result := TFB25Array.Create(self,transaction as TFB25Transaction,
#	Line 333 | Line 336 | begin
336		end;
337
338		function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
339	<	tableName: string; columnName: string; Scale: integer; size: cardinal;
339	>	tableName: AnsiString; columnName: AnsiString; Scale: integer; size: cardinal;
340		acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
341		): IArrayMetaData;
342		begin
343	<	Result := TFB25ArrayMetaData.Create(SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
343	>	Result := TFB25ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
344		end;
345
346		function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
347	<	columnName: string): IBlobMetaData;
347	>	columnName: AnsiString): IBlobMetaData;
348		begin
349		CheckHandle;
350		Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
351		end;
352
353		function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
354	<	columnName: string): IArrayMetaData;
354	>	columnName: AnsiString): IArrayMetaData;
355		begin
356		CheckHandle;
357		Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
358		end;
359
357	–	function TFB25Attachment.GetDBInformation(Requests: array of byte
358	–	): IDBInformation;
359	–	var ReqBuffer: PByte;
360	–	i: integer;
361	–	begin
362	–	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;
382	–	end;
383	–
384	–	function TFB25Attachment.GetDBInformation(Request: byte): IDBInformation;
385	–	begin
386	–	CheckHandle;
387	–	Result := TDBInformation.Create;
388	–	with Firebird25ClientAPI, Result as TDBInformation do
389	–	if isc_database_info(StatusVector, @(FHandle), 1, @Request,
390	–	getBufSize, Buffer) > 0 then
391	–	IBDataBaseError;
392	–	end;
393	–
360		end.
361

Diff Legend

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