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 37 by tony, Mon Feb 15 14:44:25 2016 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;
191	<	FCharSetNames: array of string;
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 197 | Line 206 | type
206		function GetIdleTimer: Integer;
207		function GetTransaction(Index: Integer): TIBTransaction;
208		function GetTransactionCount: Integer;
209	<	function Login: Boolean;
201	<	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 255 | 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 270 | 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 443 | 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;
462	<	function GetDefaultCharSetSize: integer;
448	<	function GetCharSetName(CharSetID: integer): string;
449	<	function GetDefaultCharSetName: string;
461	>	function GetDefaultCharSetName: RawByteString;
462	>	function GetDefaultCharSetID: cardinal;
463		procedure HandleException(Sender: TObject);
464		procedure SetCursor;
465		procedure RestoreCursor;
#	Line 479 | 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);
487	<	{$ifdef WINDOWS}
488	<	var acp: uint;
489	<	{$endif}
499	>	constructor TIBDataBase.Create(AOwner: TComponent);
500		begin
501		inherited Create(AOwner);
502		FIBLoaded := False;
#	Line 502 | 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');
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}
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 633 | Line 633 | begin
633		if Connected then
634		InternalClose(False);
635		FDBSQLDialect := 1;
636	<	SetLength(FCharSetSizes,0);
637	<	SetLength(FCharSetNames,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 829 | Line 832 | begin
832		SQLObjects[i].DoAfterDatabaseDisconnect;
833		end;
834
832	–	procedure TIBDataBase.LoadCharSetInfo;
833	–	var Query: TIBSQL;
834	–	i: integer;
835	–	begin
836	–	if not FInternalTransaction.Active then
837	–	FInternalTransaction.StartTransaction;
838	–	Query := TIBSQL.Create(self);
839	–	try
840	–	Query.Database := Self;
841	–	Query.Transaction := FInternalTransaction;
842	–	Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
843	–	'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
844	–	Query.Prepare;
845	–	Query.ExecQuery;
846	–	if not Query.EOF then
847	–	begin
848	–	SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
849	–	SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
850	–	for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
851	–	repeat
852	–	FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
853	–	Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
854	–	FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
855	–	Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
856	–	Query.Next;
857	–	until Query.EOF;
858	–	end;
859	–	finally
860	–	Query.free;
861	–	FInternalTransaction.Commit;
862	–	end;
863	–	end;
864	–
835		procedure TIBDataBase.CheckStreamConnect;
836		var
837		i: integer;
#	Line 925 | 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 961 | 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 982 | 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 1019 | Line 990 | var
990		sqlcode: Long;
991		IBErrorCode: Long;
992		status_vector: PISC_STATUS;
993	+	CharSetID: integer;
994		begin
995		CheckInactive;
996		CheckDatabaseName;
#	Line 1028 | 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;
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 1096 | Line 1088 | begin
1088		end;
1089		if not (csDesigning in ComponentState) then
1090		MonitorHook.DBConnect(Self);
1099	–	LoadCharSetInfo;
1091		end;
1092
1093		procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
#	Line 2047 | 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
2053	<	Result := Database.FCharSetSizes[CharSetID]
2054	<	else
2055	<	Result := 1; {Unknown character set}
2056	<	end;
2057	<
2058	<	function TIBBase.GetDefaultCharSetSize: integer;
2059	<	var DefaultCharSetName: string;
2060	<	i: integer;
2061	<	begin
2062	<	DefaultCharSetName := GetDefaultCharSetName;
2063	<	Result := 4; {worse case}
2064	<	for i := 0 to Length(Database.FCharSetSizes) - 1 do
2065	<	if Database.FCharSetNames[i] = DefaultCharSetName then
2066	<	begin
2067	<	Result := Database.FCharSetSizes[i];
2068	<	break;
2069	<	end;
2070	<	end;
2071	<
2072	<	function TIBBase.GetCharSetName(CharSetID: integer): string;
2073	<	begin
2074	<	if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2075	<	Result := Database.FCharSetNames[CharSetID]
2076	<	else
2077	<	Result := ''; {Unknown character set}
2043	>	Result := Database.FDefaultCharSetName;
2044		end;
2045
2046	<	function TIBBase.GetDefaultCharSetName: string;
2046	>	function TIBBase.GetDefaultCharSetID: cardinal;
2047		begin
2048	<	Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
2048	>	Result := Database.DefaultCharSetID;
2049		end;
2050
2051		procedure TIBBase.HandleException(Sender: TObject);

Diff Legend

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