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;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, IBDatabase, IB, IBXConst;

type
  TIBDatabaseEditForm = class(TForm)
    Panel1: TPanel;
    DatabaseName: TEdit;
    Label1: TLabel;
    LocalRbtn: TRadioButton;
    RemoteRbtn: TRadioButton;
    Browse: TButton;
    GroupBox1: TGroupBox;
    UserName: TEdit;
    Password: TEdit;
    SQLRole: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    DatabaseParams: TMemo;
    OKBtn: TButton;
    CancelBtn: TButton;
    HelpBtn: TButton;
    Label5: TLabel;
    LoginPrompt: TCheckBox;
    Label6: TLabel;
    CharacterSet: TComboBox;
    ServerName: TEdit;
    Protocol: TComboBox;
    Label7: TLabel;
    Label8: TLabel;
    Test: TButton;
    procedure RemoteRbtnClick(Sender: TObject);
    procedure BrowseClick(Sender: TObject);
    procedure LocalRbtnClick(Sender: TObject);
    procedure OKBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure UserNameChange(Sender: TObject);
    procedure PasswordChange(Sender: TObject);
    procedure SQLRoleChange(Sender: TObject);
    procedure CharacterSetChange(Sender: TObject);
    procedure TestClick(Sender: TObject);
  private
    { Private declarations }
    Database: TIBDatabase;
    function Edit: Boolean;
    function GetParam(Name: string): string;
    procedure AddParam(Name, Value: string);
    procedure DeleteParam(Name: string);
  public
    { Public declarations }
  end;

var
  IBDatabaseEditForm: TIBDatabaseEditForm;

  function EditIBDatabase(ADatabase: TIBDatabase): Boolean;

implementation

{$R *.DFM}

uses LibHelp, TypInfo;

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

function TIBDatabaseEditForm.GetParam(Name: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to DatabaseParams.Lines.Count - 1 do
  begin
    if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
    begin
      Result := DatabaseParams.Lines.Values[DatabaseParams.Lines.Names[i]];
      break;
    end;
  end;
end;

procedure TIBDatabaseEditForm.AddParam(Name, Value: string);
var
  i: Integer;
  found: boolean;
begin
  found := False;
  if Trim(Value) <> '' then
  begin
    for i := 0 to DatabaseParams.Lines.Count - 1 do
    begin
      if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
      begin
        DatabaseParams.Lines.Values[DatabaseParams.Lines.Names[i]] := Value;
        found := True;
        break;
      end;
    end;
    if not found then
      DatabaseParams.Lines.Add(Name + '=' + Value);
  end
  else
    DeleteParam(Name);
end;

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

function TIBDatabaseEditForm.Edit: Boolean;
var
  st: string;

  procedure DecomposeDatabaseName;
  var
    Idx1, Idx2: Integer;
    st: string;
  begin
    if Pos('\\', Database.DatabaseName) <> 0 then {do not localize}
    begin
      LocalRBtn.Checked := False;
      RemoteRbtn.Checked := True;
      Protocol.ItemIndex := 1;
      st := copy(Database.DatabaseName, 3, Length(Database.DatabaseName));
      Idx1 := Pos('\', st); {do not localize}
      if Idx1 = 0 then
        IBError(ibxeUnknownError, [nil])
      else begin
        ServerName.Text := Copy(st, 1, Idx1 - 1);
        DatabaseName.Text:= Copy(st, Idx1 + 1, Length(st));
      end;
    end
    else begin
      Idx1 := Pos(':', Database.DatabaseName ); {do not localize}
      If (Idx1 = 0) or (Idx1 = 2) then
      begin
        DatabaseName.Text := Database.DatabaseName;
      end
      else
      begin
        LocalRBtn.Checked := False;
        RemoteRbtn.Checked := True;
        Idx2 := Pos('@', Database.DatabaseName); {do not localize}
        if Idx2 = 0 then
        begin
          Protocol.ItemIndex := 0;
          ServerName.Text := copy(Database.DatabaseName, 1, Idx1 - 1);
          DatabaseName.Text := copy(Database.DatabaseName, Idx1 + 1,
            Length(Database.DatabaseName));
        end
        else begin
          Protocol.ItemIndex := 2;
          ServerName.Text := copy(Database.DatabaseName, 1, Idx2 - 1);
          DatabaseName.Text := copy(Database.DatabaseName, Idx2 + 1,
            Length(Database.DatabaseName));
        end;
      end;
    end;
  end;
begin
  DecomposeDatabaseName;
  DatabaseParams.Lines := Database.Params;
  LoginPrompt.Checked := Database.LoginPrompt;
  UserName.Text := GetParam('user_name');
  Password.Text := GetParam('password');
  SQLRole.Text := GetParam('sql_role');
  st := GetParam('lc_ctype');
  if (st <> '') then
    CharacterSet.ItemIndex := CharacterSet.Items.IndexOf(st);
  Result := False;
  if ShowModal = mrOk then
  begin
    Database.DatabaseName := DatabaseName.Text;
    if LocalRbtn.Checked then
      DatabaseName.Text := Database.DatabaseName
    else
      case Protocol.ItemIndex of
        0: Database.DatabaseName := Format('%s:%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
        1: Database.DatabaseName := Format('\\%s\%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
        2: Database.DatabaseName := Format('%s@%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
      end;
    Database.Params := DatabaseParams.Lines;
    Database.LoginPrompt := LoginPrompt.Checked;
    Result := True;
  end;
end;

procedure TIBDatabaseEditForm.RemoteRbtnClick(Sender: TObject);
begin
  Browse.Enabled := False;
  Label7.Enabled := True;
  Label8.Enabled := True;
  Protocol.Enabled := True;
  ServerName.Enabled := True;
end;

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

procedure TIBDatabaseEditForm.LocalRbtnClick(Sender: TObject);
begin
  Browse.Enabled := True;
  Label7.Enabled := False;
  Label8.Enabled := False;
  ServerName.Enabled := False;
  Protocol.Enabled := False;
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.UserNameChange(Sender: TObject);
begin
  AddParam('user_name', UserName.Text);
end;

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

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

procedure TIBDatabaseEditForm.CharacterSetChange(Sender: TObject);
begin
  if (CharacterSet.Text <> 'None') 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
    if LocalRbtn.Checked then
      tempDB.DatabaseName := DatabaseName.Text
    else
      case Protocol.ItemIndex of
        0: tempDB.DatabaseName := Format('%s:%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
        1: tempDB.DatabaseName := Format('\\%s\%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
        2: tempDB.DatabaseName := Format('%s@%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
      end;
    tempDB.Params.Assign(DatabaseParams.Lines);
    tempDB.LoginPrompt := LoginPrompt.Checked;
    tempDB.Connected := true;
    ShowMessage('Successful Connection');
  finally
    tempDB.Free;
    Test.Enabled := true;
  end;
end;

end.
Revision:	1
Committed:	Mon Jul 31 16:43:00 2000 UTC (23 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	10453 byte(s)
Log Message:	Borland IBX Open Source Release
#	Content
1	{************************************************************************}
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	interface
32
33	uses
34	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
35	StdCtrls, ExtCtrls, IBDatabase, IB, IBXConst;
36
37	type
38	TIBDatabaseEditForm = class(TForm)
39	Panel1: TPanel;
40	DatabaseName: TEdit;
41	Label1: TLabel;
42	LocalRbtn: TRadioButton;
43	RemoteRbtn: TRadioButton;
44	Browse: TButton;
45	GroupBox1: TGroupBox;
46	UserName: TEdit;
47	Password: TEdit;
48	SQLRole: TEdit;
49	Label2: TLabel;
50	Label3: TLabel;
51	Label4: TLabel;
52	DatabaseParams: TMemo;
53	OKBtn: TButton;
54	CancelBtn: TButton;
55	HelpBtn: TButton;
56	Label5: TLabel;
57	LoginPrompt: TCheckBox;
58	Label6: TLabel;
59	CharacterSet: TComboBox;
60	ServerName: TEdit;
61	Protocol: TComboBox;
62	Label7: TLabel;
63	Label8: TLabel;
64	Test: TButton;
65	procedure RemoteRbtnClick(Sender: TObject);
66	procedure BrowseClick(Sender: TObject);
67	procedure LocalRbtnClick(Sender: TObject);
68	procedure OKBtnClick(Sender: TObject);
69	procedure FormCreate(Sender: TObject);
70	procedure HelpBtnClick(Sender: TObject);
71	procedure UserNameChange(Sender: TObject);
72	procedure PasswordChange(Sender: TObject);
73	procedure SQLRoleChange(Sender: TObject);
74	procedure CharacterSetChange(Sender: TObject);
75	procedure TestClick(Sender: TObject);
76	private
77	{ Private declarations }
78	Database: TIBDatabase;
79	function Edit: Boolean;
80	function GetParam(Name: string): string;
81	procedure AddParam(Name, Value: string);
82	procedure DeleteParam(Name: string);
83	public
84	{ Public declarations }
85	end;
86
87	var
88	IBDatabaseEditForm: TIBDatabaseEditForm;
89
90	function EditIBDatabase(ADatabase: TIBDatabase): Boolean;
91
92	implementation
93
94	{$R *.DFM}
95
96	uses LibHelp, TypInfo;
97
98	function EditIBDatabase(ADatabase: TIBDatabase): Boolean;
99	begin
100	with TIBDatabaseEditForm.Create(Application) do
101	try
102	Database := ADatabase;
103	Result := Edit;
104	finally
105	Free;
106	end;
107	end;
108
109	function TIBDatabaseEditForm.GetParam(Name: string): string;
110	var
111	i: Integer;
112	begin
113	Result := '';
114	for i := 0 to DatabaseParams.Lines.Count - 1 do
115	begin
116	if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
117	begin
118	Result := DatabaseParams.Lines.Values[DatabaseParams.Lines.Names[i]];
119	break;
120	end;
121	end;
122	end;
123
124	procedure TIBDatabaseEditForm.AddParam(Name, Value: string);
125	var
126	i: Integer;
127	found: boolean;
128	begin
129	found := False;
130	if Trim(Value) <> '' then
131	begin
132	for i := 0 to DatabaseParams.Lines.Count - 1 do
133	begin
134	if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
135	begin
136	DatabaseParams.Lines.Values[DatabaseParams.Lines.Names[i]] := Value;
137	found := True;
138	break;
139	end;
140	end;
141	if not found then
142	DatabaseParams.Lines.Add(Name + '=' + Value);
143	end
144	else
145	DeleteParam(Name);
146	end;
147
148	procedure TIBDatabaseEditForm.DeleteParam(Name: string);
149	var
150	i: Integer;
151	begin
152	for i := 0 to DatabaseParams.Lines.Count - 1 do
153	begin
154	if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
155	begin
156	DatabaseParams.Lines.Delete(i);
157	break;
158	end;
159	end;
160	end;
161
162	function TIBDatabaseEditForm.Edit: Boolean;
163	var
164	st: string;
165
166	procedure DecomposeDatabaseName;
167	var
168	Idx1, Idx2: Integer;
169	st: string;
170	begin
171	if Pos('\\', Database.DatabaseName) <> 0 then {do not localize}
172	begin
173	LocalRBtn.Checked := False;
174	RemoteRbtn.Checked := True;
175	Protocol.ItemIndex := 1;
176	st := copy(Database.DatabaseName, 3, Length(Database.DatabaseName));
177	Idx1 := Pos('\', st); {do not localize}
178	if Idx1 = 0 then
179	IBError(ibxeUnknownError, [nil])
180	else begin
181	ServerName.Text := Copy(st, 1, Idx1 - 1);
182	DatabaseName.Text:= Copy(st, Idx1 + 1, Length(st));
183	end;
184	end
185	else begin
186	Idx1 := Pos(':', Database.DatabaseName ); {do not localize}
187	If (Idx1 = 0) or (Idx1 = 2) then
188	begin
189	DatabaseName.Text := Database.DatabaseName;
190	end
191	else
192	begin
193	LocalRBtn.Checked := False;
194	RemoteRbtn.Checked := True;
195	Idx2 := Pos('@', Database.DatabaseName); {do not localize}
196	if Idx2 = 0 then
197	begin
198	Protocol.ItemIndex := 0;
199	ServerName.Text := copy(Database.DatabaseName, 1, Idx1 - 1);
200	DatabaseName.Text := copy(Database.DatabaseName, Idx1 + 1,
201	Length(Database.DatabaseName));
202	end
203	else begin
204	Protocol.ItemIndex := 2;
205	ServerName.Text := copy(Database.DatabaseName, 1, Idx2 - 1);
206	DatabaseName.Text := copy(Database.DatabaseName, Idx2 + 1,
207	Length(Database.DatabaseName));
208	end;
209	end;
210	end;
211	end;
212	begin
213	DecomposeDatabaseName;
214	DatabaseParams.Lines := Database.Params;
215	LoginPrompt.Checked := Database.LoginPrompt;
216	UserName.Text := GetParam('user_name');
217	Password.Text := GetParam('password');
218	SQLRole.Text := GetParam('sql_role');
219	st := GetParam('lc_ctype');
220	if (st <> '') then
221	CharacterSet.ItemIndex := CharacterSet.Items.IndexOf(st);
222	Result := False;
223	if ShowModal = mrOk then
224	begin
225	Database.DatabaseName := DatabaseName.Text;
226	if LocalRbtn.Checked then
227	DatabaseName.Text := Database.DatabaseName
228	else
229	case Protocol.ItemIndex of
230	0: Database.DatabaseName := Format('%s:%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
231	1: Database.DatabaseName := Format('\\%s\%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
232	2: Database.DatabaseName := Format('%s@%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
233	end;
234	Database.Params := DatabaseParams.Lines;
235	Database.LoginPrompt := LoginPrompt.Checked;
236	Result := True;
237	end;
238	end;
239
240	procedure TIBDatabaseEditForm.RemoteRbtnClick(Sender: TObject);
241	begin
242	Browse.Enabled := False;
243	Label7.Enabled := True;
244	Label8.Enabled := True;
245	Protocol.Enabled := True;
246	ServerName.Enabled := True;
247	end;
248
249	procedure TIBDatabaseEditForm.BrowseClick(Sender: TObject);
250	begin
251	with TOpenDialog.Create(Application) do
252	try
253	InitialDir := ExtractFilePath(DatabaseName.Text);
254	Filter := SDatabaseFilter;
255	if Execute then
256	DatabaseName.Text := FileName;
257	finally
258	Free
259	end;
260	end;
261
262	procedure TIBDatabaseEditForm.LocalRbtnClick(Sender: TObject);
263	begin
264	Browse.Enabled := True;
265	Label7.Enabled := False;
266	Label8.Enabled := False;
267	ServerName.Enabled := False;
268	Protocol.Enabled := False;
269	end;
270
271	procedure TIBDatabaseEditForm.OKBtnClick(Sender: TObject);
272	begin
273	ModalResult := mrNone;
274	if Database.Connected then
275	begin
276	if MessageDlg(SDisconnectDatabase, mtConfirmation,
277	mbOkCancel, 0) <> mrOk then Exit;
278	Database.Close;
279	end;
280	ModalResult := mrOk;
281	end;
282
283	procedure TIBDatabaseEditForm.FormCreate(Sender: TObject);
284	begin
285	HelpContext := hcDIBDataBaseEdit;
286	end;
287
288	procedure TIBDatabaseEditForm.HelpBtnClick(Sender: TObject);
289	begin
290	Application.HelpContext(HelpContext);
291	end;
292
293	procedure TIBDatabaseEditForm.UserNameChange(Sender: TObject);
294	begin
295	AddParam('user_name', UserName.Text);
296	end;
297
298	procedure TIBDatabaseEditForm.PasswordChange(Sender: TObject);
299	begin
300	AddParam('password', Password.Text);
301	end;
302
303	procedure TIBDatabaseEditForm.SQLRoleChange(Sender: TObject);
304	begin
305	AddParam('sql_role_name', SQLRole.Text);
306	end;
307
308	procedure TIBDatabaseEditForm.CharacterSetChange(Sender: TObject);
309	begin
310	if (CharacterSet.Text <> 'None') then {do not localize}
311	AddParam('lc_ctype', CharacterSet.Text)
312	else
313	DeleteParam('lc_ctype');
314	end;
315
316	procedure TIBDatabaseEditForm.TestClick(Sender: TObject);
317	var
318	tempDB : TIBDatabase;
319	begin
320	Test.Enabled := false;
321	tempDB := TIBDatabase.Create(nil);
322	try
323	if LocalRbtn.Checked then
324	tempDB.DatabaseName := DatabaseName.Text
325	else
326	case Protocol.ItemIndex of
327	0: tempDB.DatabaseName := Format('%s:%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
328	1: tempDB.DatabaseName := Format('\\%s\%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
329	2: tempDB.DatabaseName := Format('%s@%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
330	end;
331	tempDB.Params.Assign(DatabaseParams.Lines);
332	tempDB.LoginPrompt := LoginPrompt.Checked;
333	tempDB.Connected := true;
334	ShowMessage('Successful Connection');
335	finally
336	tempDB.Free;
337	Test.Enabled := true;
338	end;
339	end;
340
341	end.