ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBDatabaseEdit.pas
(Generate patch)

Comparing ibx/trunk/design/IBDatabaseEdit.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

# Line 28 | Line 28
28  
29   unit IBDatabaseEdit;
30  
31 < {$MODE Delphi}  {$H-}
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 <  {Windows,} Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
52 <  StdCtrls, ExtCtrls, IBDataBase, IB, IBXConst, LResources;
51 >  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
52 >  StdCtrls, ExtCtrls,  IBDatabase, IB,  LResources;
53  
54   type
55  
56    { TIBDatabaseEditForm }
57  
58    TIBDatabaseEditForm = class(TForm)
44    Panel1: TPanel;
45    DatabaseName: TEdit;
46    Label1: TLabel;
47    LocalRbtn: TRadioButton;
48    RemoteRbtn: TRadioButton;
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;
# Line 57 | Line 81 | type
81      DatabaseParams: TMemo;
82      OKBtn: TButton;
83      CancelBtn: TButton;
60    HelpBtn: TButton;
84      Label5: TLabel;
85      LoginPrompt: TCheckBox;
86      Label6: TLabel;
87      CharacterSet: TComboBox;
65    ServerName: TEdit;
66    Protocol: TComboBox;
67    Label7: TLabel;
68    Label8: TLabel;
88      Test: TButton;
70    procedure CharacterSetCloseUp(Sender: TObject);
71    procedure RemoteRbtnClick(Sender: TObject);
89      procedure BrowseClick(Sender: TObject);
90 <    procedure LocalRbtnClick(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 UserNameChange(Sender: TObject);
96 <    procedure PasswordChange(Sender: TObject);
97 <    procedure SQLRoleChange(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 <    function GetParam(Name: string): string;
110 <    procedure AddParam(Name, Value: string);
111 <    procedure DeleteParam(Name: string);
109 >    procedure AddParam(aName, aValue: string);
110 >    procedure DeleteParam(aName: string);
111 >    procedure UpdateParamEditBoxes;
112    public
113      { Public declarations }
114    end;
# Line 97 | Line 120 | var
120  
121   implementation
122  
123 + {$R *.lfm}
124  
125 < uses {LibHelp,} TypInfo;
125 > uses TypInfo, IBMessages, IBUtils;
126  
127   function EditIBDatabase(ADatabase: TIBDatabase): Boolean;
128   begin
# Line 111 | Line 135 | begin
135    end;
136   end;
137  
138 < function TIBDatabaseEditForm.GetParam(Name: string): string;
115 < var
116 <  i: Integer;
138 > procedure TIBDatabaseEditForm.AddParam(aName, aValue: string);
139   begin
140 <  Result := '';
141 <  for i := 0 to DatabaseParams.Lines.Count - 1 do
142 <  begin
143 <    if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
122 <    begin
123 <      Result := DatabaseParams.Lines.Values[DatabaseParams.Lines.Names[i]];
124 <      break;
125 <    end;
126 <  end;
140 >  if Trim(aValue) = '' then
141 >    DeleteParam(aName)
142 >  else
143 >    DatabaseParams.Lines.Values[aName] := Trim(aValue);
144   end;
145  
146 < procedure TIBDatabaseEditForm.AddParam(Name, Value: string);
146 > procedure TIBDatabaseEditForm.DeleteParam(aName: string);
147   var
148    i: Integer;
132  found: boolean;
149   begin
134  found := False;
135  if Trim(Value) <> '' then
136  begin
150      for i := 0 to DatabaseParams.Lines.Count - 1 do
151      begin
152 <      if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
152 >      if (Pos(aName, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
153        begin
154 <        DatabaseParams.Lines.Values[DatabaseParams.Lines.Names[i]] := Value;
142 <        found := True;
154 >        DatabaseParams.Lines.Delete(i);
155          break;
156        end;
157      end;
146    if not found then
147      DatabaseParams.Lines.Add(Name + '=' + Value);
148  end
149  else
150    DeleteParam(Name);
158   end;
159  
160 < procedure TIBDatabaseEditForm.DeleteParam(Name: string);
161 < var
155 <  i: Integer;
160 > procedure TIBDatabaseEditForm.UpdateParamEditBoxes;
161 > var st: string;
162   begin
163 <    for i := 0 to DatabaseParams.Lines.Count - 1 do
164 <    begin
165 <      if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
166 <      begin
167 <        DatabaseParams.Lines.Delete(i);
168 <        break;
169 <      end;
170 <    end;
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 <  st: string;
175 >  aServerName: string;
176 >  aDatabaseName: string;
177 >  aProtocol: TProtocolAll;
178 >  aPortNo: string;
179  
180 <  procedure DecomposeDatabaseName;
181 <  var
173 <    Idx1, Idx2: Integer;
174 <    st: string;
180 > begin
181 >  if ParseConnectString(Database.DatabaseName, aServerName, aDatabaseName, aProtocol, aPortNo) then
182    begin
183 <    if Pos('\\', Database.DatabaseName) <> 0 then {do not localize}
184 <    begin
185 <      LocalRBtn.Checked := False;
186 <      RemoteRbtn.Checked := True;
180 <      Protocol.ItemIndex := 1;
181 <      st := copy(Database.DatabaseName, 3, Length(Database.DatabaseName));
182 <      Idx1 := Pos('\', st); {do not localize}
183 <      if Idx1 = 0 then
184 <        IBError(ibxeUnknownError, [nil])
185 <      else begin
186 <        ServerName.Text := Copy(st, 1, Idx1 - 1);
187 <        DatabaseName.Text:= Copy(st, Idx1 + 1, Length(st));
188 <      end;
189 <    end
190 <    else begin
191 <      Idx1 := Pos(':', Database.DatabaseName ); {do not localize}
192 <      If (Idx1 = 0) or (Idx1 = 2) then
193 <      begin
194 <        DatabaseName.Text := Database.DatabaseName;
195 <      end
196 <      else
197 <      begin
198 <        LocalRBtn.Checked := False;
199 <        RemoteRbtn.Checked := True;
200 <        Idx2 := Pos('@', Database.DatabaseName); {do not localize}
201 <        if Idx2 = 0 then
202 <        begin
203 <          Protocol.ItemIndex := 0;
204 <          ServerName.Text := copy(Database.DatabaseName, 1, Idx1 - 1);
205 <          DatabaseName.Text := copy(Database.DatabaseName, Idx1 + 1,
206 <            Length(Database.DatabaseName));
207 <        end
208 <        else begin
209 <          Protocol.ItemIndex := 2;
210 <          ServerName.Text := copy(Database.DatabaseName, 1, Idx2 - 1);
211 <          DatabaseName.Text := copy(Database.DatabaseName, Idx2 + 1,
212 <            Length(Database.DatabaseName));
213 <        end;
214 <      end;
215 <    end;
183 >    ServerName.Text := aServerName;
184 >    DatabasePath.Text := aDatabaseName;
185 >    Protocol.ItemIndex := ord(aProtocol);
186 >    PortNo.Text := aPortNo;
187    end;
188 < begin
189 <  DecomposeDatabaseName;
190 <  DatabaseParams.Lines := Database.Params;
188 >  ProtocolCloseUp(nil);
189 >  ConnectionTypeBtnSelectionChanged(nil);
190 >  DatabaseParams.Lines.Assign(Database.Params);
191 >  ConfigOverrides.Lines.Assign(Database.ConfigOverrides);
192    LoginPrompt.Checked := Database.LoginPrompt;
193 <  UserName.Text := GetParam('user_name');
194 <  Password.Text := GetParam('password');
195 <  SQLRole.Text := GetParam('sql_role');
224 <  st := GetParam('lc_ctype');
225 <  if (st <> '') then
226 <    CharacterSet.ItemIndex := CharacterSet.Items.IndexOf(st);
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 := DatabaseName.Text;
200 <    if LocalRbtn.Checked then
201 <      DatabaseName.Text := Database.DatabaseName
202 <    else
234 <      case Protocol.ItemIndex of
235 <        0: Database.DatabaseName := Format('%s:%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
236 <        1: Database.DatabaseName := Format('\\%s\%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
237 <        2: Database.DatabaseName := Format('%s@%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
238 <      end;
239 <    Database.Params := DatabaseParams.Lines;
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  
245 procedure TIBDatabaseEditForm.RemoteRbtnClick(Sender: TObject);
246 begin
247  Browse.Enabled := False;
248  Label7.Enabled := True;
249  Label8.Enabled := True;
250  Protocol.Enabled := True;
251  ServerName.Enabled := True;
252 end;
253
254 procedure TIBDatabaseEditForm.CharacterSetCloseUp(Sender: TObject);
255 begin
256  if (CharacterSet.Text <> 'None') then {do not localize}
257    AddParam('lc_ctype', CharacterSet.Text)
258  else
259    DeleteParam('lc_ctype');
260
261 end;
262
209   procedure TIBDatabaseEditForm.BrowseClick(Sender: TObject);
210   begin
211    with TOpenDialog.Create(Application) do
212      try
213 <      InitialDir := ExtractFilePath(DatabaseName.Text);
213 >      InitialDir := ExtractFilePath(DatabasePath.Text);
214        Filter := SDatabaseFilter;
215        if Execute then
216 <        DatabaseName.Text := FileName;
216 >        DatabasePath.Text := FileName;
217      finally
218        Free
219      end;
220   end;
221  
222 < procedure TIBDatabaseEditForm.LocalRbtnClick(Sender: TObject);
222 > procedure TIBDatabaseEditForm.ConfigOverridesEditingDone(Sender: TObject);
223   begin
224 <  Browse.Enabled := True;
225 <  Label7.Enabled := False;
226 <  Label8.Enabled := False;
227 <  ServerName.Enabled := False;
228 <  Protocol.Enabled := False;
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);
# Line 304 | Line 256 | begin
256    Application.HelpContext(HelpContext);
257   end;
258  
259 < procedure TIBDatabaseEditForm.UserNameChange(Sender: TObject);
259 > procedure TIBDatabaseEditForm.PasswordEditingDone(Sender: TObject);
260   begin
261 <  AddParam('user_name', UserName.Text);
261 >  AddParam('password', Password.Text);
262   end;
263  
264 < procedure TIBDatabaseEditForm.PasswordChange(Sender: TObject);
264 > procedure TIBDatabaseEditForm.ProtocolCloseUp(Sender: TObject);
265   begin
266 <  AddParam('password', Password.Text);
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.SQLRoleChange(Sender: TObject);
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 <  ShowMessage(CharacterSet.Text);
325 <  if (CharacterSet.Text <> 'None') then {do not localize}
303 >  if (CharacterSet.ItemIndex <> -1 ) then {do not localize}
304      AddParam('lc_ctype', CharacterSet.Text)
305    else
306      DeleteParam('lc_ctype');
# Line 335 | Line 313 | begin
313    Test.Enabled := false;
314    tempDB := TIBDatabase.Create(nil);
315    try
316 <    if LocalRbtn.Checked then
317 <      tempDB.DatabaseName := DatabaseName.Text
340 <    else
341 <      case Protocol.ItemIndex of
342 <        0: tempDB.DatabaseName := Format('%s:%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
343 <        1: tempDB.DatabaseName := Format('\\%s\%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
344 <        2: tempDB.DatabaseName := Format('%s@%s', [ServerName.Text, DatabaseName.Text]); {do not localize}
345 <      end;
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 <    tempDB.Connected := true;
321 <    ShowMessage('Successful Connection');
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 < initialization
333 <  {$i IBDatabaseEdit.lrs}
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.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines