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 33 by tony, Sat Jul 18 12:30:52 2015 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC

#	Line 35 | Line 35 | unit IBDatabase;
35
36		{$Mode Delphi}
37
38	+	{$IF FPC_FULLVERSION >= 20700 }
39	+	{$codepage UTF8}
40	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
41	+	{$ENDIF}
42	+
43		interface
44
45		uses
#	Line 182 | Line 187 | type
187		FUserNames: TStringList;
188		FDataSets: TList;
189		FLoginCalled: boolean;
190	<	FCharSetSizes: array of integer;
190	>	FDefaultCharSetName: RawByteString;
191	>	FDefaultCharSetID: integer;
192	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
193	>	FDefaultCodePage: TSystemCodePage;
194	>	{$ENDIF}
195	>	FUseDefaultSystemCodePage: boolean;
196		procedure EnsureInactive;
197		function GetDBSQLDialect: Integer;
198		function GetSQLDialect: Integer;
#	Line 196 | Line 206 | type
206		function GetIdleTimer: Integer;
207		function GetTransaction(Index: Integer): TIBTransaction;
208		function GetTransactionCount: Integer;
209	<	function Login: Boolean;
200	<	procedure LoadCharSetInfo;
209	>	function Login(var aDatabaseName: string): Boolean;
210		procedure SetDatabaseName(const Value: TIBFileName);
211		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
212		procedure SetDBParams(Value: TStrings);
#	Line 254 | 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	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
269	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
270	+	{$ENDIF}
271
272		published
273		property Connected;
#	Line 269 | Line 283 | type
283		property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
284		property DBSQLDialect : Integer read FDBSQLDialect;
285		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
286	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
287	+	write FUseDefaultSystemCodePage;
288		property AfterConnect;
289		property AfterDisconnect;
290		property BeforeConnect;
#	Line 442 | Line 458 | type
458		procedure DoAfterDelete(Sender: TObject); virtual;
459		procedure DoAfterInsert(Sender: TObject); virtual;
460		procedure DoAfterPost(Sender: TObject); virtual;
461	<	function GetCharSetSize(CharSetID: integer): integer;
461	>	function GetDefaultCharSetName: RawByteString;
462	>	function GetDefaultCharSetID: cardinal;
463		procedure HandleException(Sender: TObject);
464		procedure SetCursor;
465		procedure RestoreCursor;
#	Line 475 | Line 492 | procedure GenerateTPB(sl: TStrings; var
492		implementation
493
494		uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
495	<	typInfo;
495	>	typInfo, IBCodePage;
496
497		{ TIBDatabase }
498
499	<	constructor TIBDataBase.Create(AOwner: TComponent);
483	<	{$ifdef WINDOWS}
484	<	var acp: uint;
485	<	{$endif}
499	>	constructor TIBDataBase.Create(AOwner: TComponent);
500		begin
501		inherited Create(AOwner);
502		FIBLoaded := False;
#	Line 498 | Line 512 | begin
512		(AOwner is TCustomApplication) and
513		TCustomApplication(AOWner).ConsoleApplication then
514		LoginPrompt := false;
515	<	{$ifdef UNIX}
516	<	if csDesigning in ComponentState then
517	<	FDBParams.Add('lc_ctype=UTF8');
504	<	{$else}
505	<	{$ifdef WINDOWS}
506	<	if csDesigning in ComponentState then
507	<	begin
508	<	acp := GetACP;
509	<	if (acp >= 1250) and (acp <= 1254) then
510	<	FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
511	<	end;
512	<	{$endif}
513	<	{$endif}
515	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
516	>	FDefaultCodePage := CP_NONE;
517	>	{$ENDIF}
518		FDBParamsChanged := True;
519		TStringList(FDBParams).OnChange := DBParamsChange;
520		TStringList(FDBParams).OnChanging := DBParamsChanging;
#	Line 590 | Line 594 | end;
594
595		procedure TIBDataBase.CheckDatabaseName;
596		begin
597	<	if (FDBName = '') then
597	>	if (Trim(FDBName) = '') then
598		IBError(ibxeDatabaseNameMissing, [nil]);
599		end;
600
#	Line 629 | Line 633 | begin
633		if Connected then
634		InternalClose(False);
635		FDBSQLDialect := 1;
636	<	SetLength(FCharSetSizes,0);
636	>	FDefaultCharSetName := '';
637	>	FDefaultCharSetID := 0;
638	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
639	>	FDefaultCodePage := CP_NONE;
640	>	{$ENDIF}
641		end;
642
643		procedure TIBDataBase.CreateDatabase;
#	Line 824 | Line 832 | begin
832		SQLObjects[i].DoAfterDatabaseDisconnect;
833		end;
834
827	–	procedure TIBDataBase.LoadCharSetInfo;
828	–	var Query: TIBSQL;
829	–	i: integer;
830	–	begin
831	–	if not FInternalTransaction.Active then
832	–	FInternalTransaction.StartTransaction;
833	–	Query := TIBSQL.Create(self);
834	–	try
835	–	Query.Database := Self;
836	–	Query.Transaction := FInternalTransaction;
837	–	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
838	–	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
839	–	Query.Prepare;
840	–	Query.ExecQuery;
841	–	if not Query.EOF then
842	–	begin
843	–	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
844	–	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
845	–	repeat
846	–	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
847	–	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
848	–	Query.Next;
849	–	until Query.EOF;
850	–	end;
851	–	finally
852	–	Query.free;
853	–	FInternalTransaction.Commit;
854	–	end;
855	–	end;
856	–
835		procedure TIBDataBase.CheckStreamConnect;
836		var
837		i: integer;
#	Line 917 | Line 895 | begin
895		end;
896		end;
897
898	<	function TIBDataBase.Login: Boolean;
898	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
899		var
900		IndexOfUser, IndexOfPassword: Integer;
901		Username, Password, OldPassword: String;
#	Line 953 | Line 931 | begin
931		LoginParams.Assign(Params);
932		FOnLogin(Self, LoginParams);
933		Params.Assign (LoginParams);
934	+	aDatabaseName := FDBName;
935		HidePassword;
936		finally
937		LoginParams.Free;
#	Line 974 | Line 953 | begin
953		Length(Params[IndexOfPassword]));
954		OldPassword := password;
955		end;
956	<	result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
956	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
957		if result then
958		begin
959		if IndexOfUser = -1 then
#	Line 1006 | Line 985 | var
985		TempDBParams: TStrings;
986		I: integer;
987		aDBName: string;
988	+
989	+	{Call error analysis}
990	+	sqlcode: Long;
991	+	IBErrorCode: Long;
992	+	status_vector: PISC_STATUS;
993	+	CharSetID: integer;
994		begin
995		CheckInactive;
996		CheckDatabaseName;
#	Line 1015 | Line 1000 | begin
1000		FDBParamsChanged := True;
1001		end;
1002		{ Use builtin login prompt if requested }
1003	<	if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1003	>	aDBName := FDBName;
1004	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
1005		IBError(ibxeOperationCancelled, [nil]);
1006
1007		TempDBParams := TStringList.Create;
1008		try
1009		TempDBParams.Assign(FDBParams);
1010	<	aDBName := FDBName;
1011	<	{Opportuning to override defaults}
1010	>	if UseDefaultSystemCodePage then
1011	>	begin
1012	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1013	>	{$ifdef WINDOWS}
1014	>	if TFirebirdCharacterSets.CodePage2CharSetID(GetACP,CharSetID) then
1015	>	TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1016	>	else
1017	>	{$else}
1018	>	if TFirebirdCharacterSets.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1019	>	TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1020	>	else
1021	>	{$endif}
1022	>	{$ENDIF}
1023	>	TempDBParams.Values['lc_ctype'] :='UTF8';
1024	>	end;
1025	>	{Opportunity to override defaults}
1026		for i := 0 to FSQLObjects.Count - 1 do
1027		begin
1028		if FSQLObjects[i] <> nil then
1029		SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1030		end;
1031	<
1031	>	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1032	>	if FDefaultCharSetName <> '' then
1033	>	TFirebirdCharacterSets.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1034	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1035	>	TFirebirdCharacterSets.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1036	>	{$ENDIF}
1037		{ Generate a new DPB if necessary }
1038		if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1039		begin
#	Line 1046 | Line 1051 | begin
1051		finally
1052		TempDBParams.Free;
1053		end;
1054	<	if Call(isc_attach_database(StatusVector, Length(aDBName),
1054	>	repeat
1055	>	if Call(isc_attach_database(StatusVector, Length(aDBName),
1056		PChar(aDBName), @FHandle,
1057		FDPBLength, FDPB), False) > 0 then
1058	<	begin
1059	<	FHandle := nil;
1060	<	IBDataBaseError;
1061	<	end;
1058	>	begin
1059	>	{$IFDEF UNIX}
1060	>	if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1061	>	begin
1062	>	status_vector := StatusVector;
1063	>	IBErrorCode := StatusVectorArray[1];
1064	>	sqlcode := isc_sqlcode(StatusVector);
1065	>
1066	>	if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1067	>	or
1068	>	((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1069	>	then
1070	>	begin
1071	>	aDBName := 'localhost:' + aDBName;
1072	>	Continue;
1073	>	end;
1074	>	end;
1075	>	{$ENDIF}
1076	>	FHandle := nil;
1077	>	IBDataBaseError;
1078	>	end;
1079	>	until FHandle <> nil;
1080		if not (csDesigning in ComponentState) then
1081		FDBName := aDBName; {Synchronise at run time}
1082		FDBSQLDialect := GetDBSQLDialect;
#	Line 1064 | Line 1088 | begin
1088		end;
1089		if not (csDesigning in ComponentState) then
1090		MonitorHook.DBConnect(Self);
1067	–	LoadCharSetInfo;
1091		end;
1092
1093		procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
#	Line 2015 | Line 2038 | begin
2038		inherited Destroy;
2039		end;
2040
2041	<	function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2041	>	function TIBBase.GetDefaultCharSetName: RawByteString;
2042		begin
2043	<	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2044	<	Result := Database.FCharSetSizes[CharSetID]
2045	<	else
2046	<	Result := 1; {Unknown character set}
2043	>	Result := Database.FDefaultCharSetName;
2044	>	end;
2045	>
2046	>	function TIBBase.GetDefaultCharSetID: cardinal;
2047	>	begin
2048	>	Result := Database.DefaultCharSetID;
2049		end;
2050
2051		procedure TIBBase.HandleException(Sender: TObject);

Diff Legend

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