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 (24 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	10453 byte(s)
Log Message:	Borland IBX Open Source Release
#	User	Rev	Content
1	tony	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.