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 38 by tony, Mon Feb 15 14:44:25 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 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 1019 | Line 1040 | var
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 1028 | 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 2077 | 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 := Database.FDefaultCharSetName;
2130	>	end;
2131	>
2132	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
2133	>	function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
2134		begin
2135	<	Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
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