ViewVC Help

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

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

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

#	Line 476 | Line 476 | function GenerateTPB(sl: TStrings): ITPB
476		implementation
477
478		uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479	<	typInfo, FBMessages, IBErrorCodes;
479	>	typInfo, FBMessages, IBErrorCodes, RegExpr;
480
481		{ TIBDatabase }
482
#	Line 611 | Line 611 | begin
611		end;
612
613		procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614	<	var info: IDBInformation;
615	<	ConnectionType: integer;
616	<	SiteName: string;
614	>	var RegexObj: TRegExpr;
615		begin
616		CheckInactive;
617		FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
618	<	info := FAttachment.GetDBInformation(isc_info_db_id);
619	<	info[0].DecodeIDCluster(ConnectionType,FDBName,SiteName);
618	>	RegexObj := TRegExpr.Create;
619	>	try
620	>	{extact database file spec}
621	>	RegexObj.ModifierG := false; {turn off greedy matches}
622	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
623	>	if RegexObj.Exec(AnsiUpperCase(createDatabaseSQL)) then
624	>	FDBName := system.copy(createDatabaseSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
625	>	finally
626	>	RegexObj.Free;
627	>	end;
628		if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
629		OnCreateDatabase(self);
630		end;
#	Line 950 | Line 956 | begin
956		TempDBParams := TStringList.Create;
957		try
958		TempDBParams.Assign(FDBParams);
959	+	{$ifdef UNIX}
960	+	{See below for WINDOWS UseDefaultSystemCodePage}
961		if UseDefaultSystemCodePage then
962	<	begin
963	<	{$ifdef WINDOWS}
956	<	if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
957	<	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
958	<	{$else}
959	<	if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
960	<	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
961	<	{$endif}
962	<	else
963	<	TempDBParams.Values['lc_ctype'] :='UTF8';
964	<	end;
962	>	TempDBParams.Values['lc_ctype'] :='UTF8';
963	>	{$endif}
964		{Opportunity to override defaults}
965		for i := 0 to FSQLObjects.Count - 1 do
966		begin
#	Line 969 | Line 968 | begin
968		SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
969		end;
970
971	<	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
972	<	if FDefaultCharSetName <> '' then
973	<	FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
974	<	FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
975	<	{ Generate a new DPB if necessary }
976	<	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
977	<	begin
978	<	FDBParamsChanged := False;
979	<	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
980	<	FDPB := GenerateDPB(TempDBParams)
971	>	repeat
972	>	{ Generate a new DPB if necessary }
973	>	if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
974	>	begin
975	>	FDBParamsChanged := False;
976	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
977	>	FDPB := GenerateDPB(TempDBParams)
978	>	else
979	>	begin
980	>	TempDBParams.Values['password'] := FHiddenPassword;
981	>	FDPB := GenerateDPB(TempDBParams);
982	>	end;
983	>	end;
984	>
985	>	if FCreateDatabase then
986	>	begin
987	>	FCreateDatabase := false;
988	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
989	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
990	>	OnCreateDatabase(self);
991	>	end
992		else
993	+	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
994	+
995	+	if FAttachment = nil then
996		begin
997	<	TempDBParams.Add('password=' + FHiddenPassword);
998	<	FDPB := GenerateDPB(TempDBParams);
997	>	Status := FirebirdAPI.GetStatus;
998	>	{$IFDEF UNIX}
999	>	if Pos(':',aDBName) = 0 then
1000	>	begin
1001	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1002	>	or
1003	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1004	>	or
1005	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1006	>	or
1007	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1008	>	then
1009	>	begin
1010	>	aDBName := 'localhost:' + aDBName;
1011	>	Continue;
1012	>	end
1013	>	end;
1014	>	{$ENDIF}
1015	>	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1016	>	and CreateIfNotExists and not (csDesigning in ComponentState) then
1017	>	FCreateDatabase := true
1018	>	else
1019	>	raise EIBInterBaseError.Create(Status);
1020		end;
1021	<	end;
1021	>
1022	>	if UseDefaultSystemCodePage and (FAttachment <> nil) then
1023	>	{Only now can we check the codepage in use by the Attachment.
1024	>	If not that required then re-open with required LCLType.}
1025	>	begin
1026	>	{$ifdef WINDOWS}
1027	>	if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1028	>	{$else}
1029	>	if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1030	>	{$endif}
1031	>	begin
1032	>	FDefaultCharSetName := Attachment.GetCharsetName(CharSetID);
1033	>	if FDefaultCharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1034	>	begin
1035	>	TempDBParams.Values['lc_ctype'] := FDefaultCharSetName;
1036	>	FDBParamsChanged := True;
1037	>	FAttachment := nil;
1038	>	end
1039	>	end
1040	>	end;
1041	>
1042	>	until FAttachment <> nil;
1043	>
1044	>	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1045		finally
1046		TempDBParams.Free;
1047		end;
1048	+	if FDefaultCharSetName <> '' then
1049	+	Attachment.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1050	+	Attachment.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1051
992	–	repeat
993	–	if FCreateDatabase then
994	–	begin
995	–	FCreateDatabase := false;
996	–	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
997	–	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
998	–	OnCreateDatabase(self);
999	–	end
1000	–	else
1001	–	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1002	–	if FAttachment = nil then
1003	–	begin
1004	–	Status := FirebirdAPI.GetStatus;
1005	–	{$IFDEF UNIX}
1006	–	if Pos(':',aDBName) = 0 then
1007	–	begin
1008	–	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1009	–	or
1010	–	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1011	–	or
1012	–	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1013	–	or
1014	–	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1015	–	then
1016	–	begin
1017	–	aDBName := 'localhost:' + aDBName;
1018	–	Continue;
1019	–	end
1020	–	end;
1021	–	{$ENDIF}
1022	–	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1023	–	and CreateIfNotExists and not (csDesigning in ComponentState) then
1024	–	FCreateDatabase := true
1025	–	else
1026	–	raise EIBInterBaseError.Create(Status);
1027	–	end;
1028	–	until FAttachment <> nil;
1052		if not (csDesigning in ComponentState) then
1053		FDBName := aDBName; {Synchronise at run time}
1054		FDBSQLDialect := GetDBSQLDialect;
#	Line 1574 | Line 1597 | begin
1597		case Action of
1598		TARollback, TACommit:
1599		begin
1600	<	DoBeforeTransactionEnd;
1600	>	try
1601	>	DoBeforeTransactionEnd;
1602	>	except on E: EIBInterBaseError do
1603	>	begin
1604	>	if not Force then
1605	>	raise;
1606	>	end;
1607	>	end;
1608	>
1609		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1610	+	try
1611		SQLObjects[i].DoBeforeTransactionEnd(Action);
1612	+	except on E: EIBInterBaseError do
1613	+	begin
1614	+	if not Force then
1615	+	raise;
1616	+	end;
1617	+	end;
1618	+
1619		if InTransaction then
1620		begin
1621		if (Action = TARollback) then
#	Line 1593 | Line 1632 | begin
1632		end;
1633		end;
1634
1635	<	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1636	<	SQLObjects[i].DoAfterTransactionEnd;
1637	<	DoAfterTransactionEnd;
1635	>	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1636	>	try
1637	>	SQLObjects[i].DoAfterTransactionEnd;
1638	>	except on E: EIBInterBaseError do
1639	>	begin
1640	>	if not Force then
1641	>	raise;
1642	>	end;
1643	>	end;
1644	>	try
1645	>	DoAfterTransactionEnd;
1646	>	except on E: EIBInterBaseError do
1647	>	begin
1648	>	if not Force then
1649	>	raise;
1650	>	end;
1651	>	end;
1652		end;
1653		end;
1654		TACommitRetaining:

Diff Legend

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