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 118 by tony, Mon Jan 22 13:58:14 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	–	FDPB: IDPB;
186		FAllowStreamedConnected: boolean;
187		FHiddenPassword: string;
188		FOnCreateDatabase: TNotifyEvent;
189		FOnLogin: TIBDatabaseLoginEvent;
190		FSQLHourGlass: Boolean;
191		FTraceFlags: TTraceFlags;
181	–	FDBSQLDialect: Integer;
192		FSQLDialect: Integer;
193		FOnDialectDowngradeWarning: TNotifyEvent;
194		FSQLObjects: TList;
#	Line 195 | Line 205 | type
205		FLoginCalled: boolean;
206		FUseDefaultSystemCodePage: boolean;
207		procedure EnsureInactive;
208	+	function GetAuthenticationMethod: string;
209		function GetDBSQLDialect: Integer;
210		function GetDefaultCharSetID: integer;
211		function GetDefaultCharSetName: AnsiString;
212		function GetDefaultCodePage: TSystemCodePage;
213	<	function GetSQLDialect: Integer;
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;
#	Line 266 | Line 277 | type
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;
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;
615		end;
616
617		procedure TIBDataBase.CreateDatabase;
#	Line 610 | Line 625 | end;
625		procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
626		begin
627		CheckInactive;
628	<	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
628	>	FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,SQLDialect);
629		FDBName := Attachment.GetConnectString;
630		if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
631		OnCreateDatabase(self);
#	Line 920 | 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;
#	Line 928 | Line 977 | var
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 937 | 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 958 | 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 1032 | Line 1088 | begin
1088		finally
1089		TempDBParams.Free;
1090		end;
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}
1038	–	FDBSQLDialect := GetDBSQLDialect;
1096		ValidateClientSQLDialect;
1097		for i := 0 to FSQLObjects.Count - 1 do
1098		begin
#	Line 1217 | Line 1274 | begin
1274		DatabaseInfo.Free;
1275		end;
1276
1220	–	function TIBDataBase.GetSQLDialect: Integer;
1221	–	begin
1222	–	Result := FSQLDialect;
1223	–	end;
1224	–
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;
1236	–	var
1237	–	DatabaseInfo: TIBDatabaseInfo;
1288		begin
1289	<	DatabaseInfo := TIBDatabaseInfo.Create(self);
1290	<	DatabaseInfo.Database := self;
1241	<	result := DatabaseInfo.DBSQLDialect;
1242	<	DatabaseInfo.Free;
1289	>	CheckActive;
1290	>	Result := Attachment.GetSQLDialect;
1291		end;
1292
1293		function TIBDataBase.GetDefaultCharSetID: integer;
#	Line 1266 | Line 1314 | begin
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 1358 | Line 1412 | begin
1412		Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1413		'from RDB$RELATION_FIELDS R ' + {do not localize}
1414		'where R.RDB$RELATION_NAME = ' + {do not localize}
1415	<	'''' + ExtractIdentifier(SQLDialect, TableName) +
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;
#	Line 2189 | 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 2208 | 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