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