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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 267 by tony, Fri Dec 28 10:44:23 2018 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FB30Attachment;
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 43 | 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: string; aDPB: IDPB;
53	>	constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54		RaiseExceptionOnConnectError: boolean);
55	<	constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean);
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: string; aSQLDialect: integer); override;
73	<	function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; override;
74	<	function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
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;
76
77		{Events}
#	Line 70 | Line 79 | type
79
80		{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
81
82	<	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: string; BPB: IBPB=nil): IBlob; overload;
82	>	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
83		function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
84		function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
85	<	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
86	<	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; override; overload;
85	>	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
86	>	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload; override;
87
88		{Array}
89	<	function OpenArray(transaction: ITransaction; RelationName, ColumnName: string; ArrayID: TISC_QUAD): IArray;
90	<	function CreateArray(transaction: ITransaction; RelationName, ColumnName: string): IArray; overload;
89	>	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
90	>	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
91		function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
92	+	function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
93	+	columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
94	+	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
95	+
96
97		{Database Information}
98	<	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
99	<	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
100	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
88	<	function GetDBInformation(Request: byte): IDBInformation; overload;
98	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
99	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
100	>	procedure getFBVersion(version: TStrings);
101		end;
102
103		implementation
104
105		uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
106	<	FBOutputBlock, FB30Events;
106	>	FBOutputBlock, FB30Events, IBUtils;
107	>
108	>	type
109	>	{ TVersionCallback }
110	>
111	>	TVersionCallback = class(Firebird.IVersionCallbackImpl)
112	>	private
113	>	FOutput: TStrings;
114	>	public
115	>	constructor Create(output: TStrings);
116	>	procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
117	>	end;
118	>
119	>	{ TVersionCallback }
120	>
121	>	constructor TVersionCallback.Create(output: TStrings);
122	>	begin
123	>	inherited Create;
124	>	FOutput := output;
125	>	end;
126	>
127	>	procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
128	>	begin
129	>	FOutput.Add(text);
130	>	end;
131	>
132
133		{ TFB30Attachment }
134
#	Line 101 | Line 138 | begin
138		IBError(ibxeDatabaseClosed,[nil]);
139		end;
140
141	<	constructor TFB30Attachment.Create(DatabaseName: string; aDPB: IDPB;
141	>	constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
142		RaiseExceptionOnConnectError: boolean);
143		begin
144	+	FFirebird30ClientAPI := api;
145		if aDPB = nil then
146		begin
147		if RaiseExceptionOnConnectError then
148		IBError(ibxeNoDPB,[nil]);
149		Exit;
150		end;
151	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
151	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
152		Connect;
153		end;
154
155	<	constructor TFB30Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
155	>	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
156		RaiseExceptionOnError: boolean);
157		var Param: IDPBItem;
158	<	sql: string;
158	>	sql: AnsiString;
159		IsCreateDB: boolean;
160		begin
161	<	inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
162	<	FSQLDialect := 3;
161	>	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
162	>	FFirebird30ClientAPI := api;
163		IsCreateDB := true;
164		if aDPB <> nil then
165		begin
#	Line 130 | Line 168 | begin
168		FSQLDialect := Param.AsByte;
169		end;
170		sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
171	<	with Firebird30ClientAPI do
171	>	with FFirebird30ClientAPI do
172		begin
173		FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
174		PAnsiChar(sql),FSQLDialect,@IsCreateDB);
#	Line 143 | Line 181 | begin
181		begin
182		Disconnect;
183		Connect;
184	<	end;
184	>	end
185	>	else
186	>	GetODSAndConnectionInfo;
187	>	end;
188	>	end;
189	>
190	>	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
191	>	RaiseExceptionOnError: boolean);
192	>	var IsCreateDB: boolean;
193	>	begin
194	>	inherited Create(api,'',nil,RaiseExceptionOnError);
195	>	FFirebird30ClientAPI := api;
196	>	FSQLDialect := aSQLDialect;
197	>	with FFirebird30ClientAPI do
198	>	begin
199	>	FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
200	>	PAnsiChar(sql),aSQLDialect,@IsCreateDB);
201	>	if FRaiseExceptionOnConnectError then Check4DataBaseError;
202	>	if InErrorState then
203	>	FAttachmentIntf := nil;
204		end;
205	+	GetODSAndConnectionInfo;
206	+	ExtractConnectString(sql,FDatabaseName);
207	+	DPBFromCreateSQL(sql);
208		end;
209
210		destructor TFB30Attachment.Destroy;
#	Line 154 | Line 214 | begin
214		FAttachmentIntf.release;
215		end;
216
217	+	function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
218	+	begin
219	+	Result := TDBInformation.Create(Firebird30ClientAPI);
220	+	with FFirebird30ClientAPI, Result as TDBInformation do
221	+	begin
222	+	FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
223	+	getBufSize, BytePtr(Buffer));
224	+	Check4DataBaseError;
225	+	end
226	+	end;
227	+
228		procedure TFB30Attachment.Connect;
158	–	var Param: IDPBItem;
229		begin
230	<	with Firebird30ClientAPI do
230	>	with FFirebird30ClientAPI do
231		begin
232		FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
233		(DPB as TDPB).getDataLength,
#	Line 166 | Line 236 | begin
236		if InErrorState then
237		FAttachmentIntf := nil
238		else
239	<	begin
170	<	Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
171	<	if Param <> nil then
172	<	FSQLDialect := Param.AsByte;
173	<	Param :=  DPB.Find(isc_dpb_lc_ctype);
174	<	FHasDefaultCharSet :=  (Param <> nil) and
175	<	CharSetName2CharSetID(Param.AsString,FCharSetID) and
176	<	CharSetID2CodePage(FCharSetID,FCodePage) and
177	<	(FCharSetID > 1);
178	<	end;
239	>	GetODSAndConnectionInfo;
240		end;
241		end;
242
243		procedure TFB30Attachment.Disconnect(Force: boolean);
244		begin
245		if IsConnected then
246	<	with Firebird30ClientAPI do
246	>	with FFirebird30ClientAPI do
247		begin
248		EndAllTransactions;
249		FAttachmentIntf.Detach(StatusIntf);
#	Line 203 | Line 264 | end;
264		procedure TFB30Attachment.DropDatabase;
265		begin
266		if IsConnected then
267	<	with Firebird30ClientAPI do
267	>	with FFirebird30ClientAPI do
268		begin
269		EndAllTransactions;
270		FAttachmentIntf.dropDatabase(StatusIntf);
#	Line 216 | Line 277 | function TFB30Attachment.StartTransactio
277		DefaultCompletion: TTransactionCompletion): ITransaction;
278		begin
279		CheckHandle;
280	<	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
280	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
281		end;
282
283		function TFB30Attachment.StartTransaction(TPB: ITPB;
284		DefaultCompletion: TTransactionCompletion): ITransaction;
285		begin
286		CheckHandle;
287	<	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
287	>	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
288		end;
289
290	<	procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: string;
290	>	procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
291		aSQLDialect: integer);
292		begin
293		CheckHandle;
294	<	with Firebird30ClientAPI do
294	>	with FFirebird30ClientAPI do
295		begin
296		FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
297	<	Length(sql),PChar(sql),aSQLDialect,nil,nil,nil,nil);
297	>	Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
298		Check4DataBaseError;
299		end;
300		end;
301
302	<	function TFB30Attachment.Prepare(transaction: ITransaction; sql: string;
302	>	function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
303		aSQLDialect: integer): IStatement;
304		begin
305		CheckHandle;
#	Line 246 | Line 307 | begin
307		end;
308
309		function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
310	<	sql: string; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
310	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
311		begin
312		CheckHandle;
313		Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
#	Line 260 | Line 321 | begin
321		end;
322
323		function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
324	<	ColumnName: string; BPB: IBPB): IBlob;
324	>	ColumnName: AnsiString; BPB: IBPB): IBlob;
325		begin
326		CheckHandle;
327		Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
#	Line 282 | Line 343 | begin
343		end;
344
345		function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
346	<	ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
346	>	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
347		begin
348		CheckHandle;
349		Result := TFB30Blob.Create(self,transaction as TFB30transaction,
#	Line 298 | Line 359 | begin
359		end;
360
361		function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
362	<	ColumnName: string; ArrayID: TISC_QUAD): IArray;
362	>	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
363		begin
364		CheckHandle;
365		Result := TFB30Array.Create(self,transaction as TFB30Transaction,
#	Line 306 | Line 367 | begin
367		end;
368
369		function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
370	<	ColumnName: string): IArray;
370	>	ColumnName: AnsiString): IArray;
371		begin
372		CheckHandle;
373		Result := TFB30Array.Create(self,transaction as TFB30Transaction,
#	Line 320 | Line 381 | begin
381		Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
382		end;
383
384	+	function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
385	+	Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
386	+	bounds: TArrayBounds): IArrayMetaData;
387	+	begin
388	+	Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
389	+	end;
390	+
391		function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
392	<	columnName: string): IBlobMetaData;
392	>	columnName: AnsiString): IBlobMetaData;
393		begin
394		CheckHandle;
395		Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
396		end;
397
398		function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
399	<	columnName: string): IArrayMetaData;
399	>	columnName: AnsiString): IArrayMetaData;
400		begin
401		CheckHandle;
402		Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
403		end;
404
405	<	function TFB30Attachment.GetDBInformation(Requests: array of byte
406	<	): IDBInformation;
339	<	var ReqBuffer: PByte;
340	<	i: integer;
405	>	procedure TFB30Attachment.getFBVersion(version: TStrings);
406	>	var bufferObj: TVersionCallback;
407		begin
408	<	CheckHandle;
409	<	if Length(Requests) = 1 then
410	<	Result := GetDBInformation(Requests[0])
411	<	else
412	<	begin
413	<	Result := TDBInformation.Create;
414	<	GetMem(ReqBuffer,Length(Requests));
349	<	try
350	<	for i := 0 to Length(Requests) - 1 do
351	<	ReqBuffer[i] := Requests[i];
352	<
353	<	with Firebird30ClientAPI, Result as TDBInformation do
354	<	begin
355	<	FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
356	<	getBufSize, BytePtr(Buffer));
357	<	Check4DataBaseError;
358	<	end
359	<
360	<	finally
361	<	FreeMem(ReqBuffer);
408	>	version.Clear;
409	>	bufferObj := TVersionCallback.Create(version);
410	>	try
411	>	with FFirebird30ClientAPI do
412	>	begin
413	>	UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
414	>	Check4DataBaseError;
415		end;
416	<	end;
417	<	end;
365	<
366	<	function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
367	<	begin
368	<	CheckHandle;
369	<	Result := TDBInformation.Create;
370	<	with Firebird30ClientAPI, Result as TDBInformation do
371	<	begin
372	<	FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
373	<	getBufSize, BytePtr(Buffer));
374	<	Check4DataBaseError;
416	>	finally
417	>	bufferObj.Free;
418		end;
419		end;
420

Diff Legend

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