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, 4 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

# 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
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.