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 80 by tony, Mon Jan 1 11:31:07 2018 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 27 | Line 27
27		{    IBX For Lazarus (Firebird Express)                                  }
28		{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29		{    Portions created by MWA Software are copyright McCallum Whyman      }
30	<	{    Associates Ltd 2011                                                 }
30	>	{    Associates Ltd 2011 - 2018                                               }
31		{                                                                        }
32		{************************************************************************}
33
#	Line 127 | Line 127 | const
127		'trusted_role',
128		'org_filename',
129		'utf8_ilename',
130	<	'ext_call_depth'
131	<	);
130	>	'ext_call_depth',
131	>	'auth_block',
132	>	'client_version',
133	>	'remote_protocol',
134	>	'host_name',
135	>	'os_user',
136	>	'specific_auth_data',
137	>	'auth_plugin_list',
138	>	'auth_plugin_name',
139	>	'config',
140	>	'nolinger',
141	>	'reset_icu',
142	>	'map_attach'
143	>	);
144
145		TPBPrefix = 'isc_tpb_';
146		TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
#	Line 171 | Line 183 | type
183		FAttachment: IAttachment;
184		FCreateDatabase: boolean;
185		FCreateIfNotExists: boolean;
174	–	FDefaultCharSetID: integer;
175	–	FDefaultCharSetName: RawByteString;
176	–	FDefaultCodePage: TSystemCodePage;
177	–	FDPB: IDPB;
186		FAllowStreamedConnected: boolean;
187		FHiddenPassword: string;
188		FOnCreateDatabase: TNotifyEvent;
189		FOnLogin: TIBDatabaseLoginEvent;
190		FSQLHourGlass: Boolean;
191		FTraceFlags: TTraceFlags;
184	–	FDBSQLDialect: Integer;
192		FSQLDialect: Integer;
193		FOnDialectDowngradeWarning: TNotifyEvent;
194		FSQLObjects: TList;
#	Line 198 | Line 205 | type
205		FLoginCalled: boolean;
206		FUseDefaultSystemCodePage: boolean;
207		procedure EnsureInactive;
208	+	function GetAuthenticationMethod: string;
209		function GetDBSQLDialect: Integer;
210	<	function GetSQLDialect: Integer;
210	>	function GetDefaultCharSetID: integer;
211	>	function GetDefaultCharSetName: AnsiString;
212	>	function GetDefaultCodePage: TSystemCodePage;
213	>	function GetRemoteProtocol: string;
214		procedure SetSQLDialect(const Value: Integer);
215		procedure ValidateClientSQLDialect;
216		procedure DBParamsChange(Sender: TObject);
#	Line 256 | Line 267 | type
267		procedure RemoveTransactions;
268
269		property Attachment: IAttachment read FAttachment;
270	<	property DBSQLDialect : Integer read FDBSQLDialect;
270	>	property DBSQLDialect : Integer read GetDBSQLDialect;
271		property IsReadOnly: Boolean read GetIsReadOnly;
272		property SQLObjectCount: Integer read GetSQLObjectCount;
273		property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
274		property TransactionCount: Integer read GetTransactionCount;
275		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
276		property InternalTransaction: TIBTransaction read FInternalTransaction;
277	<	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
278	<	property DefaultCharSetID: integer read FDefaultCharSetID;
279	<	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
277	>	property DefaultCharSetName: AnsiString read GetDefaultCharSetName;
278	>	property DefaultCharSetID: integer read GetDefaultCharSetID;
279	>	property DefaultCodePage: TSystemCodePage read GetDefaultCodePage;
280	>	property AuthenticationMethod: string read GetAuthenticationMethod;
281	>	property RemoteProtocol: string read GetRemoteProtocol;
282
283		published
284		property Connected;
#	Line 278 | Line 291 | type
291		property DefaultTransaction: TIBTransaction read FDefaultTransaction
292		write SetDefaultTransaction;
293		property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
294	<	property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
294	>	property SQLDialect : Integer read FSQLDialect write SetSQLDialect default 3;
295		property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
296		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
297		property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
#	Line 476 | Line 489 | function GenerateTPB(sl: TStrings): ITPB
489		implementation
490
491		uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
492	<	typInfo, FBMessages, IBErrorCodes, RegExpr;
492	>	typInfo, FBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
493
494		{ TIBDatabase }
495
#	Line 496 | Line 509 | begin
509		FDBParamsChanged := True;
510		TStringList(FDBParams).OnChange := DBParamsChange;
511		TStringList(FDBParams).OnChanging := DBParamsChanging;
499	–	FDPB := nil;
512		FUserNames := nil;
513		FInternalTransaction := TIBTransaction.Create(self);
514		FInternalTransaction.DefaultDatabase := Self;
#	Line 504 | Line 516 | begin
516		FTimer.Enabled := False;
517		FTimer.Interval := 0;
518		FTimer.OnTimer := TimeoutConnection;
507	–	FDBSQLDialect := 1;
519		FSQLDialect := 3;
520		FTraceFlags := [];
521		FDataSets := TList.Create;
#	Line 524 | Line 535 | begin
535		RemoveSQLObjects;
536		RemoveTransactions;
537		FInternalTransaction.Free;
527	–	FDPB := nil;
538		FDBParams.Free;
539		FSQLObjects.Free;
540		FUserNames.Free;
#	Line 550 | Line 560 | begin
560		end
561		end;
562
563	+	function TIBDataBase.GetAuthenticationMethod: string;
564	+	begin
565	+	CheckActive;
566	+	Result := Attachment.GetAuthenticationMethod;
567	+	end;
568	+
569		procedure TIBDataBase.CheckInactive;
570		begin
571		if FAttachment <> nil then
#	Line 596 | Line 612 | end;
612		begin
613		if Connected then
614		InternalClose(False);
599	–	FDBSQLDialect := 1;
600	–	FDefaultCharSetName := '';
601	–	FDefaultCharSetID := 0;
602	–	FDefaultCodePage := CP_NONE;
615		end;
616
617		procedure TIBDataBase.CreateDatabase;
#	Line 611 | Line 623 | begin
623		end;
624
625		procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614	–	var RegexObj: TRegExpr;
626		begin
627		CheckInactive;
628	<	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
629	<	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	>	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,SQLDialect);
629	>	FDBName := Attachment.GetConnectString;
630		if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
631		OnCreateDatabase(self);
632		end;
#	Line 660 | Line 662 | begin
662		end;
663		end;
664
665	<	function TIBDataBase.FindDefaultTransaction: TIBTransaction;
665	>	function TIBDataBase.FindDefaultTransaction(): TIBTransaction;
666		var
667		i: Integer;
668		begin
#	Line 933 | Line 935 | begin
935		end;
936		end;
937
938	<	procedure TIBDataBase.DoConnect;
938	>	procedure TIBDataBase.DoConnect;
939	>
940	>	function ExpandDBName(aDBName: string): string;
941	>	const
942	>	TmpPrefix = '$TEMP$';
943	>	DataPrefix = '$DATADIR$';
944	>	var
945	>	LocalDirName: string;
946	>	begin
947	>	if Pos(TmpPrefix,aDBName) = 1 then
948	>	begin
949	>	system.Delete(aDBName,1,Length(TmpPrefix));
950	>	Result := GetTempDir + aDBName
951	>	end
952	>	else
953	>	if Pos(DataPrefix,aDBName) = 1 then
954	>	begin
955	>	system.Delete(aDBName,1,Length(DataPrefix));
956	>	if Sysutils.VendorName <> '' then
957	>	LocalDirName :=  Sysutils.VendorName
958	>	else
959	>	LocalDirName :=  'IBX';
960	>	{$IFDEF UNIX}
961	>	LocalDirName := GetUserDir + '.' + LocalDirName;
962	>	{$ENDIF}
963	>	{$IFDEF WINDOWS}
964	>	LocalDirName := GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA) + LocalDirName;
965	>	{$ENDIF}
966	>	CreateDir(LocalDirName);
967	>	Result := LocalDirName + DirectorySeparator + aDBName;
968	>	end
969	>	else
970	>	Result := aDBName;
971	>	end;
972	>
973		var
974		TempDBParams: TStrings;
975		I: integer;
976		aDBName: string;
977		Status: IStatus;
978		CharSetID: integer;
979	+	CharSetName: AnsiString;
980	+	DPB: IDPB;
981	+	PW: IDPBItem;
982		begin
983	+	DPB := nil;
984		CheckInactive;
985		CheckDatabaseName;
986		if (not LoginPrompt) and (FHiddenPassword <> '') then
#	Line 949 | Line 989 | begin
989		FDBParamsChanged := True;
990		end;
991		{ Use builtin login prompt if requested }
992	<	aDBName := FDBName;
992	>	aDBName := ExpandDBName(FDBName);
993	>
994		if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
995		IBError(ibxeOperationCancelled, [nil]);
996
#	Line 970 | Line 1011 | begin
1011
1012		repeat
1013		{ Generate a new DPB if necessary }
1014	<	if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
1014	>	if (DPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
1015		begin
1016		FDBParamsChanged := False;
1017		if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1018	<	FDPB := GenerateDPB(TempDBParams)
1018	>	DPB := GenerateDPB(TempDBParams)
1019		else
1020		begin
1021		TempDBParams.Values['password'] := FHiddenPassword;
1022	<	FDPB := GenerateDPB(TempDBParams);
1022	>	DPB := GenerateDPB(TempDBParams);
1023		end;
1024		end;
1025
1026		if FCreateDatabase then
1027		begin
1028		FCreateDatabase := false;
1029	<	FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
1029	>	DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect; {create with this SQL Dialect}
1030	>	FAttachment := FirebirdAPI.CreateDatabase(aDBName,DPB, false);
1031	>	if FAttachment = nil then
1032	>	DPB := nil;
1033		if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1034		OnCreateDatabase(self);
1035		end
1036		else
1037	<	FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1037	>	FAttachment := FirebirdAPI.OpenDatabase(aDBName,DPB,false);
1038
1039		if FAttachment = nil then
1040		begin
1041		Status := FirebirdAPI.GetStatus;
1042		{$IFDEF UNIX}
1043	<	if Pos(':',aDBName) = 0 then
1043	>	if GetProtocol(aDBName) = Local then
1044		begin
1045		if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1046		or
#	Line 1029 | Line 1073 | begin
1073		if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1074		{$endif}
1075		begin
1076	<	FDefaultCharSetName := Attachment.GetCharsetName(CharSetID);
1077	<	if FDefaultCharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1076	>	CharSetName := Attachment.GetCharsetName(CharSetID);
1077	>	if CharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1078		begin
1079	<	TempDBParams.Values['lc_ctype'] := FDefaultCharSetName;
1079	>	TempDBParams.Values['lc_ctype'] := CharSetName;
1080		FDBParamsChanged := True;
1081		FAttachment := nil;
1082		end
#	Line 1041 | Line 1085 | begin
1085
1086		until FAttachment <> nil;
1087
1044	–	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1088		finally
1089		TempDBParams.Free;
1090		end;
1091	<	if FDefaultCharSetName <> '' then
1092	<	Attachment.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1050	<	Attachment.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1091	>	PW := Attachment.getDPB.Find(isc_dpb_password);
1092	>	if PW <> nil then PW.AsString := 'xxxxxxxx'; {Hide password}
1093
1094		if not (csDesigning in ComponentState) then
1095		FDBName := aDBName; {Synchronise at run time}
1054	–	FDBSQLDialect := GetDBSQLDialect;
1096		ValidateClientSQLDialect;
1097		for i := 0 to FSQLObjects.Count - 1 do
1098		begin
#	Line 1233 | Line 1274 | begin
1274		DatabaseInfo.Free;
1275		end;
1276
1236	–	function TIBDataBase.GetSQLDialect: Integer;
1237	–	begin
1238	–	Result := FSQLDialect;
1239	–	end;
1240	–
1277
1278		procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1279		begin
1280		if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1281	<	if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1281	>	if (Attachment = nil) or (Value <= DBSQLDialect)  then
1282		FSQLDialect := Value
1283		else
1284		IBError(ibxeSQLDialectInvalid, [nil]);
1285		end;
1286
1287		function TIBDataBase.GetDBSQLDialect: Integer;
1252	–	var
1253	–	DatabaseInfo: TIBDatabaseInfo;
1288		begin
1289	<	DatabaseInfo := TIBDatabaseInfo.Create(self);
1290	<	DatabaseInfo.Database := self;
1291	<	result := DatabaseInfo.DBSQLDialect;
1292	<	DatabaseInfo.Free;
1289	>	CheckActive;
1290	>	Result := Attachment.GetSQLDialect;
1291	>	end;
1292	>
1293	>	function TIBDataBase.GetDefaultCharSetID: integer;
1294	>	begin
1295	>	if (Attachment <> nil) and Attachment.HasDefaultCharSet then
1296	>	Result := Attachment.GetDefaultCharSetID
1297	>	else
1298	>	Result := 0;
1299	>	end;
1300	>
1301	>	function TIBDataBase.GetDefaultCharSetName: AnsiString;
1302	>	begin
1303	>	if Attachment <> nil then
1304	>	Result := Attachment.GetCharsetName(DefaultCharSetID)
1305	>	else
1306	>	Result := '';
1307	>	end;
1308	>
1309	>	function TIBDataBase.GetDefaultCodePage: TSystemCodePage;
1310	>	begin
1311	>	if Attachment <> nil then
1312	>	Attachment.CharSetID2CodePage(DefaultCharSetID,Result)
1313	>	else
1314	>	Result := CP_NONE;
1315	>	end;
1316	>
1317	>	function TIBDataBase.GetRemoteProtocol: string;
1318	>	begin
1319	>	CheckActive;
1320	>	Result := Attachment.GetRemoteProtocol;
1321		end;
1322
1323		procedure TIBDataBase.ValidateClientSQLDialect;
1324		begin
1325	<	if (FDBSQLDialect < FSQLDialect) then
1325	>	if (DBSQLDialect < FSQLDialect) then
1326		begin
1327	<	FSQLDialect := FDBSQLDialect;
1327	>	FSQLDialect := DBSQLDialect;
1328		if Assigned (FOnDialectDowngradeWarning) then
1329		FOnDialectDowngradeWarning(self);
1330		end;
#	Line 1348 | Line 1410 | begin
1410		Query.Database := Self;
1411		Query.Transaction := FInternalTransaction;
1412		Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1413	<	'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1413	>	'from RDB$RELATION_FIELDS R ' + {do not localize}
1414		'where R.RDB$RELATION_NAME = ' + {do not localize}
1415	<	'''' +
1416	<	FormatIdentifierValue(SQLDialect, TableName) +
1355	<	''' ' +
1356	<	'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1415	>	'''' + ExtractIdentifier(DBSQLDialect, TableName) +
1416	>	''' and Exists(Select * From RDB$FIELDS F Where R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME)' ; {do not localize}
1417		Query.Prepare;
1418		Query.ExecQuery;
1419		with List do
#	Line 2183 | Line 2243 | begin
2243		case DPBVal of
2244		isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
2245		isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
2246	<	isc_dpb_lc_messages, isc_dpb_lc_ctype,
2246	>	isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_page_size,
2247		isc_dpb_sql_role_name, isc_dpb_sql_dialect:
2248		begin
2249		if DPBVal = isc_dpb_sql_dialect then
#	Line 2202 | Line 2262 | begin
2262		Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2263
2264		isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2265	<	isc_dpb_quit_log:
2265	>	isc_dpb_map_attach, isc_dpb_quit_log:
2266		Result.Add(DPBVal).SetAsByte(0);
2267		else
2268		begin

Diff Legend

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