ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBDatabaseEdit.pas
Revision: 33
Committed: Sat Jul 18 12:30:52 2015 UTC (9 years, 5 months ago) by tony
Content type: text/x-pascal
File size: 11640 byte(s)
Log Message:
Committing updates for Release R1-3-1

File Contents

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