ViewVC Help

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

root/public/ibx/trunk/runtime/nongui/IBDatabase.pas

Comparing ibx/trunk/runtime/nongui/IBDatabase.pas (file contents):
Revision 229 by tony, Tue Apr 10 13:32:36 2018 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

#	Line 185 | Line 185 | type
185		private
186		FCloseAction: TIBDatabaseCloseActions;
187		FAttachment: IAttachment;
188	+	FConfigOverrides: TStrings;
189		FCreateDatabase: boolean;
190		FCreateIfNotExists: boolean;
191		FAllowStreamedConnected: boolean;
192	+	FFirebirdLibraryPathName: TIBFileName;
193		FHiddenPassword: string;
194		FOnCreateDatabase: TNotifyEvent;
195		FOnLogin: TIBDatabaseLoginEvent;
#	Line 208 | Line 210 | type
210		FLoginCalled: boolean;
211		FUseDefaultSystemCodePage: boolean;
212		FUseHiddenPassword: boolean;
213	+	FFirebirdAPI: IFirebirdAPI;
214		procedure EnsureInactive;
215		function GetAuthenticationMethod: string;
216		function GetDBSQLDialect: Integer;
217		function GetDefaultCharSetID: integer;
218		function GetDefaultCharSetName: AnsiString;
219		function GetDefaultCodePage: TSystemCodePage;
220	+	function GetFirebirdAPI: IFirebirdAPI;
221		function GetRemoteProtocol: string;
222		function GetSQLObjectsCount: Integer;
223	+	function GetWireCompression: boolean;
224	+	procedure SetAttachment(AValue: IAttachment);
225	+	procedure SetConfigOverrides(AValue: TStrings);
226	+	procedure SetFirebirdLibraryPathName(AValue: TIBFileName);
227		procedure SetSQLDialect(const Value: Integer);
228	+	procedure SetWireCompression(AValue: boolean);
229		procedure ValidateClientSQLDialect;
230		procedure DBParamsChange(Sender: TObject);
231		procedure DBParamsChanging(Sender: TObject);
232	+	function GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
233		function GetSQLObject(Index: Integer): TIBBase;
234		function GetSQLObjectCount: Integer;
235		function GetIdleTimer: Integer;
#	Line 237 | Line 247 | type
247		procedure RemoveSQLObject(Idx: Integer);
248		procedure RemoveSQLObjects;
249		procedure InternalClose;
250	+	procedure InternalBeforeClose;
251	+	procedure InternalAfterClose;
252	+	procedure InternalBeforeConnect(aDBParams: TStrings; var aDBName: string;
253	+	var aCreateIfNotExists: boolean);
254	+	procedure InternalAfterConnect;
255		procedure DoOnCreateDatabase;
256
257		protected
#	Line 273 | Line 288 | type
288		procedure RemoveTransaction(Idx: Integer);
289		procedure RemoveTransactions;
290
291	<	property Attachment: IAttachment read FAttachment;
291	>	property Attachment: IAttachment read FAttachment write SetAttachment;
292	>	property FirebirdAPI: IFirebirdAPI read GetFirebirdAPI;
293		property DBSQLDialect : Integer read GetDBSQLDialect;
294		property IsReadOnly: Boolean read GetIsReadOnly;
295		property SQLObjectCount: Integer read GetSQLObjectCount; {ignores nil objects}
#	Line 294 | Line 310 | type
310		property AllowStreamedConnected: boolean read FAllowStreamedConnected
311		write FAllowStreamedConnected;
312		property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
313	+	property FirebirdLibraryPathName: TIBFileName read FFirebirdLibraryPathName
314	+	write SetFirebirdLibraryPathName;
315		property Params: TStrings read FDBParams write SetDBParams;
316	+	property ConfigOverrides: TStrings read FConfigOverrides write SetConfigOverrides;
317		property LoginPrompt default True;
318		property DefaultTransaction: TIBTransaction read FDefaultTransaction
319		write SetDefaultTransaction;
#	Line 304 | Line 323 | type
323		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
324		property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
325		write FUseDefaultSystemCodePage;
326	+	property WireCompression: boolean read GetWireCompression write SetWireCompression
327	+	stored false;
328		property AfterConnect;
329		property AfterDisconnect;
330		property BeforeConnect;
#	Line 311 | Line 332 | type
332		property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
333		property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
334		property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
335	<	property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
335	>	property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning
336	>	write FOnDialectDowngradeWarning;
337		end;
338
339		TDefaultEndAction = TARollback..TACommit;
#	Line 368 | Line 390 | type
390		function AddSQLObject(ds: TIBBase): Integer;
391		procedure RemoveSQLObject(Idx: Integer);
392		procedure RemoveSQLObjects;
393	+	function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
394
395		protected
396		procedure Loaded; override;
#	Line 495 | Line 518 | type
518		write SetTransaction;
519		end;
520
498	–	function GenerateDPB(sl: TStrings): IDPB;
499	–	function GenerateTPB(sl: TStrings): ITPB;
500	–
521
522		implementation
523
524		uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
525	<	typInfo, FBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
525	>	typInfo, IBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
526
527		{ TIBDatabase }
528
#	Line 512 | Line 532 | begin
532		LoginPrompt := True;
533		FSQLObjects := TList.Create;
534		FTransactions := TList.Create;
535	+	FConfigOverrides := TStringList.Create;
536		FDBName := '';
537		FDBParams := TStringList.Create;
538		FSQLHourGlass := true;
#	Line 548 | Line 569 | begin
569		RemoveSQLObjects;
570		RemoveTransactions;
571		FInternalTransaction.Free;
572	+	FConfigOverrides.Free;
573		FDBParams.Free;
574		FSQLObjects.Free;
575		FTransactions.Free;
576		FDataSets.Free;
577	+	FFirebirdAPI := nil;
578		inherited Destroy;
579		end;
580
#	Line 793 | Line 816 | begin
816		end;
817
818		procedure TIBDataBase.InternalClose;
819	+	begin
820	+	CheckActive;
821	+	InternalBeforeClose;
822	+	case FCloseAction of
823	+	caNormal:
824	+	FAttachment.Disconnect(false);
825	+	caForce:
826	+	FAttachment.Disconnect(true);
827	+	caDropDatabase:
828	+	FAttachment.DropDatabase;
829	+	end;
830	+	FAttachment := nil;
831	+	FHiddenPassword := '';
832	+	FCloseAction := caNormal;
833	+
834	+	if not (csDesigning in ComponentState) then
835	+	MonitorHook.DBDisconnect(Self);
836	+
837	+	InternalAfterClose;
838	+	end;
839	+
840	+	procedure TIBDataBase.InternalBeforeClose;
841		var
842		i: Integer;
843		begin
799	–	CheckActive;
844		{ Tell all connected transactions that we're disconnecting.
845		This is so transactions can commit/rollback, accordingly
846		}
#	Line 821 | Line 865 | begin
865		end;
866		end;
867
868	<	case FCloseAction of
825	<	caNormal:
826	<	FAttachment.Disconnect(false);
827	<	caForce:
828	<	FAttachment.Disconnect(true);
829	<	caDropDatabase:
830	<	FAttachment.DropDatabase;
831	<	end;
832	<	FAttachment := nil;
833	<	FHiddenPassword := '';
834	<	FCloseAction := caNormal;
835	<
836	<	if not (csDesigning in ComponentState) then
837	<	MonitorHook.DBDisconnect(Self);
868	>	end;
869
870	+	procedure TIBDataBase.InternalAfterClose;
871	+	var
872	+	i: Integer;
873	+	begin
874		for i := 0 to FSQLObjects.Count - 1 do
875		if FSQLObjects[i] <> nil then
876		SQLObjects[i].DoAfterDatabaseDisconnect;
877		end;
878
879	+	procedure TIBDataBase.InternalBeforeConnect(aDBParams: TStrings; var aDBName: string;
880	+	var aCreateIfNotExists: boolean);
881	+	var i: integer;
882	+	begin
883	+	{Opportunity to override defaults}
884	+	for i := 0 to FSQLObjects.Count - 1 do
885	+	begin
886	+	if FSQLObjects[i] <> nil then
887	+	SQLObjects[i].DoBeforeDatabaseConnect(aDBParams,aDBName, aCreateIfNotExists);
888	+	end;
889	+	end;
890	+
891	+	procedure TIBDataBase.InternalAfterConnect;
892	+	var i: integer;
893	+	begin
894	+	for i := 0 to FSQLObjects.Count - 1 do
895	+	begin
896	+	if FSQLObjects[i] <> nil then
897	+	SQLObjects[i].DoAfterDatabaseConnect;
898	+	end;
899	+	end;
900	+
901		procedure TIBDataBase.DoOnCreateDatabase;
902		var i: integer;
903		begin
#	Line 1034 | Line 1091 | procedure TIBDataBase.DoConnect;
1091
1092		var
1093		TempDBParams: TStrings;
1037	–	I: integer;
1094		aDBName, oldDBName: string;
1095		Status: IStatus;
1096		CharSetID: integer;
#	Line 1072 | Line 1128 | begin
1128		if UseDefaultSystemCodePage then
1129		TempDBParams.Values['lc_ctype'] :='UTF8';
1130		{$endif}
1131	<	{Opportunity to override defaults}
1076	<	for i := 0 to FSQLObjects.Count - 1 do
1077	<	begin
1078	<	if FSQLObjects[i] <> nil then
1079	<	SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName, aCreateIfNotExists);
1080	<	end;
1131	>	InternalBeforeConnect(TempDBParams,aDBName,aCreateIfNotExists);
1132
1133		repeat
1134		{ Generate a new DPB if necessary }
#	Line 1085 | Line 1136 | begin
1136		begin
1137		FDBParamsChanged := False;
1138		if not FUseHiddenPassword and (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1139	<	DPB := GenerateDPB(TempDBParams)
1139	>	DPB := GenerateDPB(FirebirdAPI,TempDBParams)
1140		else
1141		begin
1142		TempDBParams.Values['password'] := FHiddenPassword;
1143	<	DPB := GenerateDPB(TempDBParams);
1143	>	DPB := GenerateDPB(FirebirdAPI,TempDBParams);
1144		end;
1145		end;
1146
#	Line 1099 | Line 1150 | begin
1150		DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect; {create with this SQL Dialect}
1151		FAttachment := FirebirdAPI.CreateDatabase(aDBName,DPB, false);
1152		if FAttachment = nil then
1153	<	DPB := nil;
1154	<	DoOnCreateDatabase;
1153	>	DPB := nil
1154	>	else
1155	>	DoOnCreateDatabase;
1156		end
1157		else
1158		FAttachment := FirebirdAPI.OpenDatabase(aDBName,DPB,false);
#	Line 1163 | Line 1215 | begin
1215		if not (csDesigning in ComponentState) then
1216		FDBName := aDBName; {Synchronise at run time}
1217		ValidateClientSQLDialect;
1218	<	for i := 0 to FSQLObjects.Count - 1 do
1167	<	begin
1168	<	if FSQLObjects[i] <> nil then
1169	<	SQLObjects[i].DoAfterDatabaseConnect;
1170	<	end;
1218	>	InternalAfterConnect;
1219		if not (csDesigning in ComponentState) then
1220		MonitorHook.DBConnect(Self);
1221		end;
#	Line 1353 | Line 1401 | begin
1401		IBError(ibxeSQLDialectInvalid, [nil]);
1402		end;
1403
1404	+	procedure TIBDataBase.SetWireCompression(AValue: boolean);
1405	+	var Index: integer;
1406	+	begin
1407	+	if AValue then
1408	+	FConfigOverrides.Values['WireCompression'] := 'true'
1409	+	else
1410	+	begin
1411	+	Index := FConfigOverrides.IndexOfName('WireCompression');
1412	+	if Index <> -1 then
1413	+	FConfigOverrides.Delete(Index);
1414	+	end;
1415	+	end;
1416	+
1417		function TIBDataBase.GetDBSQLDialect: Integer;
1418		begin
1419		CheckActive;
#	Line 1383 | Line 1444 | begin
1444		Result := CP_NONE;
1445		end;
1446
1447	+	function TIBDataBase.GetFirebirdAPI: IFirebirdAPI;
1448	+	var fblib: IFirebirdLibrary;
1449	+	begin
1450	+	if FFirebirdAPI = nil then
1451	+	begin
1452	+	if (csDesigning in ComponentState) or (Trim(FFirebirdLibraryPathName) = '') then
1453	+	FFirebirdAPI := IB.FirebirdAPI
1454	+	else
1455	+	begin
1456	+	fblib := IB.LoadFBLibrary(FFirebirdLibraryPathName);
1457	+	if assigned(fblib) then
1458	+	FFirebirdAPI := fblib.GetFirebirdAPI;
1459	+	end;
1460	+	end;
1461	+	Result := FFirebirdAPI;
1462	+	end;
1463	+
1464		function TIBDataBase.GetRemoteProtocol: string;
1465		begin
1466		CheckActive;
#	Line 1394 | Line 1472 | begin
1472		Result := FSQLObjects.Count;
1473		end;
1474
1475	+	function TIBDataBase.GetWireCompression: boolean;
1476	+	begin
1477	+	Result := CompareText(FConfigOverrides.Values['WireCompression'],'true') = 0;
1478	+	end;
1479	+
1480	+	procedure TIBDataBase.SetAttachment(AValue: IAttachment);
1481	+	begin
1482	+	if FAttachment = AValue then Exit;
1483	+	if FAttachment <> nil then
1484	+	begin
1485	+	if Assigned(BeforeDisconnect) then
1486	+	BeforeDisconnect(self);
1487	+	InternalBeforeClose;
1488	+	FAttachment := nil;
1489	+	FFirebirdAPI := nil;
1490	+	InternalAfterClose;
1491	+	if Assigned(AfterDisconnect) then
1492	+	AfterDisconnect(self);
1493	+	end;
1494	+	if Assigned(BeforeConnect) then
1495	+	BeforeConnect(self);
1496	+	FAttachment := AValue;
1497	+	if FAttachment <> nil then
1498	+	begin
1499	+	ValidateClientSQLDialect;
1500	+	FDBName := FAttachment.GetConnectString;
1501	+	if FFirebirdLibraryPathName <> '' then
1502	+	FFirebirdLibraryPathName := FAttachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath;
1503	+	InternalAfterConnect;
1504	+	if Assigned(AfterConnect) then
1505	+	AfterConnect(self);
1506	+	end;
1507	+	end;
1508	+
1509	+	procedure TIBDataBase.SetConfigOverrides(AValue: TStrings);
1510	+	begin
1511	+	if FConfigOverrides = AValue then Exit;
1512	+	FConfigOverrides.Assign(AValue);
1513	+	end;
1514	+
1515	+	procedure TIBDataBase.SetFirebirdLibraryPathName(AValue: TIBFileName);
1516	+	begin
1517	+	if FFirebirdLibraryPathName = AValue then Exit;
1518	+	FFirebirdLibraryPathName := AValue;
1519	+	ForceClose;
1520	+	FFirebirdAPI := nil;
1521	+	end;
1522	+
1523		procedure TIBDataBase.ValidateClientSQLDialect;
1524		begin
1525		if (DBSQLDialect < FSQLDialect) then
#	Line 2061 | Line 2187 | begin
2187		if FTRParamsChanged then
2188		begin
2189		FTRParamsChanged := False;
2190	<	FTPB :=  GenerateTPB(FTRParams);
2190	>	FTPB :=  GenerateTPB(Databases[0].FirebirdAPI,FTRParams);
2191		end;
2192
2193		ValidDatabaseCount := 0;
#	Line 2077 | Line 2203 | begin
2203		if Databases[i] <> nil then
2204		Attachments[i] := Databases[i].Attachment;
2205
2206	<	FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
2206	>	FTransactionIntf := Databases[0].FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
2207		end;
2208		end;
2209
#	Line 2282 | Line 2408 | end;
2408		parameter buffer, and return it and its length
2409		in DPB and DPBLength, respectively. }
2410
2411	<	function GenerateDPB(sl: TStrings): IDPB;
2411	>	function TIBDataBase.GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
2412		var
2413		i, j: Integer;
2414		DPBVal: UShort;
#	Line 2353 | Line 2479 | begin
2479		end;
2480		end;
2481		end;
2482	+	if FConfigOverrides.Count > 0 then
2483	+	Result.Add(isc_dpb_config).SetAsString(FConfigOverrides.Text);
2484		end;
2485
2486		{ GenerateTPB -
#	Line 2360 | Line 2488 | end;
2488		of the transaction parameters, generate a transaction
2489		parameter buffer, and return it and its length in
2490		TPB and TPBLength, respectively. }
2491	<	function GenerateTPB(sl: TStrings): ITPB;
2491	>	function TIBTransaction.GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
2492		var
2493		i, j, TPBVal: Integer;
2494		ParamName, ParamValue: string;

Diff Legend

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