trunk/design/IBDatabaseEdit.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{************************************************************************}

unit IBDatabaseEdit;

{$MODE Delphi}

{$A+}                           (* Aligned records: On *)
{$B-}                           (* Short circuit boolean expressions: Off *)
{ $G+}                           (* Imported data: On *)
{$H+}                           (* Huge Strings: On *)
{$J-}                           (* Modification of Typed Constants: Off *)
{$M+}                           (* Generate run-time type information: On *)
{$O+}                           (* Optimization: On *)
{$Q-}                           (* Overflow checks: Off *)
{$R-}                           (* Range checks: Off *)
{$T+}                           (* Typed address: On *)
{ $U+}                           (* Pentim-safe FDIVs: On *)
{$W-}                           (* Always generate stack frames: Off *)
{$X+}                           (* Extended syntax: On *)
{$Z1}                           (* Minimum Enumeration Size: 1 Byte *)

interface

uses
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,  IBDatabase, IB,  LResources;

type

  { TIBDatabaseEditForm }

  TIBDatabaseEditForm = class(TForm)
    Browse: TButton;
    DatabasePath: TEdit;
    Label1: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    PortNo: TEdit;
    Protocol: TComboBox;
    ConnectionTypeBtn: TRadioGroup;
    ServerName: TEdit;
    UseSystemDefaultCS: TCheckBox;
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    UserName: TEdit;
    Password: TEdit;
    SQLRole: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    DatabaseParams: TMemo;
    OKBtn: TButton;
    CancelBtn: TButton;
    Label5: TLabel;
    LoginPrompt: TCheckBox;
    Label6: TLabel;
    CharacterSet: TComboBox;
    Test: TButton;
    procedure BrowseClick(Sender: TObject);
    procedure DatabaseParamsEditingDone(Sender: TObject);
    procedure OKBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure PasswordEditingDone(Sender: TObject);
    procedure ProtocolCloseUp(Sender: TObject);
    procedure ConnectionTypeBtnSelectionChanged(Sender: TObject);
    procedure SQLRoleEditingDone(Sender: TObject);
    procedure CharacterSetChange(Sender: TObject);
    procedure TestClick(Sender: TObject);
    procedure UserNameEditingDone(Sender: TObject);
    procedure UseSystemDefaultCSChange(Sender: TObject);
  private
    { Private declarations }
    Database: TIBDatabase;
    function Edit: Boolean;
    procedure AddParam(aName, aValue: string);
    procedure DeleteParam(aName: string);
    procedure UpdateParamEditBoxes;
  public
    { Public declarations }
  end;

var
  IBDatabaseEditForm: TIBDatabaseEditForm;

  function EditIBDatabase(ADatabase: TIBDatabase): Boolean;

implementation

{$R *.lfm}

uses TypInfo, FBMessages, IBUtils;

function EditIBDatabase(ADatabase: TIBDatabase): Boolean;
begin
  with TIBDatabaseEditForm.Create(Application) do
  try
    Database := ADatabase;
    Result := Edit;
  finally
    Free;
  end;
end;

procedure TIBDatabaseEditForm.AddParam(aName, aValue: string);
begin
  if Trim(aValue) = '' then
    DeleteParam(aName)
  else
    DatabaseParams.Lines.Values[aName] := Trim(aValue);
end;

procedure TIBDatabaseEditForm.DeleteParam(aName: string);
var
  i: Integer;
begin
    for i := 0 to DatabaseParams.Lines.Count - 1 do
    begin
      if (Pos(aName, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
      begin
        DatabaseParams.Lines.Delete(i);
        break;
      end;
    end;
end;

procedure TIBDatabaseEditForm.UpdateParamEditBoxes;
var st: string;
begin
  UserName.Text := DatabaseParams.Lines.Values['user_name'];
  Password.Text := DatabaseParams.Lines.Values['password'];
  SQLRole.Text := DatabaseParams.Lines.Values['sql_role_name'];
  st := DatabaseParams.Lines.Values['lc_ctype'];
  if (st <> '') then
    CharacterSet.ItemIndex := CharacterSet.Items.IndexOf(st)
  else
    CharacterSet.ItemIndex := -1;
end;

function TIBDatabaseEditForm.Edit: Boolean;
var
  aServerName: string;
  aDatabaseName: string;
  aProtocol: TProtocolAll;
  aPortNo: string;

begin
  if ParseConnectString(Database.DatabaseName, aServerName, aDatabaseName, aProtocol, aPortNo) then
  begin
    ServerName.Text := aServerName;
    DatabasePath.Text := aDatabaseName;
    Protocol.ItemIndex := ord(aProtocol);
    PortNo.Text := aPortNo;
  end;
  ProtocolCloseUp(nil);
  ConnectionTypeBtnSelectionChanged(nil);
  if Trim(Database.Params.Text) = '' then
    DatabaseParams.Clear
  else
    DatabaseParams.Lines.Assign(Database.Params);
  LoginPrompt.Checked := Database.LoginPrompt;
  UpdateParamEditBoxes;
  UseSystemDefaultCS.Checked := Database.UseDefaultSystemCodePage;
  Result := False;
  if ShowModal = mrOk then
  begin
    Database.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
      TProtocolAll(Protocol.ItemIndex), PortNo.Text);
    Database.Params := DatabaseParams.Lines;
    Database.LoginPrompt := LoginPrompt.Checked;
    Database.UseDefaultSystemCodePage := UseSystemDefaultCS.Checked;
    Result := True;
  end;
end;

procedure TIBDatabaseEditForm.BrowseClick(Sender: TObject);
begin
  with TOpenDialog.Create(Application) do
    try
      InitialDir := ExtractFilePath(DatabasePath.Text);
      Filter := SDatabaseFilter;
      if Execute then
        DatabasePath.Text := FileName;
    finally
      Free
    end;
end;

procedure TIBDatabaseEditForm.DatabaseParamsEditingDone(Sender: TObject);
begin
  UpdateParamEditBoxes;
end;

procedure TIBDatabaseEditForm.OKBtnClick(Sender: TObject);
begin
  ModalResult := mrNone;
  if Database.Connected then
  begin
    if MessageDlg(SDisconnectDatabase, mtConfirmation,
      mbOkCancel, 0) <> mrOk then Exit;
    Database.Close;
  end;
  ModalResult := mrOk;
end;

procedure TIBDatabaseEditForm.FormCreate(Sender: TObject);
begin
//  HelpContext := hcDIBDataBaseEdit;
end;

procedure TIBDatabaseEditForm.HelpBtnClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

procedure TIBDatabaseEditForm.PasswordEditingDone(Sender: TObject);
begin
  AddParam('password', Password.Text);
end;

procedure TIBDatabaseEditForm.ProtocolCloseUp(Sender: TObject);
begin
  if Protocol.ItemIndex = 3 then
    ConnectionTypeBtn.ItemIndex := 0
  else
    ConnectionTypeBtn.ItemIndex := 1;
end;

procedure TIBDatabaseEditForm.ConnectionTypeBtnSelectionChanged(Sender: TObject);
begin
  if ConnectionTypeBtn.ItemIndex > 0 then
  begin
    Browse.Enabled := False;
    Label7.Enabled := True;
    Label8.Enabled := True;
    Protocol.Enabled := True;
    ServerName.Enabled := True;
    if Protocol.ItemIndex = 3 then
      Protocol.ItemIndex := 4;
  end
  else
  begin
    Browse.Enabled := True;
    Label7.Enabled := False;
    Label8.Enabled := true;
    ServerName.Text := '';
    ServerName.Enabled := False;
    Protocol.Enabled := true;
    Protocol.ItemIndex := 3;
  end;
end;

procedure TIBDatabaseEditForm.SQLRoleEditingDone(Sender: TObject);
begin
  AddParam('sql_role_name', SQLRole.Text);
end;

procedure TIBDatabaseEditForm.CharacterSetChange(Sender: TObject);
begin
  if (CharacterSet.ItemIndex <> -1 ) then {do not localize}
    AddParam('lc_ctype', CharacterSet.Text)
  else
    DeleteParam('lc_ctype');
end;

procedure TIBDatabaseEditForm.TestClick(Sender: TObject);
var
  tempDB : TIBDatabase;
begin
  Test.Enabled := false;
  tempDB := TIBDatabase.Create(nil);
  try
    tempDB.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
      TProtocolAll(Protocol.ItemIndex), PortNo.Text);
    tempDB.Params.Assign(DatabaseParams.Lines);
    tempDB.LoginPrompt := LoginPrompt.Checked;
    try
      tempDB.Connected := true;
      ShowMessage('Successful Connection');
    except on E: Exception do
      ShowMessage(E.Message)
    end;
  finally
    tempDB.Free;
    Test.Enabled := true;
  end;
end;

procedure TIBDatabaseEditForm.UserNameEditingDone(Sender: TObject);
begin
  AddParam('user_name', UserName.Text);
end;

procedure TIBDatabaseEditForm.UseSystemDefaultCSChange(Sender: TObject);
begin
  CharacterSet.Enabled := not UseSystemDefaultCS.Checked;
  if UseSystemDefaultCS.Checked then
    DeleteParam('lc_ctype')
  else
  if (CharacterSet.Text <> 'None') then {do not localize}
      AddParam('lc_ctype', CharacterSet.Text)
end;


end.
Revision:	231
Committed:	Mon Apr 16 08:32:21 2018 UTC (6 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	10334 byte(s)
Log Message:	Fixes merged
#	User	Rev	Content
1	tony	33	{************************************************************************}
2			{ }
3			{ Borland Delphi Visual Component Library }
4			{ InterBase Express core components }
5			{ }
6			{ Copyright (c) 1998-2000 Inprise Corporation }
7			{ }
8			{ InterBase Express is based in part on the product }
9			{ Free IB Components, written by Gregory H. Deatz for }
10			{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
11			{ Free IB Components is used under license. }
12			{ }
13			{ The contents of this file are subject to the InterBase }
14			{ Public License Version 1.0 (the "License"); you may not }
15			{ use this file except in compliance with the License. You }
16			{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17			{ Software distributed under the License is distributed on }
18			{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19			{ express or implied. See the License for the specific language }
20			{ governing rights and limitations under the License. }
21			{ The Original Code was created by InterBase Software Corporation }
22			{ and its successors. }
23			{ Portions created by Inprise Corporation are Copyright (C) Inprise }
24			{ Corporation. All Rights Reserved. }
25			{ Contributor(s): Jeff Overcash }
26			{ }
27			{************************************************************************}
28
29			unit IBDatabaseEdit;
30
31			{$MODE Delphi}
32
33			{$A+} (* Aligned records: On *)
34			{$B-} (* Short circuit boolean expressions: Off *)
35	tony	45	{ $G+} (* Imported data: On *)
36	tony	33	{$H+} (* Huge Strings: On *)
37			{$J-} (* Modification of Typed Constants: Off *)
38			{$M+} (* Generate run-time type information: On *)
39			{$O+} (* Optimization: On *)
40			{$Q-} (* Overflow checks: Off *)
41			{$R-} (* Range checks: Off *)
42			{$T+} (* Typed address: On *)
43	tony	45	{ $U+} (* Pentim-safe FDIVs: On *)
44	tony	33	{$W-} (* Always generate stack frames: Off *)
45			{$X+} (* Extended syntax: On *)
46			{$Z1} (* Minimum Enumeration Size: 1 Byte *)
47
48			interface
49
50			uses
51	tony	45	SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
52	tony	231	StdCtrls, ExtCtrls, IBDatabase, IB, LResources;
53	tony	33
54			type
55
56			{ TIBDatabaseEditForm }
57
58			TIBDatabaseEditForm = class(TForm)
59	tony	231	Browse: TButton;
60			DatabasePath: TEdit;
61			Label1: TLabel;
62			Label7: TLabel;
63			Label8: TLabel;
64			Label9: TLabel;
65			PortNo: TEdit;
66			Protocol: TComboBox;
67			ConnectionTypeBtn: TRadioGroup;
68			ServerName: TEdit;
69	tony	39	UseSystemDefaultCS: TCheckBox;
70	tony	33	Panel1: TPanel;
71			GroupBox1: TGroupBox;
72			UserName: TEdit;
73			Password: TEdit;
74			SQLRole: TEdit;
75			Label2: TLabel;
76			Label3: TLabel;
77			Label4: TLabel;
78			DatabaseParams: TMemo;
79			OKBtn: TButton;
80			CancelBtn: TButton;
81			Label5: TLabel;
82			LoginPrompt: TCheckBox;
83			Label6: TLabel;
84			CharacterSet: TComboBox;
85			Test: TButton;
86			procedure BrowseClick(Sender: TObject);
87	tony	231	procedure DatabaseParamsEditingDone(Sender: TObject);
88	tony	33	procedure OKBtnClick(Sender: TObject);
89			procedure FormCreate(Sender: TObject);
90			procedure HelpBtnClick(Sender: TObject);
91	tony	231	procedure PasswordEditingDone(Sender: TObject);
92			procedure ProtocolCloseUp(Sender: TObject);
93			procedure ConnectionTypeBtnSelectionChanged(Sender: TObject);
94			procedure SQLRoleEditingDone(Sender: TObject);
95	tony	33	procedure CharacterSetChange(Sender: TObject);
96			procedure TestClick(Sender: TObject);
97	tony	231	procedure UserNameEditingDone(Sender: TObject);
98	tony	39	procedure UseSystemDefaultCSChange(Sender: TObject);
99	tony	33	private
100			{ Private declarations }
101			Database: TIBDatabase;
102			function Edit: Boolean;
103	tony	231	procedure AddParam(aName, aValue: string);
104			procedure DeleteParam(aName: string);
105			procedure UpdateParamEditBoxes;
106	tony	33	public
107			{ Public declarations }
108			end;
109
110			var
111			IBDatabaseEditForm: TIBDatabaseEditForm;
112
113			function EditIBDatabase(ADatabase: TIBDatabase): Boolean;
114
115			implementation
116
117			{$R *.lfm}
118
119	tony	231	uses TypInfo, FBMessages, IBUtils;
120	tony	33
121			function EditIBDatabase(ADatabase: TIBDatabase): Boolean;
122			begin
123			with TIBDatabaseEditForm.Create(Application) do
124			try
125			Database := ADatabase;
126			Result := Edit;
127			finally
128			Free;
129			end;
130			end;
131
132	tony	231	procedure TIBDatabaseEditForm.AddParam(aName, aValue: string);
133	tony	33	begin
134	tony	231	if Trim(aValue) = '' then
135			DeleteParam(aName)
136			else
137			DatabaseParams.Lines.Values[aName] := Trim(aValue);
138	tony	33	end;
139
140	tony	231	procedure TIBDatabaseEditForm.DeleteParam(aName: string);
141	tony	33	var
142			i: Integer;
143			begin
144			for i := 0 to DatabaseParams.Lines.Count - 1 do
145			begin
146	tony	231	if (Pos(aName, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
147	tony	33	begin
148	tony	231	DatabaseParams.Lines.Delete(i);
149	tony	33	break;
150			end;
151			end;
152			end;
153
154	tony	231	procedure TIBDatabaseEditForm.UpdateParamEditBoxes;
155			var st: string;
156	tony	33	begin
157	tony	231	UserName.Text := DatabaseParams.Lines.Values['user_name'];
158			Password.Text := DatabaseParams.Lines.Values['password'];
159			SQLRole.Text := DatabaseParams.Lines.Values['sql_role_name'];
160			st := DatabaseParams.Lines.Values['lc_ctype'];
161			if (st <> '') then
162			CharacterSet.ItemIndex := CharacterSet.Items.IndexOf(st)
163			else
164			CharacterSet.ItemIndex := -1;
165	tony	33	end;
166
167			function TIBDatabaseEditForm.Edit: Boolean;
168			var
169	tony	231	aServerName: string;
170			aDatabaseName: string;
171			aProtocol: TProtocolAll;
172			aPortNo: string;
173	tony	33
174	tony	231	begin
175			if ParseConnectString(Database.DatabaseName, aServerName, aDatabaseName, aProtocol, aPortNo) then
176	tony	33	begin
177	tony	231	ServerName.Text := aServerName;
178			DatabasePath.Text := aDatabaseName;
179			Protocol.ItemIndex := ord(aProtocol);
180			PortNo.Text := aPortNo;
181	tony	33	end;
182	tony	231	ProtocolCloseUp(nil);
183			ConnectionTypeBtnSelectionChanged(nil);
184	tony	33	if Trim(Database.Params.Text) = '' then
185			DatabaseParams.Clear
186			else
187			DatabaseParams.Lines.Assign(Database.Params);
188			LoginPrompt.Checked := Database.LoginPrompt;
189	tony	231	UpdateParamEditBoxes;
190			UseSystemDefaultCS.Checked := Database.UseDefaultSystemCodePage;
191	tony	33	Result := False;
192			if ShowModal = mrOk then
193			begin
194	tony	231	Database.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
195			TProtocolAll(Protocol.ItemIndex), PortNo.Text);
196	tony	33	Database.Params := DatabaseParams.Lines;
197			Database.LoginPrompt := LoginPrompt.Checked;
198	tony	39	Database.UseDefaultSystemCodePage := UseSystemDefaultCS.Checked;
199	tony	33	Result := True;
200			end;
201			end;
202
203			procedure TIBDatabaseEditForm.BrowseClick(Sender: TObject);
204			begin
205			with TOpenDialog.Create(Application) do
206			try
207	tony	231	InitialDir := ExtractFilePath(DatabasePath.Text);
208	tony	33	Filter := SDatabaseFilter;
209			if Execute then
210	tony	231	DatabasePath.Text := FileName;
211	tony	33	finally
212			Free
213			end;
214			end;
215
216	tony	231	procedure TIBDatabaseEditForm.DatabaseParamsEditingDone(Sender: TObject);
217	tony	33	begin
218	tony	231	UpdateParamEditBoxes;
219	tony	33	end;
220
221			procedure TIBDatabaseEditForm.OKBtnClick(Sender: TObject);
222			begin
223			ModalResult := mrNone;
224			if Database.Connected then
225			begin
226			if MessageDlg(SDisconnectDatabase, mtConfirmation,
227			mbOkCancel, 0) <> mrOk then Exit;
228			Database.Close;
229			end;
230			ModalResult := mrOk;
231			end;
232
233			procedure TIBDatabaseEditForm.FormCreate(Sender: TObject);
234			begin
235			// HelpContext := hcDIBDataBaseEdit;
236			end;
237
238			procedure TIBDatabaseEditForm.HelpBtnClick(Sender: TObject);
239			begin
240			Application.HelpContext(HelpContext);
241			end;
242
243	tony	231	procedure TIBDatabaseEditForm.PasswordEditingDone(Sender: TObject);
244	tony	33	begin
245	tony	231	AddParam('password', Password.Text);
246	tony	33	end;
247
248	tony	231	procedure TIBDatabaseEditForm.ProtocolCloseUp(Sender: TObject);
249	tony	33	begin
250	tony	231	if Protocol.ItemIndex = 3 then
251			ConnectionTypeBtn.ItemIndex := 0
252			else
253			ConnectionTypeBtn.ItemIndex := 1;
254	tony	33	end;
255
256	tony	231	procedure TIBDatabaseEditForm.ConnectionTypeBtnSelectionChanged(Sender: TObject);
257	tony	33	begin
258	tony	231	if ConnectionTypeBtn.ItemIndex > 0 then
259			begin
260			Browse.Enabled := False;
261			Label7.Enabled := True;
262			Label8.Enabled := True;
263			Protocol.Enabled := True;
264			ServerName.Enabled := True;
265			if Protocol.ItemIndex = 3 then
266			Protocol.ItemIndex := 4;
267			end
268			else
269			begin
270			Browse.Enabled := True;
271			Label7.Enabled := False;
272			Label8.Enabled := true;
273			ServerName.Text := '';
274			ServerName.Enabled := False;
275			Protocol.Enabled := true;
276			Protocol.ItemIndex := 3;
277			end;
278			end;
279
280			procedure TIBDatabaseEditForm.SQLRoleEditingDone(Sender: TObject);
281			begin
282	tony	33	AddParam('sql_role_name', SQLRole.Text);
283			end;
284
285			procedure TIBDatabaseEditForm.CharacterSetChange(Sender: TObject);
286			begin
287	tony	231	if (CharacterSet.ItemIndex <> -1 ) then {do not localize}
288	tony	33	AddParam('lc_ctype', CharacterSet.Text)
289			else
290			DeleteParam('lc_ctype');
291			end;
292
293			procedure TIBDatabaseEditForm.TestClick(Sender: TObject);
294			var
295			tempDB : TIBDatabase;
296			begin
297			Test.Enabled := false;
298			tempDB := TIBDatabase.Create(nil);
299			try
300	tony	231	tempDB.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
301			TProtocolAll(Protocol.ItemIndex), PortNo.Text);
302	tony	33	tempDB.Params.Assign(DatabaseParams.Lines);
303			tempDB.LoginPrompt := LoginPrompt.Checked;
304			try
305			tempDB.Connected := true;
306			ShowMessage('Successful Connection');
307			except on E: Exception do
308			ShowMessage(E.Message)
309			end;
310			finally
311			tempDB.Free;
312			Test.Enabled := true;
313			end;
314			end;
315
316	tony	231	procedure TIBDatabaseEditForm.UserNameEditingDone(Sender: TObject);
317			begin
318			AddParam('user_name', UserName.Text);
319			end;
320
321	tony	39	procedure TIBDatabaseEditForm.UseSystemDefaultCSChange(Sender: TObject);
322			begin
323			CharacterSet.Enabled := not UseSystemDefaultCS.Checked;
324			if UseSystemDefaultCS.Checked then
325			DeleteParam('lc_ctype')
326			else
327			if (CharacterSet.Text <> 'None') then {do not localize}
328			AddParam('lc_ctype', CharacterSet.Text)
329			end;
330	tony	33
331	tony	39
332	tony	33	end.