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, 7 months ago) by tony
Content type:	text/x-pascal
File size:	10334 byte(s)
Log Message:	Fixes merged
#	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	{$MODE Delphi}
32
33	{$A+} (* Aligned records: On *)
34	{$B-} (* Short circuit boolean expressions: Off *)
35	{ $G+} (* Imported data: On *)
36	{$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	{ $U+} (* Pentim-safe FDIVs: On *)
44	{$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	SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
52	StdCtrls, ExtCtrls, IBDatabase, IB, LResources;
53
54	type
55
56	{ TIBDatabaseEditForm }
57
58	TIBDatabaseEditForm = class(TForm)
59	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	UseSystemDefaultCS: TCheckBox;
70	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	procedure DatabaseParamsEditingDone(Sender: TObject);
88	procedure OKBtnClick(Sender: TObject);
89	procedure FormCreate(Sender: TObject);
90	procedure HelpBtnClick(Sender: TObject);
91	procedure PasswordEditingDone(Sender: TObject);
92	procedure ProtocolCloseUp(Sender: TObject);
93	procedure ConnectionTypeBtnSelectionChanged(Sender: TObject);
94	procedure SQLRoleEditingDone(Sender: TObject);
95	procedure CharacterSetChange(Sender: TObject);
96	procedure TestClick(Sender: TObject);
97	procedure UserNameEditingDone(Sender: TObject);
98	procedure UseSystemDefaultCSChange(Sender: TObject);
99	private
100	{ Private declarations }
101	Database: TIBDatabase;
102	function Edit: Boolean;
103	procedure AddParam(aName, aValue: string);
104	procedure DeleteParam(aName: string);
105	procedure UpdateParamEditBoxes;
106	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	uses TypInfo, FBMessages, IBUtils;
120
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	procedure TIBDatabaseEditForm.AddParam(aName, aValue: string);
133	begin
134	if Trim(aValue) = '' then
135	DeleteParam(aName)
136	else
137	DatabaseParams.Lines.Values[aName] := Trim(aValue);
138	end;
139
140	procedure TIBDatabaseEditForm.DeleteParam(aName: string);
141	var
142	i: Integer;
143	begin
144	for i := 0 to DatabaseParams.Lines.Count - 1 do
145	begin
146	if (Pos(aName, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
147	begin
148	DatabaseParams.Lines.Delete(i);
149	break;
150	end;
151	end;
152	end;
153
154	procedure TIBDatabaseEditForm.UpdateParamEditBoxes;
155	var st: string;
156	begin
157	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	end;
166
167	function TIBDatabaseEditForm.Edit: Boolean;
168	var
169	aServerName: string;
170	aDatabaseName: string;
171	aProtocol: TProtocolAll;
172	aPortNo: string;
173
174	begin
175	if ParseConnectString(Database.DatabaseName, aServerName, aDatabaseName, aProtocol, aPortNo) then
176	begin
177	ServerName.Text := aServerName;
178	DatabasePath.Text := aDatabaseName;
179	Protocol.ItemIndex := ord(aProtocol);
180	PortNo.Text := aPortNo;
181	end;
182	ProtocolCloseUp(nil);
183	ConnectionTypeBtnSelectionChanged(nil);
184	if Trim(Database.Params.Text) = '' then
185	DatabaseParams.Clear
186	else
187	DatabaseParams.Lines.Assign(Database.Params);
188	LoginPrompt.Checked := Database.LoginPrompt;
189	UpdateParamEditBoxes;
190	UseSystemDefaultCS.Checked := Database.UseDefaultSystemCodePage;
191	Result := False;
192	if ShowModal = mrOk then
193	begin
194	Database.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
195	TProtocolAll(Protocol.ItemIndex), PortNo.Text);
196	Database.Params := DatabaseParams.Lines;
197	Database.LoginPrompt := LoginPrompt.Checked;
198	Database.UseDefaultSystemCodePage := UseSystemDefaultCS.Checked;
199	Result := True;
200	end;
201	end;
202
203	procedure TIBDatabaseEditForm.BrowseClick(Sender: TObject);
204	begin
205	with TOpenDialog.Create(Application) do
206	try
207	InitialDir := ExtractFilePath(DatabasePath.Text);
208	Filter := SDatabaseFilter;
209	if Execute then
210	DatabasePath.Text := FileName;
211	finally
212	Free
213	end;
214	end;
215
216	procedure TIBDatabaseEditForm.DatabaseParamsEditingDone(Sender: TObject);
217	begin
218	UpdateParamEditBoxes;
219	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	procedure TIBDatabaseEditForm.PasswordEditingDone(Sender: TObject);
244	begin
245	AddParam('password', Password.Text);
246	end;
247
248	procedure TIBDatabaseEditForm.ProtocolCloseUp(Sender: TObject);
249	begin
250	if Protocol.ItemIndex = 3 then
251	ConnectionTypeBtn.ItemIndex := 0
252	else
253	ConnectionTypeBtn.ItemIndex := 1;
254	end;
255
256	procedure TIBDatabaseEditForm.ConnectionTypeBtnSelectionChanged(Sender: TObject);
257	begin
258	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	AddParam('sql_role_name', SQLRole.Text);
283	end;
284
285	procedure TIBDatabaseEditForm.CharacterSetChange(Sender: TObject);
286	begin
287	if (CharacterSet.ItemIndex <> -1 ) then {do not localize}
288	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	tempDB.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
301	TProtocolAll(Protocol.ItemIndex), PortNo.Text);
302	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	procedure TIBDatabaseEditForm.UserNameEditingDone(Sender: TObject);
317	begin
318	AddParam('user_name', UserName.Text);
319	end;
320
321	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
331
332	end.