ViewVC Help

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

root/public/ibx/trunk/fbintf/client/3.0/FB30Attachment.pas

Comparing ibx/trunk/fbintf/client/3.0/FB30Attachment.pas (file contents):
Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

#	Line 46 | Line 46 | type
46		TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
47		private
48		FAttachmentIntf: Firebird.IAttachment;
49	+	FFirebird30ClientAPI: TFB30ClientAPI;
50		protected
51		procedure CheckHandle; override;
52		public
53	<	constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
53	>	constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54		RaiseExceptionOnConnectError: boolean);
55	<	constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
56	<	constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
55	>	constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
56	>	constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
57		RaiseExceptionOnError: boolean); overload;
58		destructor Destroy; override;
59	+	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
60	+	override;
61		property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
62	+	property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
63
64		public
65		{IAttachment}
66		procedure Connect;
67		procedure Disconnect(Force: boolean=false); override;
68	<	function IsConnected: boolean;
68	>	function IsConnected: boolean; override;
69		procedure DropDatabase;
70		function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
71		function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
72		procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
73		function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
74		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
75	<	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
75	>	aSQLDialect: integer; GenerateParamNames: boolean=false;
76	>	CaseSensitiveParams: boolean=false): IStatement; override;
77
78		{Events}
79		function GetEventHandler(Events: TStrings): IEvents; override;
80
81		{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
82
83	<	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
79	<	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
83	>	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
84		function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
81	–	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
85		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload; override;
86
87		{Array}
88	<	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
89	<	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
87	<	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
88	>	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
89	>	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
90		function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
91		columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
92	<	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
92	>	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
93
94
95		{Database Information}
96	<	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
97	<	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
98	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
97	<	function GetDBInformation(Request: byte): IDBInformation; overload;
96	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
97	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
98	>	procedure getFBVersion(version: TStrings);
99		end;
100
101		implementation
102
103		uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
104	<	FBOutputBlock, FB30Events;
104	>	FBOutputBlock, FB30Events, IBUtils;
105	>
106	>	type
107	>	{ TVersionCallback }
108	>
109	>	TVersionCallback = class(Firebird.IVersionCallbackImpl)
110	>	private
111	>	FOutput: TStrings;
112	>	public
113	>	constructor Create(output: TStrings);
114	>	procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
115	>	end;
116	>
117	>	{ TVersionCallback }
118	>
119	>	constructor TVersionCallback.Create(output: TStrings);
120	>	begin
121	>	inherited Create;
122	>	FOutput := output;
123	>	end;
124	>
125	>	procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
126	>	begin
127	>	FOutput.Add(text);
128	>	end;
129	>
130
131		{ TFB30Attachment }
132
#	Line 110 | Line 136 | begin
136		IBError(ibxeDatabaseClosed,[nil]);
137		end;
138
139	<	constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
139	>	constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
140		RaiseExceptionOnConnectError: boolean);
141		begin
142	+	FFirebird30ClientAPI := api;
143		if aDPB = nil then
144		begin
145		if RaiseExceptionOnConnectError then
146		IBError(ibxeNoDPB,[nil]);
147		Exit;
148		end;
149	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
149	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
150		Connect;
151		end;
152
153	<	constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
153	>	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
154		RaiseExceptionOnError: boolean);
155		var Param: IDPBItem;
156		sql: AnsiString;
157		IsCreateDB: boolean;
158		begin
159	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
159	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
160	>	FFirebird30ClientAPI := api;
161		IsCreateDB := true;
162		if aDPB <> nil then
163		begin
#	Line 138 | Line 166 | begin
166		FSQLDialect := Param.AsByte;
167		end;
168		sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
169	<	with Firebird30ClientAPI do
169	>	with FFirebird30ClientAPI do
170		begin
171		FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
172		PAnsiChar(sql),FSQLDialect,@IsCreateDB);
#	Line 151 | Line 179 | begin
179		begin
180		Disconnect;
181		Connect;
182	<	end;
182	>	end
183	>	else
184	>	GetODSAndConnectionInfo;
185		end;
186		end;
187
188	<	constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
188	>	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
189		RaiseExceptionOnError: boolean);
190		var IsCreateDB: boolean;
161	–	info: IDBInformation;
162	–	ConnectionType: integer;
163	–	SiteName: AnsiString;
191		begin
192	<	inherited Create('',nil,RaiseExceptionOnError);
192	>	inherited Create(api,'',nil,RaiseExceptionOnError);
193	>	FFirebird30ClientAPI := api;
194		FSQLDialect := aSQLDialect;
195	<	with Firebird30ClientAPI do
195	>	with FFirebird30ClientAPI do
196		begin
197		FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
198		PAnsiChar(sql),aSQLDialect,@IsCreateDB);
199		if FRaiseExceptionOnConnectError then Check4DataBaseError;
200		if InErrorState then
201		FAttachmentIntf := nil;
174	–	FCharSetID := 0;
175	–	FCodePage := CP_NONE;
176	–	FHasDefaultCharSet := false;
177	–	info := GetDBInformation(isc_info_db_id);
178	–	info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
202		end;
203	+	GetODSAndConnectionInfo;
204	+	ExtractConnectString(sql,FDatabaseName);
205	+	DPBFromCreateSQL(sql);
206		end;
207
208		destructor TFB30Attachment.Destroy;
#	Line 186 | Line 212 | begin
212		FAttachmentIntf.release;
213		end;
214
215	+	function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
216	+	begin
217	+	Result := TDBInformation.Create(Firebird30ClientAPI);
218	+	with FFirebird30ClientAPI, Result as TDBInformation do
219	+	begin
220	+	FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
221	+	getBufSize, BytePtr(Buffer));
222	+	Check4DataBaseError;
223	+	end
224	+	end;
225	+
226		procedure TFB30Attachment.Connect;
190	–	var Param: IDPBItem;
227		begin
228	<	with Firebird30ClientAPI do
228	>	with FFirebird30ClientAPI do
229		begin
230		FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
231		(DPB as TDPB).getDataLength,
#	Line 198 | Line 234 | begin
234		if InErrorState then
235		FAttachmentIntf := nil
236		else
237	<	begin
202	<	Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
203	<	if Param <> nil then
204	<	FSQLDialect := Param.AsByte;
205	<	Param :=  DPB.Find(isc_dpb_lc_ctype);
206	<	FHasDefaultCharSet :=  (Param <> nil) and
207	<	CharSetName2CharSetID(Param.AsString,FCharSetID) and
208	<	CharSetID2CodePage(FCharSetID,FCodePage) and
209	<	(FCharSetID > 1);
210	<	end;
237	>	GetODSAndConnectionInfo;
238		end;
239		end;
240
241		procedure TFB30Attachment.Disconnect(Force: boolean);
242		begin
243		if IsConnected then
244	<	with Firebird30ClientAPI do
244	>	with FFirebird30ClientAPI do
245		begin
246		EndAllTransactions;
247		FAttachmentIntf.Detach(StatusIntf);
#	Line 235 | Line 262 | end;
262		procedure TFB30Attachment.DropDatabase;
263		begin
264		if IsConnected then
265	<	with Firebird30ClientAPI do
265	>	with FFirebird30ClientAPI do
266		begin
267		EndAllTransactions;
268		FAttachmentIntf.dropDatabase(StatusIntf);
#	Line 248 | Line 275 | function TFB30Attachment.StartTransactio
275		DefaultCompletion: TTransactionCompletion): ITransaction;
276		begin
277		CheckHandle;
278	<	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
278	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
279		end;
280
281		function TFB30Attachment.StartTransaction(TPB: ITPB;
282		DefaultCompletion: TTransactionCompletion): ITransaction;
283		begin
284		CheckHandle;
285	<	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
285	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
286		end;
287
288		procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
289		aSQLDialect: integer);
290		begin
291		CheckHandle;
292	<	with Firebird30ClientAPI do
292	>	with FFirebird30ClientAPI do
293		begin
294		FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
295		Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
#	Line 278 | Line 305 | begin
305		end;
306
307		function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
308	<	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
308	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
309	>	CaseSensitiveParams: boolean): IStatement;
310		begin
311		CheckHandle;
312		Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
313	<	GenerateParamNames);
313	>	GenerateParamNames,CaseSensitiveParams);
314		end;
315
316		function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
#	Line 291 | Line 319 | begin
319		Result := TFB30Events.Create(self,Events);
320		end;
321
294	–	function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
295	–	ColumnName: AnsiString; BPB: IBPB): IBlob;
296	–	begin
297	–	CheckHandle;
298	–	Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
299	–	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
300	–	end;
301	–
322		function TFB30Attachment.CreateBlob(transaction: ITransaction;
323		BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
324		begin
#	Line 313 | Line 333 | begin
333		Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
334		end;
335
316	–	function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
317	–	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
318	–	begin
319	–	CheckHandle;
320	–	Result := TFB30Blob.Create(self,transaction as TFB30transaction,
321	–	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
322	–	BlobID,BPB);
323	–	end;
324	–
336		function TFB30Attachment.OpenBlob(transaction: ITransaction;
337		BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
338		begin
#	Line 329 | Line 340 | begin
340		Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
341		end;
342
343	<	function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
344	<	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
334	<	begin
335	<	CheckHandle;
336	<	Result := TFB30Array.Create(self,transaction as TFB30Transaction,
337	<	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
338	<	end;
339	<
340	<	function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
341	<	ColumnName: AnsiString): IArray;
343	>	function TFB30Attachment.OpenArray(transaction: ITransaction;
344	>	ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
345		begin
346		CheckHandle;
347		Result := TFB30Array.Create(self,transaction as TFB30Transaction,
348	<	GetArrayMetaData(transaction,RelationName,ColumnName));
348	>	ArrayMetaData,ArrayID);
349		end;
350
351		function TFB30Attachment.CreateArray(transaction: ITransaction;
#	Line 373 | Line 376 | begin
376		Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
377		end;
378
379	<	function TFB30Attachment.GetDBInformation(Requests: array of byte
380	<	): IDBInformation;
378	<	var ReqBuffer: PByte;
379	<	i: integer;
379	>	procedure TFB30Attachment.getFBVersion(version: TStrings);
380	>	var bufferObj: TVersionCallback;
381		begin
382	<	CheckHandle;
383	<	if Length(Requests) = 1 then
384	<	Result := GetDBInformation(Requests[0])
385	<	else
386	<	begin
387	<	Result := TDBInformation.Create;
388	<	GetMem(ReqBuffer,Length(Requests));
388	<	try
389	<	for i := 0 to Length(Requests) - 1 do
390	<	ReqBuffer[i] := Requests[i];
391	<
392	<	with Firebird30ClientAPI, Result as TDBInformation do
393	<	begin
394	<	FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
395	<	getBufSize, BytePtr(Buffer));
396	<	Check4DataBaseError;
397	<	end
398	<
399	<	finally
400	<	FreeMem(ReqBuffer);
382	>	version.Clear;
383	>	bufferObj := TVersionCallback.Create(version);
384	>	try
385	>	with FFirebird30ClientAPI do
386	>	begin
387	>	UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
388	>	Check4DataBaseError;
389		end;
390	<	end;
391	<	end;
404	<
405	<	function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
406	<	begin
407	<	CheckHandle;
408	<	Result := TDBInformation.Create;
409	<	with Firebird30ClientAPI, Result as TDBInformation do
410	<	begin
411	<	FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
412	<	getBufSize, BytePtr(Buffer));
413	<	Check4DataBaseError;
390	>	finally
391	>	bufferObj.Free;
392		end;
393		end;
394

Diff Legend

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