ViewVC Help

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

root/public/ibx/branches/udr/client/FBAttachment.pas

Comparing ibx/branches/udr/client/FBAttachment.pas (file contents):
Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC vs.
Revision 375 by tony, Sun Jan 9 23:42:58 2022 UTC

#	Line 16 | Line 16
16		*
17		*  The Initial Developer of the Original Code is Tony Whyman.
18		*
19	<	*  The Original Code is (C) 2016 Tony Whyman, MWA Software
19	>	*  The Original Code is (C) 2016-2021 Tony Whyman, MWA Software
20		*  (http://www.mwasoftware.co.uk).
21		*
22		*  All Rights Reserved.
#	Line 69 | Line 69 | type
69		Syntax:
70
71		Transaction Start:
72	<	*S:<date/time>,<session id>,<transaction no.>,<string length>:<transaction Name>,<string length>:<TPB>,<default Completion>
72	>	*S:<date/time>,<attachmentid>,<session id>,<transaction no.>,<string length>:<transaction Name>,<string length>:<TPB>,<default Completion>
73
74		Transaction Commit:
75	<	*C:<date/time>,<session id>,<transaction no.>
75	>	*C:<date/time>,<attachmentid>,<session id>,<transaction no.>
76
77		Transaction Commit retaining :
78	<	*c:<date/time>,<session id>,<transaction no.><old transaction no.>
78	>	*c:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
79
80		Transaction Rollback:
81	<	*R:<date/time>,<session id>,<transaction no.>
81	>	*R:<date/time>,<attachmentid>,<session id>,<transaction no.>
82
83		Transaction Rollback retaining:
84	<	*r:<date/time>,<session id>,<transaction no.><old transaction no.>
84	>	*r:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
85
86		Update/Insert/Delete
87	<	*Q:<date/time>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
87	>	*Q:<date/time>,<attachmentid>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
88
89		}
90
#	Line 93 | Line 93 | type
93		TFBJournaling = class(TActivityHandler, IJournallingHook)
94		private
95		{Logfile}
96	<	const sQueryJournal          = '*Q:''%s'',%d,%d,%d:%s' + LineEnding;
97	<	const sTransStartJnl         = '*S:''%s'',%d,%d,%d:%s,%d:%s,%d' + LineEnding;
98	<	const sTransCommitJnl        = '*C:''%s'',%d,%d' + LineEnding;
99	<	const sTransCommitRetJnl     = '*c:''%s'',%d,%d,%d' + LineEnding;
100	<	const sTransRollBackJnl      = '*R:''%s'',%d,%d' + LineEnding;
101	<	const sTransRollBackRetJnl   = '*r:''%s'',%d,%d,%d' + LineEnding;
96	>	const sQueryJournal          = '*Q:''%s'',%d,%d,%d,%d:%s' + LineEnding;
97	>	const sTransStartJnl         = '*S:''%s'',%d,%d,%d,%d:%s,%d:%s,%d' + LineEnding;
98	>	const sTransCommitJnl        = '*C:''%s'',%d,%d,%d' + LineEnding;
99	>	const sTransCommitRetJnl     = '*c:''%s'',%d,%d,%d,%d' + LineEnding;
100	>	const sTransRollBackJnl      = '*R:''%s'',%d,%d,%d' + LineEnding;
101	>	const sTransRollBackRetJnl   = '*r:''%s'',%d,%d,%d,%d' + LineEnding;
102		private
103		FOptions: TJournalOptions;
104		FJournalFilePath: string;
#	Line 125 | Line 125 | type
125		function GetJournalOptions: TJournalOptions;
126		function StartJournaling(aJournalLogFile: AnsiString): integer; overload;
127		function StartJournaling(aJournalLogFile: AnsiString; Options: TJournalOptions): integer; overload;
128	+	function StartJournaling(S: TStream; Options: TJournalOptions): integer; overload;
129		procedure StopJournaling(RetainJournal: boolean);
130		end;
131
#	Line 139 | Line 140 | type
140		FUserCharSetMap: array of TCharSetMap;
141		FSecDatabase: AnsiString;
142		FInlineBlobLimit: integer;
143	<	protected
143	<	FDatabaseName: AnsiString;
144	<	FRaiseExceptionOnConnectError: boolean;
143	>	FAttachmentID: integer;
144		FSQLDialect: integer;
145		FHasDefaultCharSet: boolean;
146		FCharSetID: integer;
147		FCodePage: TSystemCodePage;
148		FRemoteProtocol: AnsiString;
149		FAuthMethod: AnsiString;
150	+	FHasConnectionInfo: boolean;
151	+	procedure NeedDBInfo;
152	+	procedure NeedConnectionInfo;
153	+	protected
154	+	FDatabaseName: AnsiString;
155	+	FRaiseExceptionOnConnectError: boolean;
156		constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
157		RaiseExceptionOnConnectError: boolean);
158		procedure CheckHandle; virtual; abstract;
159	+	procedure ClearCachedInfo;
160		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
155	–	procedure GetODSAndConnectionInfo;
161		function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
162		function IsConnected: boolean; virtual; abstract;
163		procedure EndAllTransactions;
164		procedure DPBFromCreateSQL(CreateSQL: AnsiString);
165		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
166	+	procedure SetSQLDialect(aValue: integer);
167		procedure UseServerICUChanged; virtual;
168		public
169		destructor Destroy; override;
170	+	procedure Disconnect(Force: boolean); override;
171		function getFirebirdAPI: IFirebirdAPI;
172		function getDPB: IDPB;
173		function AllocateBPB: IBPB;
#	Line 217 | Line 224 | type
224		function GetEventHandler(Event: AnsiString): IEvents; overload;
225
226		function GetSQLDialect: integer;
227	+	function GetAttachmentID: integer;
228		function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
229		function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
230		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
#	Line 227 | Line 235 | type
235		function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; virtual; abstract;
236		function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
237		function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
238	<	property SQLDialect: integer read FSQLDialect;
238	>	property SQLDialect: integer read GetSQLDialect;
239		property DPB: IDPB read FDPB;
240		public
241		function GetDBInformation(Requests: array of byte): IDBInformation; overload;
242		function GetDBInformation(Request: byte): IDBInformation; overload;
243		function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
236	–	function GetAttachmentID: integer;
244		function GetConnectString: AnsiString;
245		function GetRemoteProtocol: AnsiString;
246		function GetAuthenticationMethod: AnsiString;
247		function GetSecurityDatabase: AnsiString;
248		function GetODSMajorVersion: integer;
249		function GetODSMinorVersion: integer;
250	+	function GetCharSetID: integer;
251		function HasDecFloatSupport: boolean; virtual;
252		function GetInlineBlobLimit: integer;
253		procedure SetInlineBlobLimit(limit: integer);
254		function HasBatchMode: boolean; virtual;
255		function HasTable(aTableName: AnsiString): boolean;
256	+	function HasFunction(aFunctionName: AnsiString): boolean;
257	+	function HasProcedure(aProcName: AnsiString): boolean;
258
259		public
260		{Character Sets}
#	Line 259 | Line 269 | type
269		AllowReverseLookup:boolean; out CharSetID: integer);
270		function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
271		function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
272	<	property CharSetID: integer read FCharSetID;
272	>	property CharSetID: integer read GetCharSetID;
273		property CodePage: TSystemCodePage read FCodePage;
274
275		public
#	Line 610 | Line 620 | end;
620
621		procedure TFBJournaling.EndSession(RetainJournal: boolean);
622		begin
623	<	if JournalingActive then
623	>	if JournalingActive and (FJournalFilePath <> '') then
624		begin
625		FreeAndNil(FJournalFileStream);
626	<	if not RetainJournal then
626	>	if not (joNoServerTable in FOptions) and not RetainJournal then
627		try
628		GetAttachment.ExecuteSQL([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],
629		sqlCleanUpSession,[FSessionID]);
#	Line 638 | Line 648 | var LogEntry: AnsiString;
648		TPBText: AnsiString;
649		begin
650		FDoNotJournal := true;
651	+	if not (joNoServerTable in FOptions) then
652		try
653		GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,NULL]);
654		finally
#	Line 645 | Line 656 | begin
656		end;
657		TPBText := Tr.getTPB.AsText;
658		LogEntry := Format(sTransStartJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
659	+	GetAttachment.GetAttachmentID,
660		FSessionID,
661		Tr.GetTransactionID,
662		Length(Tr.TransactionName),
#	Line 664 | Line 676 | begin
676		case Action of
677		TARollback:
678		begin
679	<	LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),FSessionID,TransactionID]);
679	>	LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
680	>	GetAttachment.GetAttachmentID,
681	>	FSessionID,TransactionID]);
682		Result := true;
683		end;
684		TACommit:
685		begin
686	<	LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),FSessionID,TransactionID]);
686	>	LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
687	>	GetAttachment.GetAttachmentID,
688	>	FSessionID,TransactionID]);
689		Result := true;
690		end;
691		end;
#	Line 684 | Line 700 | begin
700		case Action of
701		TACommitRetaining:
702		LogEntry := Format(sTransCommitRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
703	+	GetAttachment.GetAttachmentID,
704		FSessionID,Tr.GetTransactionID,OldTransactionID]);
705		TARollbackRetaining:
706		LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
707	+	GetAttachment.GetAttachmentID,
708		FSessionID,Tr.GetTransactionID,OldTransactionID]);
709		end;
710		if assigned(FJournalFileStream) then
711		FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
712
713		FDoNotJournal := true;
714	+	if not (joNoServerTable in FOptions) then
715		try
716		GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,OldTransactionID]);
717		finally
#	Line 706 | Line 725 | var SQL: AnsiString;
725		begin
726		SQL := TQueryProcessor.Execute(Stmt);
727		LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
728	+	GetAttachment.GetAttachmentID,
729		FSessionID,
730		Stmt.GetTransaction.GetTransactionID,
731		Length(SQL),SQL]);
#	Line 731 | Line 751 | end;
751		function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString;
752		Options: TJournalOptions): integer;
753		begin
754	+	try
755	+	StartJournaling(TFileStream.Create(aJournalLogFile,fmCreate),Options);
756	+	finally
757	+	FJournalFilePath := aJournalLogFile;
758	+	end;
759	+	end;
760	+
761	+	function TFBJournaling.StartJournaling(S: TStream; Options: TJournalOptions
762	+	): integer;
763	+	begin
764		FOptions := Options;
765	+	if not (joNoServerTable in FOptions) then
766		with GetAttachment do
767		begin
768	<	if not HasTable(sJournalTableName) then
768	>	if  not HasTable(sJournalTableName) then
769		begin
770		ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateJournalTable);
771		ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateSequence);
772		end;
773		FSessionID := OpenCursorAtStart(sqlGetNextSessionID)[0].AsInteger;
774		end;
775	<	FJournalFilePath := aJournalLogFile;
745	<	FJournalFileStream := TFileStream.Create(FJournalFilePath,fmCreate);
775	>	FJournalFileStream := S;
776		Result := FSessionID;
777		end;
778
#	Line 751 | Line 781 | begin
781		EndSession(RetainJournal);
782		end;
783
754	–
755	–
756	–
784		{ TFBAttachment }
785
786	<	procedure TFBAttachment.GetODSAndConnectionInfo;
787	<	var DBInfo: IDBInformation;
761	<	i: integer;
762	<	Stmt: IStatement;
786	>	procedure TFBAttachment.NeedConnectionInfo;
787	>	var Stmt: IStatement;
788		ResultSet: IResultSet;
789		Param: IDPBItem;
790		begin
791	<	if not IsConnected then Exit;
792	<	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
768	<	isc_info_db_SQL_Dialect]);
769	<	for i := 0 to DBInfo.GetCount - 1 do
770	<	with DBInfo[i] do
771	<	case getItemType of
772	<	isc_info_ods_minor_version:
773	<	FODSMinorVersion := getAsInteger;
774	<	isc_info_ods_version:
775	<	FODSMajorVersion := getAsInteger;
776	<	isc_info_db_SQL_Dialect:
777	<	FSQLDialect := getAsInteger;
778	<	end;
779	<
791	>	if not IsConnected or FHasConnectionInfo then Exit;
792	>	NeedDBInfo;
793		FCharSetID := 0;
794		FRemoteProtocol := '';
795		FAuthMethod := 'Legacy_Auth';
#	Line 822 | Line 835 | begin
835		end;
836		end;
837		FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
838	+	FHasConnectionInfo := true;
839	+	end;
840	+
841	+	procedure TFBAttachment.NeedDBInfo;
842	+	var DBInfo: IDBInformation;
843	+	i: integer;
844	+	begin
845	+	if not IsConnected or (FAttachmentID > 0) then Exit;
846	+	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
847	+	isc_info_db_SQL_Dialect, isc_info_attachment_id]);
848	+	for i := 0 to DBInfo.GetCount - 1 do
849	+	with DBInfo[i] do
850	+	case getItemType of
851	+	isc_info_ods_minor_version:
852	+	FODSMinorVersion := getAsInteger;
853	+	isc_info_ods_version:
854	+	FODSMajorVersion := getAsInteger;
855	+	isc_info_db_SQL_Dialect:
856	+	FSQLDialect := getAsInteger;
857	+	isc_info_attachment_id:
858	+	FAttachmentID := getAsInteger;
859	+	end;
860		end;
861
862		constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
#	Line 831 | Line 866 | begin
866		FFirebirdAPI := api.GetAPI; {Keep reference to interface}
867		FSQLDialect := 3;
868		FDatabaseName := DatabaseName;
834	–	FDPB := DPB;
869		SetLength(FUserCharSetMap,0);
870	+	ClearCachedInfo;
871	+	FInlineBlobLimit := DefaultMaxInlineBlobLimit;
872	+	FDPB := DPB;
873		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
874	+	end;
875	+
876	+	procedure TFBAttachment.ClearCachedInfo;
877	+	begin
878	+	FHasDefaultCharSet := false;
879	+	FAttachmentID := 0;
880		FODSMajorVersion := 0;
881		FODSMinorVersion := 0;
882	<	FInlineBlobLimit := DefaultMaxInlineBlobLimit;
882	>	FCodePage := CP_NONE;
883	>	FCharSetID := 0;
884	>	FRemoteProtocol := '';
885	>	FAuthMethod := '';
886	>	FSecDatabase := '';
887	>	FHasConnectionInfo := false;
888		end;
889
890		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 970 | Line 1018 | begin
1018		end;
1019		end;
1020
1021	+	procedure TFBAttachment.SetSQLDialect(aValue: integer);
1022	+	begin
1023	+	FSQLDialect := aValue;
1024	+	end;
1025	+
1026		procedure TFBAttachment.UseServerICUChanged;
1027		begin
1028		// Do nothing by default
#	Line 981 | Line 1034 | begin
1034		inherited Destroy;
1035		end;
1036
1037	+	procedure TFBAttachment.Disconnect(Force: boolean);
1038	+	begin
1039	+	inherited Disconnect(Force);
1040	+	ClearCachedInfo;
1041	+	end;
1042	+
1043		function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
1044		begin
1045		Result := FFirebirdAPI;
#	Line 1178 | Line 1237 | end;
1237
1238		function TFBAttachment.GetSQLDialect: integer;
1239		begin
1240	+	NeedDBInfo;
1241		Result := FSQLDialect;
1242		end;
1243
1244	+	function TFBAttachment.GetAttachmentID: integer;
1245	+	begin
1246	+	NeedDBInfo;
1247	+	Result := FAttachmentID;
1248	+	end;
1249	+
1250		function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
1251		ColumnName: AnsiString; BPB: IBPB): IBlob;
1252		begin
#	Line 1250 | Line 1316 | begin
1316		Result := GetDBInfo(getBuffer,getDataLength);
1317		end;
1318
1253	–	function TFBAttachment.GetAttachmentID: integer;
1254	–	var Info: IDBInformation;
1255	–	begin
1256	–	Info := GetDBInformation(isc_info_attachment_id);
1257	–	if (Info.Count > 0) and (Info[0].getItemType = isc_info_attachment_id) then
1258	–	Result := Info[0].getAsInteger
1259	–	else
1260	–	Result := -1;
1261	–	end;
1262	–
1319		function TFBAttachment.GetConnectString: AnsiString;
1320		begin
1321		Result := FDatabaseName;
#	Line 1267 | Line 1323 | end;
1323
1324		function TFBAttachment.GetRemoteProtocol: AnsiString;
1325		begin
1326	+	NeedConnectionInfo;
1327		Result := FRemoteProtocol;
1328		end;
1329
1330		function TFBAttachment.GetAuthenticationMethod: AnsiString;
1331		begin
1332	+	NeedConnectionInfo;
1333		Result := FAuthMethod;
1334		end;
1335
1336		function TFBAttachment.GetSecurityDatabase: AnsiString;
1337		begin
1338	+	NeedConnectionInfo;
1339		Result := FSecDatabase;
1340		end;
1341
1342		function TFBAttachment.GetODSMajorVersion: integer;
1343		begin
1344	+	NeedDBInfo;
1345		Result := FODSMajorVersion;
1346		end;
1347
1348		function TFBAttachment.GetODSMinorVersion: integer;
1349		begin
1350	+	NeedDBInfo;
1351		Result := FODSMinorVersion;
1352		end;
1353
1354	+	function TFBAttachment.GetCharSetID: integer;
1355	+	begin
1356	+	NeedConnectionInfo;
1357	+	Result := FCharSetID;
1358	+	end;
1359	+
1360		function TFBAttachment.HasDecFloatSupport: boolean;
1361		begin
1362		Result := false;
#	Line 1320 | Line 1387 | begin
1387		[aTableName])[0].AsInteger > 0;
1388		end;
1389
1390	+	function TFBAttachment.HasFunction(aFunctionName: AnsiString): boolean;
1391	+	begin
1392	+	Result := OpenCursorAtStart(
1393	+	'Select count(*) From RDB$FUNCTIONS Where RDB$FUNCTION_NAME = ?',
1394	+	[aFunctionName])[0].AsInteger > 0;
1395	+	end;
1396	+
1397	+	function TFBAttachment.HasProcedure(aProcName: AnsiString): boolean;
1398	+	begin
1399	+	Result := OpenCursorAtStart(
1400	+	'Select count(*) From RDB$PROCEDURES Where RDB$PROCEDURE_NAME = ?',
1401	+	[aProcName])[0].AsInteger > 0;
1402	+	end;
1403	+
1404		function TFBAttachment.HasDefaultCharSet: boolean;
1405		begin
1406	+	NeedConnectionInfo;
1407		Result := FHasDefaultCharSet
1408		end;
1409
1410		function TFBAttachment.GetDefaultCharSetID: integer;
1411		begin
1412	+	NeedConnectionInfo;
1413		Result := FCharsetID;
1414		end;
1415

Diff Legend

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