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 35 by tony, Tue Jan 26 14:38:47 2016 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 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 183 | Line 188 | type
188		FDataSets: TList;
189		FLoginCalled: boolean;
190		FCharSetSizes: array of integer;
191	<	FCharSetNames: array of string;
191	>	FCharSetNames: array of RawByteString;
192	>	FDefaultCharSetName: RawByteString;
193	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
194	>	FCodePages: array of TSystemCodePage;
195	>	FDefaultCodePage: TSystemCodePage;
196	>	{$ENDIF}
197	>	FUseDefaultSystemCodePage: boolean;
198		procedure EnsureInactive;
199		function GetDBSQLDialect: Integer;
200		function GetSQLDialect: Integer;
#	Line 197 | Line 208 | type
208		function GetIdleTimer: Integer;
209		function GetTransaction(Index: Integer): TIBTransaction;
210		function GetTransactionCount: Integer;
211	<	function Login: Boolean;
211	>	function Login(var aDatabaseName: string): Boolean;
212		procedure LoadCharSetInfo;
213		procedure SetDatabaseName(const Value: TIBFileName);
214		procedure SetDBParamByDPB(const Idx: Integer; Value: String);
#	Line 255 | Line 266 | type
266		property TransactionCount: Integer read GetTransactionCount;
267		property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
268		property InternalTransaction: TIBTransaction read FInternalTransaction;
269	+	property DefaultCharSetName: RawByteString read FDefaultCharSetName;
270	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
271	+	property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
272	+	{$ENDIF}
273
274		published
275		property Connected;
#	Line 270 | Line 285 | type
285		property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
286		property DBSQLDialect : Integer read FDBSQLDialect;
287		property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
288	+	property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
289	+	write FUseDefaultSystemCodePage;
290		property AfterConnect;
291		property AfterDisconnect;
292		property BeforeConnect;
#	Line 446 | Line 463 | type
463		function GetCharSetSize(CharSetID: integer): integer;
464		function GetDefaultCharSetSize: integer;
465		function GetCharSetName(CharSetID: integer): string;
466	<	function GetDefaultCharSetName: string;
466	>	function GetDefaultCharSetName: RawByteString;
467	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
468	>	function GetCodePage(CharSetID: integer): TSystemCodePage;
469	>	function GetDefaultCodePage: TSystemCodePage;
470	>	{$ENDIF}
471		procedure HandleException(Sender: TObject);
472		procedure SetCursor;
473		procedure RestoreCursor;
#	Line 479 | Line 500 | procedure GenerateTPB(sl: TStrings; var
500		implementation
501
502		uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
503	<	typInfo;
503	>	typInfo, IBCodePage;
504
505		{ TIBDatabase }
506
507	<	constructor TIBDataBase.Create(AOwner: TComponent);
487	<	{$ifdef WINDOWS}
488	<	var acp: uint;
489	<	{$endif}
507	>	constructor TIBDataBase.Create(AOwner: TComponent);
508		begin
509		inherited Create(AOwner);
510		FIBLoaded := False;
#	Line 502 | Line 520 | begin
520		(AOwner is TCustomApplication) and
521		TCustomApplication(AOWner).ConsoleApplication then
522		LoginPrompt := false;
523	<	{$ifdef UNIX}
524	<	if csDesigning in ComponentState then
525	<	FDBParams.Add('lc_ctype=UTF8');
508	<	{$else}
509	<	{$ifdef WINDOWS}
510	<	if csDesigning in ComponentState then
511	<	begin
512	<	acp := GetACP;
513	<	if (acp >= 1250) and (acp <= 1254) then
514	<	FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
515	<	end;
516	<	{$endif}
517	<	{$endif}
523	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
524	>	FDefaultCodePage := CP_NONE;
525	>	{$ENDIF}
526		FDBParamsChanged := True;
527		TStringList(FDBParams).OnChange := DBParamsChange;
528		TStringList(FDBParams).OnChanging := DBParamsChanging;
#	Line 594 | Line 602 | end;
602
603		procedure TIBDataBase.CheckDatabaseName;
604		begin
605	<	if (FDBName = '') then
605	>	if (Trim(FDBName) = '') then
606		IBError(ibxeDatabaseNameMissing, [nil]);
607		end;
608
#	Line 635 | Line 643 | begin
643		FDBSQLDialect := 1;
644		SetLength(FCharSetSizes,0);
645		SetLength(FCharSetNames,0);
646	+	FDefaultCharSetName := '';
647	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
648	+	SetLength(FCodePages,0);
649	+	FDefaultCodePage := CP_NONE;
650	+	{$ENDIF}
651		end;
652
653		procedure TIBDataBase.CreateDatabase;
#	Line 847 | Line 860 | begin
860		begin
861		SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
862		SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
863	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
864	+	SetLength(FCodePages, Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
865	+	{$ENDIF}
866		for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
867		repeat
868		FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
869		Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
870		FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
871	<	Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
871	>	Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
872	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
873	>	FCodePages[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
874	>	IBGetCodePage(Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString));
875	>	{$ENDIF}
876		Query.Next;
877		until Query.EOF;
878		end;
#	Line 925 | Line 945 | begin
945		end;
946		end;
947
948	<	function TIBDataBase.Login: Boolean;
948	>	function TIBDataBase.Login(var aDatabaseName: string): Boolean;
949		var
950		IndexOfUser, IndexOfPassword: Integer;
951		Username, Password, OldPassword: String;
#	Line 961 | Line 981 | begin
981		LoginParams.Assign(Params);
982		FOnLogin(Self, LoginParams);
983		Params.Assign (LoginParams);
984	+	aDatabaseName := FDBName;
985		HidePassword;
986		finally
987		LoginParams.Free;
#	Line 982 | Line 1003 | begin
1003		Length(Params[IndexOfPassword]));
1004		OldPassword := password;
1005		end;
1006	<	result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
1006	>	result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
1007		if result then
1008		begin
1009		if IndexOfUser = -1 then
#	Line 1014 | Line 1035 | var
1035		TempDBParams: TStrings;
1036		I: integer;
1037		aDBName: string;
1038	+
1039	+	{Call error analysis}
1040	+	sqlcode: Long;
1041	+	IBErrorCode: Long;
1042	+	status_vector: PISC_STATUS;
1043	+	{$ifdef WINDOWS}
1044	+	acp: uint;
1045	+	{$endif}
1046		begin
1047		CheckInactive;
1048		CheckDatabaseName;
#	Line 1023 | Line 1052 | begin
1052		FDBParamsChanged := True;
1053		end;
1054		{ Use builtin login prompt if requested }
1055	<	if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1055	>	aDBName := FDBName;
1056	>	if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
1057		IBError(ibxeOperationCancelled, [nil]);
1058
1059		TempDBParams := TStringList.Create;
1060		try
1061		TempDBParams.Assign(FDBParams);
1062	<	aDBName := FDBName;
1062	>	if UseDefaultSystemCodePage then
1063	>	begin
1064	>	{$ifdef WINDOWS}
1065	>	acp := GetACP;
1066	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1067	>	TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp);
1068	>	FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1069	>	{$ELSE}
1070	>	if (acp >= 1250) and (acp <= 1258) then
1071	>	TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp])
1072	>	else
1073	>	TempDBParams.Values['lc_ctype'] :='UTF8';
1074	>	{$ENDIF}
1075	>	{$else}
1076	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1077	>	TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage);
1078	>	FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1079	>	{$ELSE}
1080	>	TempDBParams.Values['lc_ctype'] :='UTF8';
1081	>	{$ENDIF}
1082	>	{$endif}
1083	>	end;
1084		{Opportunity to override defaults}
1085		for i := 0 to FSQLObjects.Count - 1 do
1086		begin
1087		if FSQLObjects[i] <> nil then
1088		SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1089		end;
1090	+	FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1091
1092		{ Generate a new DPB if necessary }
1093		if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
#	Line 1054 | Line 1106 | begin
1106		finally
1107		TempDBParams.Free;
1108		end;
1109	<	if Call(isc_attach_database(StatusVector, Length(aDBName),
1109	>	repeat
1110	>	if Call(isc_attach_database(StatusVector, Length(aDBName),
1111		PChar(aDBName), @FHandle,
1112		FDPBLength, FDPB), False) > 0 then
1113	<	begin
1114	<	FHandle := nil;
1115	<	IBDataBaseError;
1116	<	end;
1113	>	begin
1114	>	{$IFDEF UNIX}
1115	>	if IsEmbeddedServer and (Pos(':',aDBName) = 0) then
1116	>	begin
1117	>	status_vector := StatusVector;
1118	>	IBErrorCode := StatusVectorArray[1];
1119	>	sqlcode := isc_sqlcode(StatusVector);
1120	>
1121	>	if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp}
1122	>	or
1123	>	((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem}
1124	>	then
1125	>	begin
1126	>	aDBName := 'localhost:' + aDBName;
1127	>	Continue;
1128	>	end;
1129	>	end;
1130	>	{$ENDIF}
1131	>	FHandle := nil;
1132	>	IBDataBaseError;
1133	>	end;
1134	>	until FHandle <> nil;
1135		if not (csDesigning in ComponentState) then
1136		FDBName := aDBName; {Synchronise at run time}
1137		FDBSQLDialect := GetDBSQLDialect;
#	Line 2053 | Line 2124 | begin
2124		Result := ''; {Unknown character set}
2125		end;
2126
2127	<	function TIBBase.GetDefaultCharSetName: string;
2127	>	function TIBBase.GetDefaultCharSetName: RawByteString;
2128		begin
2129	<	Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
2129	>	Result := Database.FDefaultCharSetName;
2130		end;
2131
2132	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2133	+	function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
2134	+	begin
2135	+	if (CharSetID >= 0) and (CharSetID < Length(Database.FCodePages)) then
2136	+	Result := Database.FCodePages[CharSetID]
2137	+	else
2138	+	Result := CP_NONE; {Unknown character set}
2139	+	end;
2140	+
2141	+	function TIBBase.GetDefaultCodePage: TSystemCodePage;
2142	+	begin
2143	+	Result := Database.FDefaultCodePage;
2144	+	end;
2145	+
2146	+	{$ENDIF}
2147	+
2148		procedure TIBBase.HandleException(Sender: TObject);
2149		begin
2150		if assigned(Database) then

Diff Legend

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