ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBDatabaseEdit.pas
Revision: 267
Committed: Fri Dec 28 10:44:23 2018 UTC (5 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 11321 byte(s)
Log Message:
Fixes Merged

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