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 49 by tony, Thu Feb 2 16:20:12 2017 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC

#	Line 171 | Line 171 | type
171		FAttachment: IAttachment;
172		FCreateDatabase: boolean;
173		FCreateIfNotExists: boolean;
174	–	FDefaultCharSetID: integer;
175	–	FDefaultCharSetName: RawByteString;
176	–	FDefaultCodePage: TSystemCodePage;
174		FDPB: IDPB;
175		FAllowStreamedConnected: boolean;
176		FHiddenPassword: string;
#	Line 199 | Line 196 | type
196		FUseDefaultSystemCodePage: boolean;
197		procedure EnsureInactive;
198		function GetDBSQLDialect: Integer;
199	+	function GetDefaultCharSetID: integer;
200	+	function GetDefaultCharSetName: AnsiString;
201	+	function GetDefaultCodePage: TSystemCodePage;
202		function GetSQLDialect: Integer;
203		procedure SetSQLDialect(const Value: Integer);
204		procedure ValidateClientSQLDialect;
#	Line 263 | Line 263 | type
263		property TransactionCount: Integer read GetTransactionCount;
264		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265		property InternalTransaction: TIBTransaction read FInternalTransaction;
266	<	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267	<	property DefaultCharSetID: integer read FDefaultCharSetID;
268	<	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
266	>	property DefaultCharSetName: AnsiString read GetDefaultCharSetName;
267	>	property DefaultCharSetID: integer read GetDefaultCharSetID;
268	>	property DefaultCodePage: TSystemCodePage read GetDefaultCodePage;
269
270		published
271		property Connected;
#	Line 476 | Line 476 | function GenerateTPB(sl: TStrings): ITPB
476		implementation
477
478		uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479	<	typInfo, FBMessages, IBErrorCodes, RegExpr;
479	>	typInfo, FBMessages, IBErrorCodes;
480
481		{ TIBDatabase }
482
#	Line 597 | Line 597 | begin
597		if Connected then
598		InternalClose(False);
599		FDBSQLDialect := 1;
600	–	FDefaultCharSetName := '';
601	–	FDefaultCharSetID := 0;
602	–	FDefaultCodePage := CP_NONE;
600		end;
601
602		procedure TIBDataBase.CreateDatabase;
#	Line 611 | Line 608 | begin
608		end;
609
610		procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614	–	var RegexObj: TRegExpr;
611		begin
612		CheckInactive;
613		FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
614	<	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;
614	>	FDBName := Attachment.GetConnectString;
615		if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
616		OnCreateDatabase(self);
617		end;
#	Line 660 | Line 647 | begin
647		end;
648		end;
649
650	<	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
650	>	function TIBDataBase.FindDefaultTransaction(): TIBTransaction;
651		var
652		i: Integer;
653		begin
#	Line 940 | Line 927 | var
927		aDBName: string;
928		Status: IStatus;
929		CharSetID: integer;
930	+	CharSetName: AnsiString;
931		begin
932		CheckInactive;
933		CheckDatabaseName;
#	Line 956 | Line 944 | begin
944		TempDBParams := TStringList.Create;
945		try
946		TempDBParams.Assign(FDBParams);
947	+	{$ifdef UNIX}
948	+	{See below for WINDOWS UseDefaultSystemCodePage}
949		if UseDefaultSystemCodePage then
950	<	begin
951	<	{$ifdef WINDOWS}
962	<	if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
963	<	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
964	<	{$else}
965	<	if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
966	<	TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
967	<	{$endif}
968	<	else
969	<	TempDBParams.Values['lc_ctype'] :='UTF8';
970	<	end;
950	>	TempDBParams.Values['lc_ctype'] :='UTF8';
951	>	{$endif}
952		{Opportunity to override defaults}
953		for i := 0 to FSQLObjects.Count - 1 do
954		begin
#	Line 975 | Line 956 | begin
956		SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
957		end;
958
959	<	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
960	<	if FDefaultCharSetName <> '' then
961	<	FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
962	<	FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
963	<	{ Generate a new DPB if necessary }
964	<	if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
965	<	begin
966	<	FDBParamsChanged := False;
967	<	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
968	<	FDPB := GenerateDPB(TempDBParams)
959	>	repeat
960	>	{ Generate a new DPB if necessary }
961	>	if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
962	>	begin
963	>	FDBParamsChanged := False;
964	>	if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
965	>	FDPB := GenerateDPB(TempDBParams)
966	>	else
967	>	begin
968	>	TempDBParams.Values['password'] := FHiddenPassword;
969	>	FDPB := GenerateDPB(TempDBParams);
970	>	end;
971	>	end;
972	>
973	>	if FCreateDatabase then
974	>	begin
975	>	FCreateDatabase := false;
976	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
977	>	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
978	>	OnCreateDatabase(self);
979	>	end
980		else
981	+	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
982	+
983	+	if FAttachment = nil then
984		begin
985	<	TempDBParams.Add('password=' + FHiddenPassword);
986	<	FDPB := GenerateDPB(TempDBParams);
985	>	Status := FirebirdAPI.GetStatus;
986	>	{$IFDEF UNIX}
987	>	if Pos(':',aDBName) = 0 then
988	>	begin
989	>	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
990	>	or
991	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
992	>	or
993	>	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
994	>	or
995	>	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
996	>	then
997	>	begin
998	>	aDBName := 'localhost:' + aDBName;
999	>	Continue;
1000	>	end
1001	>	end;
1002	>	{$ENDIF}
1003	>	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1004	>	and CreateIfNotExists and not (csDesigning in ComponentState) then
1005	>	FCreateDatabase := true
1006	>	else
1007	>	raise EIBInterBaseError.Create(Status);
1008		end;
1009	<	end;
1009	>
1010	>	if UseDefaultSystemCodePage and (FAttachment <> nil) then
1011	>	{Only now can we check the codepage in use by the Attachment.
1012	>	If not that required then re-open with required LCLType.}
1013	>	begin
1014	>	{$ifdef WINDOWS}
1015	>	if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1016	>	{$else}
1017	>	if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1018	>	{$endif}
1019	>	begin
1020	>	CharSetName := Attachment.GetCharsetName(CharSetID);
1021	>	if CharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1022	>	begin
1023	>	TempDBParams.Values['lc_ctype'] := CharSetName;
1024	>	FDBParamsChanged := True;
1025	>	FAttachment := nil;
1026	>	end
1027	>	end
1028	>	end;
1029	>
1030	>	until FAttachment <> nil;
1031	>
1032		finally
1033		TempDBParams.Free;
1034		end;
1035
998	–	repeat
999	–	if FCreateDatabase then
1000	–	begin
1001	–	FCreateDatabase := false;
1002	–	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
1003	–	if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1004	–	OnCreateDatabase(self);
1005	–	end
1006	–	else
1007	–	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1008	–	if FAttachment = nil then
1009	–	begin
1010	–	Status := FirebirdAPI.GetStatus;
1011	–	{$IFDEF UNIX}
1012	–	if Pos(':',aDBName) = 0 then
1013	–	begin
1014	–	if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1015	–	or
1016	–	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1017	–	or
1018	–	((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1019	–	or
1020	–	((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1021	–	then
1022	–	begin
1023	–	aDBName := 'localhost:' + aDBName;
1024	–	Continue;
1025	–	end
1026	–	end;
1027	–	{$ENDIF}
1028	–	if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1029	–	and CreateIfNotExists and not (csDesigning in ComponentState) then
1030	–	FCreateDatabase := true
1031	–	else
1032	–	raise EIBInterBaseError.Create(Status);
1033	–	end;
1034	–	until FAttachment <> nil;
1036		if not (csDesigning in ComponentState) then
1037		FDBName := aDBName; {Synchronise at run time}
1038		FDBSQLDialect := GetDBSQLDialect;
#	Line 1241 | Line 1242 | begin
1242		DatabaseInfo.Free;
1243		end;
1244
1245	+	function TIBDataBase.GetDefaultCharSetID: integer;
1246	+	begin
1247	+	if (Attachment <> nil) and Attachment.HasDefaultCharSet then
1248	+	Result := Attachment.GetDefaultCharSetID
1249	+	else
1250	+	Result := 0;
1251	+	end;
1252	+
1253	+	function TIBDataBase.GetDefaultCharSetName: AnsiString;
1254	+	begin
1255	+	if Attachment <> nil then
1256	+	Result := Attachment.GetCharsetName(DefaultCharSetID)
1257	+	else
1258	+	Result := '';
1259	+	end;
1260	+
1261	+	function TIBDataBase.GetDefaultCodePage: TSystemCodePage;
1262	+	begin
1263	+	if Attachment <> nil then
1264	+	Attachment.CharSetID2CodePage(DefaultCharSetID,Result)
1265	+	else
1266	+	Result := CP_NONE;
1267	+	end;
1268	+
1269		procedure TIBDataBase.ValidateClientSQLDialect;
1270		begin
1271		if (FDBSQLDialect < FSQLDialect) then
#	Line 1331 | Line 1356 | begin
1356		Query.Database := Self;
1357		Query.Transaction := FInternalTransaction;
1358		Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1359	<	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1359	>	'from RDB$RELATION_FIELDS R ' + {do not localize}
1360		'where R.RDB$RELATION_NAME = ' + {do not localize}
1361	<	'''' +
1362	<	FormatIdentifierValue(SQLDialect, TableName) +
1338	<	''' ' +
1339	<	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1361	>	'''' + ExtractIdentifier(SQLDialect, TableName) +
1362	>	''' and Exists(Select * From RDB$FIELDS F Where R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME)' ; {do not localize}
1363		Query.Prepare;
1364		Query.ExecQuery;
1365		with List do
#	Line 1580 | Line 1603 | begin
1603		case Action of
1604		TARollback, TACommit:
1605		begin
1606	<	DoBeforeTransactionEnd;
1606	>	try
1607	>	DoBeforeTransactionEnd;
1608	>	except on E: EIBInterBaseError do
1609	>	begin
1610	>	if not Force then
1611	>	raise;
1612	>	end;
1613	>	end;
1614	>
1615		for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1616	+	try
1617		SQLObjects[i].DoBeforeTransactionEnd(Action);
1618	+	except on E: EIBInterBaseError do
1619	+	begin
1620	+	if not Force then
1621	+	raise;
1622	+	end;
1623	+	end;
1624	+
1625		if InTransaction then
1626		begin
1627		if (Action = TARollback) then
#	Line 1599 | Line 1638 | begin
1638		end;
1639		end;
1640
1641	<	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1642	<	SQLObjects[i].DoAfterTransactionEnd;
1643	<	DoAfterTransactionEnd;
1641	>	for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1642	>	try
1643	>	SQLObjects[i].DoAfterTransactionEnd;
1644	>	except on E: EIBInterBaseError do
1645	>	begin
1646	>	if not Force then
1647	>	raise;
1648	>	end;
1649	>	end;
1650	>	try
1651	>	DoAfterTransactionEnd;
1652	>	except on E: EIBInterBaseError do
1653	>	begin
1654	>	if not Force then
1655	>	raise;
1656	>	end;
1657	>	end;
1658		end;
1659		end;
1660		TACommitRetaining:

Diff Legend

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