ViewVC Help

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

root/public/ibx/trunk/fbintf/client/FBAttachment.pas

Comparing ibx/trunk/fbintf/client/FBAttachment.pas (file contents):
Revision 401 by tony, Mon Jan 10 10:13:17 2022 UTC vs.
Revision 402 by tony, Mon Aug 1 10:07:24 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 39 | Line 39 | interface
39
40		uses
41		Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock,
42	<	FBActivityMonitor, FBClientAPI;
42	>	FBActivityMonitor, FBClientAPI, IBUtils, SyncObjs;
43
44		const
45		DefaultMaxInlineBlobLimit = 8192;
#	Line 53 | Line 53 | type
53		AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
54		end;
55
56	+	{ Database Journalling.
57	+
58	+	This class is intended to support a client side journal of all database
59	+	updates, inserts and deletes made by the client during a session. It also records
60	+	the transaction each update was made under.
61	+
62	+	The database schema is required to include a control table "IBX$JOURNALS" and
63	+	an SQL Sequence IBX$SESSIONS. These are created by the class when the
64	+	database is opened, if they are not already present. However, it is recommended
65	+	that they are created as an orginal part of the database schema in order to
66	+	unnecessarily avoid each user being given sufficient priviledge to create tables
67	+	and Sequences.
68	+
69	+	Syntax:
70	+
71	+	Transaction Start:
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>,<attachmentid>,<session id>,<transaction no.>
76	+
77	+	Transaction Commit retaining :
78	+	*c:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
79	+
80	+	Transaction Rollback:
81	+	*R:<date/time>,<attachmentid>,<session id>,<transaction no.>
82	+
83	+	Transaction Rollback retaining:
84	+	*r:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
85	+
86	+	Update/Insert/Delete
87	+	*Q:<date/time>,<attachmentid>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
88	+
89	+	}
90	+
91	+	{ TFBJournaling }
92	+
93	+	TFBJournaling = class(TActivityHandler, IJournallingHook)
94	+	private
95	+	{Logfile}
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 sTransCommitFailJnl    = '*F:''%s'',%d,%d,%d' + LineEnding;
100	+	const sTransCommitRetJnl     = '*c:''%s'',%d,%d,%d,%d' + LineEnding;
101	+	const sTransRollBackJnl      = '*R:''%s'',%d,%d,%d' + LineEnding;
102	+	const sTransRollBackFailJnl  = '*f:''%s'',%d,%d,%d' + LineEnding;
103	+	const sTransRollBackRetJnl   = '*r:''%s'',%d,%d,%d,%d' + LineEnding;
104	+	private
105	+	FOptions: TJournalOptions;
106	+	FJournalFilePath: string;
107	+	FJournalFileStream: TStream;
108	+	FSessionID: integer;
109	+	FDoNotJournal: boolean;
110	+	FOwnsJournal: boolean;
111	+	FCriticalSection: TCriticalSection;
112	+	function GetDateTimeFmt: AnsiString;
113	+	procedure WriteJnlEntry(LogEntry: AnsiString);
114	+	protected
115	+	procedure EndSession(RetainJournal: boolean);
116	+	function GetAttachment: IAttachment; virtual; abstract;
117	+	public
118	+	{IAttachment}
119	+	procedure Disconnect(Force: boolean=false); virtual;
120	+	public
121	+	{IJournallingHook}
122	+	procedure TransactionStart(Tr: ITransaction);
123	+	function TransactionEnd( TransactionID: integer; Completion: TTrCompletionState): boolean;
124	+	procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer;
125	+	Action: TTransactionAction);
126	+	procedure ExecQuery(Stmt: IStatement);
127	+	procedure ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
128	+	public
129	+	constructor Create;
130	+	destructor Destroy; override;
131	+	{Client side Journaling}
132	+	function JournalingActive: boolean;
133	+	function GetJournalOptions: TJournalOptions;
134	+	function StartJournaling(aJournalLogFile: AnsiString): integer; overload;
135	+	function StartJournaling(aJournalLogFile: AnsiString; Options: TJournalOptions): integer; overload;
136	+	function StartJournaling(S: TStream; Options: TJournalOptions): integer; overload;
137	+	procedure StopJournaling(RetainJournal: boolean);
138	+	end;
139	+
140		{ TFBAttachment }
141
142	<	TFBAttachment = class(TActivityHandler)
142	>	TFBAttachment = class(TFBJournaling)
143		private
144		FDPB: IDPB;
145		FFirebirdAPI: IFirebirdAPI;
#	Line 64 | Line 148 | type
148		FUserCharSetMap: array of TCharSetMap;
149		FSecDatabase: AnsiString;
150		FInlineBlobLimit: integer;
151	<	protected
68	<	FDatabaseName: AnsiString;
69	<	FRaiseExceptionOnConnectError: boolean;
151	>	FAttachmentID: integer;
152		FSQLDialect: integer;
153		FHasDefaultCharSet: boolean;
154		FCharSetID: integer;
155		FCodePage: TSystemCodePage;
156		FRemoteProtocol: AnsiString;
157		FAuthMethod: AnsiString;
158	+	FHasConnectionInfo: boolean;
159	+	procedure NeedDBInfo;
160	+	procedure NeedConnectionInfo;
161	+	protected
162	+	FDatabaseName: AnsiString;
163	+	FRaiseExceptionOnConnectError: boolean;
164		constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
165		RaiseExceptionOnConnectError: boolean);
166		procedure CheckHandle; virtual; abstract;
167	+	procedure ClearCachedInfo;
168		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
80	–	procedure GetODSAndConnectionInfo;
169		function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
170		function IsConnected: boolean; virtual; abstract;
171		procedure EndAllTransactions;
172		procedure DPBFromCreateSQL(CreateSQL: AnsiString);
173		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
174	+	procedure SetSQLDialect(aValue: integer);
175		procedure UseServerICUChanged; virtual;
176		public
177		destructor Destroy; override;
178	+	procedure Disconnect(Force: boolean); override;
179		function getFirebirdAPI: IFirebirdAPI;
180		function getDPB: IDPB;
181		function AllocateBPB: IBPB;
182		function AllocateDIRB: IDIRB;
183	<	function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
184	<	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
185	<	procedure Disconnect(Force: boolean=false); virtual; abstract;
183	>	function StartTransaction(TPB: array of byte;
184	>	DefaultCompletion: TTransactionCompletion;
185	>	aName: AnsiString=''): ITransaction; overload; virtual; abstract;
186	>	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion;
187	>	aName: AnsiString=''): ITransaction; overload; virtual; abstract;
188		procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
189		procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
190		procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
#	Line 140 | Line 232 | type
232		function GetEventHandler(Event: AnsiString): IEvents; overload;
233
234		function GetSQLDialect: integer;
235	+	function GetAttachmentID: integer;
236		function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
237		function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
238		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
#	Line 150 | Line 243 | type
243		function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; virtual; abstract;
244		function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
245		function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
246	<	property SQLDialect: integer read FSQLDialect;
246	>	property SQLDialect: integer read GetSQLDialect;
247		property DPB: IDPB read FDPB;
248		public
249		function GetDBInformation(Requests: array of byte): IDBInformation; overload;
#	Line 162 | Line 255 | type
255		function GetSecurityDatabase: AnsiString;
256		function GetODSMajorVersion: integer;
257		function GetODSMinorVersion: integer;
258	+	function GetCharSetID: integer;
259		function HasDecFloatSupport: boolean; virtual;
260		function GetInlineBlobLimit: integer;
261		procedure SetInlineBlobLimit(limit: integer);
262		function HasBatchMode: boolean; virtual;
263	+	function HasTable(aTableName: AnsiString): boolean;
264	+	function HasFunction(aFunctionName: AnsiString): boolean;
265	+	function HasProcedure(aProcName: AnsiString): boolean;
266
267		public
268		{Character Sets}
#	Line 180 | Line 277 | type
277		AllowReverseLookup:boolean; out CharSetID: integer);
278		function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
279		function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
280	<	property CharSetID: integer read FCharSetID;
280	>	property CharSetID: integer read GetCharSetID;
281		property CodePage: TSystemCodePage read FCodePage;
282
283		public
#	Line 214 | Line 311 | type
311
312		implementation
313
314	<	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
314	>	uses FBMessages, IBErrorCodes, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
315	>
316	>	const
317	>	{Journaling}
318	>	sJournalTableName = 'IBX$JOURNALS';
319	>	sSequenceName = 'IBX$SESSIONS';
320	>
321	>	sqlCreateJournalTable =
322	>	'Create Table ' + sJournalTableName + '(' +
323	>	'  IBX$SessionID Integer not null, '+
324	>	'  IBX$TransactionID Integer not null, '+
325	>	'  IBX$OldTransactionID Integer, '+
326	>	'  IBX$USER VarChar(32) Default CURRENT_USER, '+
327	>	'  IBX$CREATED TIMESTAMP Default CURRENT_TIMESTAMP, '+
328	>	'  Primary Key(IBX$SessionID,IBX$TransactionID)' +
329	>	')';
330	>
331	>	sqlCreateSequence = 'CREATE SEQUENCE ' + sSequenceName;
332	>
333	>	sqlGetNextSessionID = 'Select Gen_ID(' + sSequenceName + ',1) as SessionID From RDB$DATABASE';
334	>
335	>	sqlRecordJournalEntry = 'Insert into ' + sJournalTableName + '(IBX$SessionID,IBX$TransactionID,IBX$OldTransactionID) '+
336	>	'Values(?,?,?)';
337	>
338	>	sqlCleanUpSession = 'Delete From ' + sJournalTableName + ' Where IBX$SessionID = ?';
339
340		const
341		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 370 | Line 491 | const
491		'process_name',
492		'trusted_role',
493		'org_filename',
494	<	'utf8_ilename',
494	>	'utf8_filename',
495		'ext_call_depth',
496		'auth_block',
497		'client_version',
#	Line 391 | Line 512 | const
512		'decfloat_traps'
513		);
514
515	+	type
516	+
517	+	{ TQueryProcessor }
518	+
519	+	TQueryProcessor=class(TSQLTokeniser)
520	+	private
521	+	FInString: AnsiString;
522	+	FIndex: integer;
523	+	FStmt: IStatement;
524	+	function DoExecute: AnsiString;
525	+	function GetParamValue(ParamIndex: integer): AnsiString;
526	+	protected
527	+	function GetChar: AnsiChar; override;
528	+	public
529	+	class function Execute(Stmt: IStatement): AnsiString;
530	+	end;
531	+
532	+	{ TQueryProcessor }
533	+
534	+	function TQueryProcessor.DoExecute: AnsiString;
535	+	var token: TSQLTokens;
536	+	ParamIndex: integer;
537	+	begin
538	+	Result := '';
539	+	ParamIndex := 0;
540	+
541	+	while not EOF do
542	+	begin
543	+	token := GetNextToken;
544	+	case token of
545	+	sqltPlaceHolder:
546	+	begin
547	+	Result := Result + GetParamValue(ParamIndex);
548	+	Inc(ParamIndex);
549	+	end;
550	+
551	+	sqltIdentifierInDoubleQuotes:
552	+	Result := Result + '"' + TokenText + '"';
553	+	else
554	+	Result := Result + TokenText;
555	+	end;
556	+	end;
557	+	end;
558	+
559	+	function TQueryProcessor.GetParamValue(ParamIndex: integer): AnsiString;
560	+
561	+	function formatWithTZ(fmt: AnsiString): AnsiString;
562	+	var aDateTime: TDateTime;
563	+	aTimeZone: AnsiString;
564	+	dstOffset: smallint;
565	+	begin
566	+	with FStmt.GetAttachment.GetTimeZoneServices, FStmt.SQLParams[ParamIndex] do
567	+	begin
568	+	if GetTZTextOption = tzGMT then
569	+	Result := FBFormatDateTime(fmt,GetAsUTCDateTime)
570	+	else
571	+	begin
572	+	GetAsDateTime(aDateTime,dstOffset,aTimeZone);
573	+	if GetTZTextOption = tzOffset then
574	+	Result := FBFormatDateTime(fmt,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
575	+	else
576	+	Result := FBFormatDateTime(fmt,aDateTime) + ' ' + aTimeZone;
577	+	end;
578	+	end;
579	+	end;
580	+
581	+	begin
582	+	with FStmt.SQLParams[ParamIndex] do
583	+	begin
584	+	if IsNull then
585	+	Result := 'NULL'
586	+	else
587	+	case getColMetadata.GetSQLType of
588	+	SQL_BLOB:
589	+	if  GetSQLType = SQL_BLOB then
590	+	begin
591	+	if getSubType = 1 then {string}
592	+	Result := '''' + SQLSafeString(GetAsString) + ''''
593	+	else
594	+	Result := TSQLXMLReader.FormatBlob(GetAsString,getSubType);
595	+	end
596	+	else
597	+	Result := '''' + SQLSafeString(GetAsString) + '''';
598	+
599	+	SQL_ARRAY:
600	+	Result := TSQLXMLReader.FormatArray(getAsArray);
601	+
602	+	SQL_VARYING,
603	+	SQL_TEXT:
604	+	Result := '''' + SQLSafeString(GetAsString) + '''';
605	+
606	+	SQL_TYPE_DATE:
607	+	Result := '''' + SQLSafeString(FormatDateTime('yyyy-mm-dd',GetAsDateTime)) + '''';
608	+
609	+	SQL_TIMESTAMP:
610	+	Result := '''' + SQLSafeString(FBFormatDateTime('yyyy-mm-dd hh:mm:ss.zzzz',GetAsDateTime)) + '''';
611	+
612	+	SQL_TYPE_TIME:
613	+	Result := '''' + SQLSafeString(FBFormatDateTime('hh:mm:ss.zzzz',GetAsDateTime)) + '''';
614	+
615	+	SQL_TIMESTAMP_TZ_EX,
616	+	SQL_TIMESTAMP_TZ:
617	+	Result := '''' + SQLSafeString(formatWithTZ('yyyy-mm-dd hh:mm:ss.zzzz')) + '''';
618	+
619	+	SQL_TIME_TZ_EX,
620	+	SQL_TIME_TZ:
621	+	Result := '''' + SQLSafeString(formatWithTZ('hh:mm:ss.zzzz')) + '''';
622	+
623	+	else
624	+	Result := GetAsString;
625	+	end;
626	+	end;
627	+	end;
628	+
629	+	function TQueryProcessor.GetChar: AnsiChar;
630	+	begin
631	+	if FIndex <= Length(FInString) then
632	+	begin
633	+	Result := FInString[FIndex];
634	+	Inc(FIndex);
635	+	end
636	+	else
637	+	Result := #0;
638	+	end;
639	+
640	+	class function TQueryProcessor.Execute(Stmt: IStatement): AnsiString;
641	+	begin
642	+	if not Stmt.IsPrepared then
643	+	IBError(ibxeSQLClosed,[]);
644	+	with self.Create do
645	+	try
646	+	FStmt := Stmt;
647	+	FInString := Stmt.GetProcessedSQLText;
648	+	FIndex := 1;
649	+	Result := Trim(DoExecute);
650	+	finally
651	+	Free;
652	+	end;
653	+	end;
654	+
655	+	{ TFBJournaling }
656	+
657	+	function TFBJournaling.GetDateTimeFmt: AnsiString;
658	+	begin
659	+	{$IF declared(DefaultFormatSettings)}
660	+	with DefaultFormatSettings do
661	+	{$ELSE}
662	+	{$IF declared(FormatSettings)}
663	+	with FormatSettings do
664	+	{$IFEND}
665	+	{$IFEND}
666	+	Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzzz'
667	+	end;
668	+
669	+	procedure TFBJournaling.WriteJnlEntry(LogEntry: AnsiString);
670	+	begin
671	+	if assigned(FJournalFileStream) then
672	+	begin
673	+	FCriticalSection.Acquire;
674	+	try
675	+	FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
676	+	finally
677	+	FCriticalSection.Release;
678	+	end;
679	+	end;
680	+
681	+	end;
682	+
683	+	procedure TFBJournaling.EndSession(RetainJournal: boolean);
684	+	begin
685	+	if JournalingActive and (FJournalFileStream <> nil) then
686	+	begin
687	+	if FOwnsJournal then
688	+	FJournalFileStream.Free;
689	+	FJournalFileStream := nil;
690	+
691	+	if not (joNoServerTable in FOptions) and not RetainJournal then
692	+	try
693	+	GetAttachment.ExecuteSQL([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],
694	+	sqlCleanUpSession,[FSessionID]);
695	+	if FileExists(FJournalFilePath) then
696	+	sysutils.DeleteFile(FJournalFilePath);
697	+	except On E: EIBInterBaseError do
698	+	if E.IBErrorCode <> isc_lost_db_connection then
699	+	raise;
700	+	{ignore - do not delete journal if database gone away}
701	+	end;
702	+	FSessionID := -1;
703	+	FJournalFilePath := '';
704	+	end;
705	+	end;
706	+
707	+	procedure TFBJournaling.Disconnect(Force: boolean);
708	+	begin
709	+	if JournalingActive then
710	+	EndSession(Force);
711	+	end;
712	+
713	+	procedure TFBJournaling.TransactionStart(Tr: ITransaction);
714	+	var LogEntry: AnsiString;
715	+	TPBText: AnsiString;
716	+	begin
717	+	if not (joNoServerTable in FOptions) then
718	+	try
719	+	FDoNotJournal := true;
720	+	GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,NULL]);
721	+	finally
722	+	FDoNotJournal := false;
723	+	end;
724	+	TPBText := Tr.getTPB.AsText;
725	+	LogEntry := Format(sTransStartJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
726	+	GetAttachment.GetAttachmentID,
727	+	FSessionID,
728	+	Tr.GetTransactionID,
729	+	Length(Tr.TransactionName),
730	+	Tr.TransactionName,
731	+	Length(TPBText),TPBText,
732	+	ord(tr.GetDefaultCompletion)]);
733	+	WriteJnlEntry(LogEntry);
734	+	end;
735	+
736	+	function TFBJournaling.TransactionEnd(TransactionID: integer;
737	+	Completion: TTrCompletionState): boolean;
738	+
739	+	var LogEntry: AnsiString;
740	+	begin
741	+	Result := false;
742	+	case Completion of
743	+	trRolledback:
744	+	begin
745	+	LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
746	+	GetAttachment.GetAttachmentID,
747	+	FSessionID,TransactionID]);
748	+	Result := true;
749	+	end;
750	+
751	+	trRollbackFailed:
752	+	begin
753	+	LogEntry := Format(sTransRollbackFailJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
754	+	GetAttachment.GetAttachmentID,
755	+	FSessionID,TransactionID]);
756	+	Result := true;
757	+	end;
758	+
759	+	trCommitted:
760	+	begin
761	+	LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
762	+	GetAttachment.GetAttachmentID,
763	+	FSessionID,TransactionID]);
764	+	Result := true;
765	+	end;
766	+
767	+	trCommitFailed:
768	+	begin
769	+	LogEntry := Format(sTransCommitFailJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
770	+	GetAttachment.GetAttachmentID,
771	+	FSessionID,TransactionID]);
772	+	Result := true;
773	+	end;
774	+	end;
775	+	WriteJnlEntry(LogEntry);
776	+	end;
777	+
778	+	procedure TFBJournaling.TransactionRetained(Tr: ITransaction;
779	+	OldTransactionID: integer; Action: TTransactionAction);
780	+	var LogEntry: AnsiString;
781	+	begin
782	+	case Action of
783	+	TACommitRetaining:
784	+	LogEntry := Format(sTransCommitRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
785	+	GetAttachment.GetAttachmentID,
786	+	FSessionID,Tr.GetTransactionID,OldTransactionID]);
787	+	TARollbackRetaining:
788	+	LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
789	+	GetAttachment.GetAttachmentID,
790	+	FSessionID,Tr.GetTransactionID,OldTransactionID]);
791	+	end;
792	+	WriteJnlEntry(LogEntry);
793	+
794	+	if not (joNoServerTable in FOptions) then
795	+	try
796	+	FDoNotJournal := true;
797	+	GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,OldTransactionID]);
798	+	finally
799	+	FDoNotJournal := false;
800	+	end;
801	+	end;
802	+
803	+	procedure TFBJournaling.ExecQuery(Stmt: IStatement);
804	+	var SQL: AnsiString;
805	+	LogEntry: AnsiString;
806	+	begin
807	+	SQL := TQueryProcessor.Execute(Stmt);
808	+	LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
809	+	GetAttachment.GetAttachmentID,
810	+	FSessionID,
811	+	Stmt.GetTransaction.GetTransactionID,
812	+	Length(SQL),SQL]);
813	+	WriteJnlEntry(LogEntry);
814	+	end;
815	+
816	+	procedure TFBJournaling.ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
817	+	var LogEntry: AnsiString;
818	+	begin
819	+	LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
820	+	GetAttachment.GetAttachmentID,
821	+	FSessionID,
822	+	tr.GetTransactionID,
823	+	Length(sql),sql]);
824	+	WriteJnlEntry(LogEntry);
825	+	end;
826	+
827	+	constructor TFBJournaling.Create;
828	+	begin
829	+	inherited Create;
830	+	FCriticalSection := TCriticalSection.Create;
831	+	end;
832
833	+	destructor TFBJournaling.Destroy;
834	+	begin
835	+	if FCriticalSection <> nil then
836	+	FCriticalSection.Free;
837	+	inherited Destroy;
838	+	end;
839	+
840	+	function TFBJournaling.JournalingActive: boolean;
841	+	begin
842	+	Result := (FJournalFileStream <> nil) and not FDoNotJournal;
843	+	end;
844	+
845	+	function TFBJournaling.GetJournalOptions: TJournalOptions;
846	+	begin
847	+	Result := FOptions;
848	+	end;
849	+
850	+	function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString): integer;
851	+	begin
852	+	Result := StartJournaling(aJournalLogFile,[joReadWriteTransactions,joModifyQueries]);
853	+	end;
854	+
855	+	function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString;
856	+	Options: TJournalOptions): integer;
857	+	begin
858	+	try
859	+	StartJournaling(TFileStream.Create(aJournalLogFile,fmCreate),Options);
860	+	FOwnsJournal := true;
861	+	finally
862	+	FJournalFilePath := aJournalLogFile;
863	+	end;
864	+	end;
865	+
866	+	function TFBJournaling.StartJournaling(S: TStream; Options: TJournalOptions
867	+	): integer;
868	+	begin
869	+	FOptions := Options;
870	+	if not (joNoServerTable in FOptions) then
871	+	with GetAttachment do
872	+	begin
873	+	if  not HasTable(sJournalTableName) then
874	+	begin
875	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateJournalTable);
876	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateSequence);
877	+	end;
878	+	FSessionID := OpenCursorAtStart(sqlGetNextSessionID)[0].AsInteger;
879	+	end;
880	+	FJournalFileStream := S;
881	+	FOwnsJournal := false;
882	+	Result := FSessionID;
883	+	end;
884	+
885	+	procedure TFBJournaling.StopJournaling(RetainJournal: boolean);
886	+	begin
887	+	EndSession(RetainJournal);
888	+	end;
889
890		{ TFBAttachment }
891
892	<	procedure TFBAttachment.GetODSAndConnectionInfo;
893	<	var DBInfo: IDBInformation;
400	<	i: integer;
401	<	Stmt: IStatement;
892	>	procedure TFBAttachment.NeedConnectionInfo;
893	>	var Stmt: IStatement;
894		ResultSet: IResultSet;
895		Param: IDPBItem;
896		begin
897	<	if not IsConnected then Exit;
898	<	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
407	<	isc_info_db_SQL_Dialect]);
408	<	for i := 0 to DBInfo.GetCount - 1 do
409	<	with DBInfo[i] do
410	<	case getItemType of
411	<	isc_info_ods_minor_version:
412	<	FODSMinorVersion := getAsInteger;
413	<	isc_info_ods_version:
414	<	FODSMajorVersion := getAsInteger;
415	<	isc_info_db_SQL_Dialect:
416	<	FSQLDialect := getAsInteger;
417	<	end;
418	<
897	>	if not IsConnected or FHasConnectionInfo then Exit;
898	>	NeedDBInfo;
899		FCharSetID := 0;
900		FRemoteProtocol := '';
901		FAuthMethod := 'Legacy_Auth';
#	Line 461 | Line 941 | begin
941		end;
942		end;
943		FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
944	+	FHasConnectionInfo := true;
945	+	end;
946	+
947	+	procedure TFBAttachment.NeedDBInfo;
948	+	var DBInfo: IDBInformation;
949	+	i: integer;
950	+	begin
951	+	if not IsConnected or (FAttachmentID > 0) then Exit;
952	+	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
953	+	isc_info_db_SQL_Dialect, isc_info_attachment_id]);
954	+	for i := 0 to DBInfo.GetCount - 1 do
955	+	with DBInfo[i] do
956	+	case getItemType of
957	+	isc_info_ods_minor_version:
958	+	FODSMinorVersion := getAsInteger;
959	+	isc_info_ods_version:
960	+	FODSMajorVersion := getAsInteger;
961	+	isc_info_db_SQL_Dialect:
962	+	FSQLDialect := getAsInteger;
963	+	isc_info_attachment_id:
964	+	FAttachmentID := getAsInteger;
965	+	end;
966		end;
967
968		constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
#	Line 470 | Line 972 | begin
972		FFirebirdAPI := api.GetAPI; {Keep reference to interface}
973		FSQLDialect := 3;
974		FDatabaseName := DatabaseName;
473	–	FDPB := DPB;
975		SetLength(FUserCharSetMap,0);
976	+	ClearCachedInfo;
977	+	FInlineBlobLimit := DefaultMaxInlineBlobLimit;
978	+	FDPB := DPB;
979		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
980	+	end;
981	+
982	+	procedure TFBAttachment.ClearCachedInfo;
983	+	begin
984	+	FHasDefaultCharSet := false;
985	+	FAttachmentID := 0;
986		FODSMajorVersion := 0;
987		FODSMinorVersion := 0;
988	<	FInlineBlobLimit := DefaultMaxInlineBlobLimit;
988	>	FCodePage := CP_NONE;
989	>	FCharSetID := 0;
990	>	FRemoteProtocol := '';
991	>	FAuthMethod := '';
992	>	FSecDatabase := '';
993	>	FHasConnectionInfo := false;
994		end;
995
996		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 609 | Line 1124 | begin
1124		end;
1125		end;
1126
1127	+	procedure TFBAttachment.SetSQLDialect(aValue: integer);
1128	+	begin
1129	+	FSQLDialect := aValue;
1130	+	end;
1131	+
1132		procedure TFBAttachment.UseServerICUChanged;
1133		begin
1134		// Do nothing by default
#	Line 620 | Line 1140 | begin
1140		inherited Destroy;
1141		end;
1142
1143	+	procedure TFBAttachment.Disconnect(Force: boolean);
1144	+	begin
1145	+	inherited Disconnect(Force);
1146	+	ClearCachedInfo;
1147	+	end;
1148	+
1149		function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
1150		begin
1151		Result := FFirebirdAPI;
#	Line 642 | Line 1168 | end;
1168
1169		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
1170		aSQLDialect: integer);
1171	+	var tr: ITransaction;
1172		begin
1173	<	ExecImmediate(StartTransaction(TPB,taCommit),sql,aSQLDialect);
1173	>	tr := StartTransaction(TPB,taCommit);
1174	>	try
1175	>	ExecImmediate(tr,sql,aSQLDialect);
1176	>	tr.Commit;
1177	>	except
1178	>	tr.Rollback(true);
1179	>	raise;
1180	>	end;
1181		end;
1182
1183		procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: AnsiString);
#	Line 653 | Line 1187 | end;
1187
1188		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString);
1189		begin
1190	<	ExecImmediate(StartTransaction(TPB,taCommit),sql,FSQLDialect);
1190	>	ExecImmediate(TPB,sql,FSQLDialect);
1191		end;
1192
1193		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
1194		SQLDialect: integer; params: array of const): IResults;
1195	+	var tr: ITransaction;
1196		begin
1197	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
1197	>	tr := StartTransaction(TPB,taCommit);
1198	>	try
1199	>	Result := ExecuteSQL(tr,sql,SQLDialect,params);
1200	>	tr.CommitRetaining;
1201	>	except
1202	>	tr.Rollback(true);
1203	>	raise;
1204	>	end;
1205		end;
1206
1207		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 675 | Line 1217 | end;
1217		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
1218		params: array of const): IResults;
1219		begin
1220	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,params);
1220	>	Result := ExecuteSQL(TPB,sql,FSQLDialect,params);
1221		end;
1222
1223		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
1224		params: array of const): IResults;
1225		begin
1226	<	with Prepare(transaction,sql,FSQLDialect) do
685	<	begin
686	<	SetParameters(SQLParams,params);
687	<	Result := Execute;
688	<	end;
1226	>	Result := ExecuteSQL(transaction,sql,FSQLDialect,params);
1227		end;
1228
1229		function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
#	Line 778 | Line 1316 | end;
1316
1317		function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
1318		params: array of const): IResultSet;
1319	+	var tr: ITransaction;
1320		begin
1321	<	Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,
1322	<	Scrollable,params);
1321	>	tr := StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit);
1322	>	try
1323	>	Result := OpenCursorAtStart(tr,sql,FSQLDialect,Scrollable,params);
1324	>	tr.CommitRetaining;
1325	>	except
1326	>	tr.Rollback(true);
1327	>	raise;
1328	>	end;
1329		end;
1330
1331		function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
1332		params: array of const): IResultSet;
1333		begin
1334	<	Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,
790	<	false,params);
1334	>	Result := OpenCursorAtStart(sql,false,params);
1335		end;
1336
1337		function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString;
#	Line 817 | Line 1361 | end;
1361
1362		function TFBAttachment.GetSQLDialect: integer;
1363		begin
1364	+	NeedDBInfo;
1365		Result := FSQLDialect;
1366		end;
1367
1368	+	function TFBAttachment.GetAttachmentID: integer;
1369	+	begin
1370	+	NeedDBInfo;
1371	+	Result := FAttachmentID;
1372	+	end;
1373	+
1374		function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
1375		ColumnName: AnsiString; BPB: IBPB): IBlob;
1376		begin
#	Line 896 | Line 1447 | end;
1447
1448		function TFBAttachment.GetRemoteProtocol: AnsiString;
1449		begin
1450	+	NeedConnectionInfo;
1451		Result := FRemoteProtocol;
1452		end;
1453
1454		function TFBAttachment.GetAuthenticationMethod: AnsiString;
1455		begin
1456	+	NeedConnectionInfo;
1457		Result := FAuthMethod;
1458		end;
1459
1460		function TFBAttachment.GetSecurityDatabase: AnsiString;
1461		begin
1462	+	NeedConnectionInfo;
1463		Result := FSecDatabase;
1464		end;
1465
1466		function TFBAttachment.GetODSMajorVersion: integer;
1467		begin
1468	+	NeedDBInfo;
1469		Result := FODSMajorVersion;
1470		end;
1471
1472		function TFBAttachment.GetODSMinorVersion: integer;
1473		begin
1474	+	NeedDBInfo;
1475		Result := FODSMinorVersion;
1476		end;
1477
1478	+	function TFBAttachment.GetCharSetID: integer;
1479	+	begin
1480	+	NeedConnectionInfo;
1481	+	Result := FCharSetID;
1482	+	end;
1483	+
1484		function TFBAttachment.HasDecFloatSupport: boolean;
1485		begin
1486		Result := false;
#	Line 942 | Line 1504 | begin
1504		Result := false;
1505		end;
1506
1507	+	function TFBAttachment.HasTable(aTableName: AnsiString): boolean;
1508	+	begin
1509	+	Result := OpenCursorAtStart(
1510	+	'Select count(*) From RDB$RELATIONS Where RDB$RELATION_NAME = ?',
1511	+	[aTableName])[0].AsInteger > 0;
1512	+	end;
1513	+
1514	+	function TFBAttachment.HasFunction(aFunctionName: AnsiString): boolean;
1515	+	begin
1516	+	Result := OpenCursorAtStart(
1517	+	'Select count(*) From RDB$FUNCTIONS Where RDB$FUNCTION_NAME = ?',
1518	+	[aFunctionName])[0].AsInteger > 0;
1519	+	end;
1520	+
1521	+	function TFBAttachment.HasProcedure(aProcName: AnsiString): boolean;
1522	+	begin
1523	+	Result := OpenCursorAtStart(
1524	+	'Select count(*) From RDB$PROCEDURES Where RDB$PROCEDURE_NAME = ?',
1525	+	[aProcName])[0].AsInteger > 0;
1526	+	end;
1527	+
1528		function TFBAttachment.HasDefaultCharSet: boolean;
1529		begin
1530	+	NeedConnectionInfo;
1531		Result := FHasDefaultCharSet
1532		end;
1533
1534		function TFBAttachment.GetDefaultCharSetID: integer;
1535		begin
1536	+	NeedConnectionInfo;
1537		Result := FCharsetID;
1538		end;
1539

Diff Legend

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