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 (8 years, 6 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

# 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 Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
52 StdCtrls, ExtCtrls, IBDataBase, IB, IBXConst, LResources;
53
54 type
55
56 { TIBDatabaseEditForm }
57
58 TIBDatabaseEditForm = class(TForm)
59 UseSystemDefaultCS: TCheckBox;
60 GroupBox2: TGroupBox;
61 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 procedure UseSystemDefaultCSChange(Sender: TObject);
98 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 if Database.UseDefaultSystemCodePage then
249 UseSystemDefaultCS.Checked := true
250 else
251 UseSystemDefaultCS.Checked := false;
252 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 Database.UseDefaultSystemCodePage := UseSystemDefaultCS.Checked;
267 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 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
388
389 end.