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 231 by tony, Mon Apr 16 08:32:21 2018 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 +    DatabasePath: TEdit;
61 +    Label1: TLabel;
62 +    Label7: TLabel;
63 +    Label8: TLabel;
64 +    Label9: TLabel;
65 +    PortNo: TEdit;
66 +    Protocol: TComboBox;
67 +    ConnectionTypeBtn: TRadioGroup;
68 +    ServerName: TEdit;
69 +    UseSystemDefaultCS: TCheckBox;
70 +    Panel1: TPanel;
71      GroupBox1: TGroupBox;
72      UserName: TEdit;
73      Password: TEdit;
# Line 57 | Line 78 | type
78      DatabaseParams: TMemo;
79      OKBtn: TButton;
80      CancelBtn: TButton;
60    HelpBtn: TButton;
81      Label5: TLabel;
82      LoginPrompt: TCheckBox;
83      Label6: TLabel;
84      CharacterSet: TComboBox;
65    ServerName: TEdit;
66    Protocol: TComboBox;
67    Label7: TLabel;
68    Label8: TLabel;
85      Test: TButton;
70    procedure CharacterSetCloseUp(Sender: TObject);
71    procedure RemoteRbtnClick(Sender: TObject);
86      procedure BrowseClick(Sender: TObject);
87 <    procedure LocalRbtnClick(Sender: TObject);
87 >    procedure DatabaseParamsEditingDone(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);
91 >    procedure PasswordEditingDone(Sender: TObject);
92 >    procedure ProtocolCloseUp(Sender: TObject);
93 >    procedure ConnectionTypeBtnSelectionChanged(Sender: TObject);
94 >    procedure SQLRoleEditingDone(Sender: TObject);
95      procedure CharacterSetChange(Sender: TObject);
96      procedure TestClick(Sender: TObject);
97 +    procedure UserNameEditingDone(Sender: TObject);
98 +    procedure UseSystemDefaultCSChange(Sender: TObject);
99    private
100      { Private declarations }
101      Database: TIBDatabase;
102      function Edit: Boolean;
103 <    function GetParam(Name: string): string;
104 <    procedure AddParam(Name, Value: string);
105 <    procedure DeleteParam(Name: string);
103 >    procedure AddParam(aName, aValue: string);
104 >    procedure DeleteParam(aName: string);
105 >    procedure UpdateParamEditBoxes;
106    public
107      { Public declarations }
108    end;
# Line 97 | Line 114 | var
114  
115   implementation
116  
117 + {$R *.lfm}
118  
119 < uses {LibHelp,} TypInfo;
119 > uses TypInfo, FBMessages, IBUtils;
120  
121   function EditIBDatabase(ADatabase: TIBDatabase): Boolean;
122   begin
# Line 111 | Line 129 | begin
129    end;
130   end;
131  
132 < function TIBDatabaseEditForm.GetParam(Name: string): string;
115 < var
116 <  i: Integer;
132 > procedure TIBDatabaseEditForm.AddParam(aName, aValue: string);
133   begin
134 <  Result := '';
135 <  for i := 0 to DatabaseParams.Lines.Count - 1 do
136 <  begin
137 <    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;
134 >  if Trim(aValue) = '' then
135 >    DeleteParam(aName)
136 >  else
137 >    DatabaseParams.Lines.Values[aName] := Trim(aValue);
138   end;
139  
140 < procedure TIBDatabaseEditForm.AddParam(Name, Value: string);
140 > procedure TIBDatabaseEditForm.DeleteParam(aName: string);
141   var
142    i: Integer;
132  found: boolean;
143   begin
134  found := False;
135  if Trim(Value) <> '' then
136  begin
144      for i := 0 to DatabaseParams.Lines.Count - 1 do
145      begin
146 <      if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
146 >      if (Pos(aName, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
147        begin
148 <        DatabaseParams.Lines.Values[DatabaseParams.Lines.Names[i]] := Value;
142 <        found := True;
148 >        DatabaseParams.Lines.Delete(i);
149          break;
150        end;
151      end;
146    if not found then
147      DatabaseParams.Lines.Add(Name + '=' + Value);
148  end
149  else
150    DeleteParam(Name);
152   end;
153  
154 < procedure TIBDatabaseEditForm.DeleteParam(Name: string);
155 < var
155 <  i: Integer;
154 > procedure TIBDatabaseEditForm.UpdateParamEditBoxes;
155 > var st: string;
156   begin
157 <    for i := 0 to DatabaseParams.Lines.Count - 1 do
158 <    begin
159 <      if (Pos(Name, LowerCase(DatabaseParams.Lines.Names[i])) = 1) then {mbcs ok}
160 <      begin
161 <        DatabaseParams.Lines.Delete(i);
162 <        break;
163 <      end;
164 <    end;
157 >  UserName.Text := DatabaseParams.Lines.Values['user_name'];
158 >  Password.Text := DatabaseParams.Lines.Values['password'];
159 >  SQLRole.Text := DatabaseParams.Lines.Values['sql_role_name'];
160 >  st := DatabaseParams.Lines.Values['lc_ctype'];
161 >  if (st <> '') then
162 >    CharacterSet.ItemIndex := CharacterSet.Items.IndexOf(st)
163 >  else
164 >    CharacterSet.ItemIndex := -1;
165   end;
166  
167   function TIBDatabaseEditForm.Edit: Boolean;
168   var
169 <  st: string;
169 >  aServerName: string;
170 >  aDatabaseName: string;
171 >  aProtocol: TProtocolAll;
172 >  aPortNo: string;
173  
174 <  procedure DecomposeDatabaseName;
175 <  var
173 <    Idx1, Idx2: Integer;
174 <    st: string;
174 > begin
175 >  if ParseConnectString(Database.DatabaseName, aServerName, aDatabaseName, aProtocol, aPortNo) then
176    begin
177 <    if Pos('\\', Database.DatabaseName) <> 0 then {do not localize}
178 <    begin
179 <      LocalRBtn.Checked := False;
180 <      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;
177 >    ServerName.Text := aServerName;
178 >    DatabasePath.Text := aDatabaseName;
179 >    Protocol.ItemIndex := ord(aProtocol);
180 >    PortNo.Text := aPortNo;
181    end;
182 < begin
183 <  DecomposeDatabaseName;
184 <  DatabaseParams.Lines := Database.Params;
182 >  ProtocolCloseUp(nil);
183 >  ConnectionTypeBtnSelectionChanged(nil);
184 >  if Trim(Database.Params.Text) = '' then
185 >    DatabaseParams.Clear
186 >  else
187 >    DatabaseParams.Lines.Assign(Database.Params);
188    LoginPrompt.Checked := Database.LoginPrompt;
189 <  UserName.Text := GetParam('user_name');
190 <  Password.Text := GetParam('password');
223 <  SQLRole.Text := GetParam('sql_role');
224 <  st := GetParam('lc_ctype');
225 <  if (st <> '') then
226 <    CharacterSet.ItemIndex := CharacterSet.Items.IndexOf(st);
189 >  UpdateParamEditBoxes;
190 >  UseSystemDefaultCS.Checked := Database.UseDefaultSystemCodePage;
191    Result := False;
192    if ShowModal = mrOk then
193    begin
194 <    Database.DatabaseName := DatabaseName.Text;
195 <    if LocalRbtn.Checked then
232 <      DatabaseName.Text := Database.DatabaseName
233 <    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;
194 >    Database.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
195 >      TProtocolAll(Protocol.ItemIndex), PortNo.Text);
196      Database.Params := DatabaseParams.Lines;
197      Database.LoginPrompt := LoginPrompt.Checked;
198 +    Database.UseDefaultSystemCodePage := UseSystemDefaultCS.Checked;
199      Result := True;
200    end;
201   end;
202  
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
203   procedure TIBDatabaseEditForm.BrowseClick(Sender: TObject);
204   begin
205    with TOpenDialog.Create(Application) do
206      try
207 <      InitialDir := ExtractFilePath(DatabaseName.Text);
207 >      InitialDir := ExtractFilePath(DatabasePath.Text);
208        Filter := SDatabaseFilter;
209        if Execute then
210 <        DatabaseName.Text := FileName;
210 >        DatabasePath.Text := FileName;
211      finally
212        Free
213      end;
214   end;
215  
216 < procedure TIBDatabaseEditForm.LocalRbtnClick(Sender: TObject);
216 > procedure TIBDatabaseEditForm.DatabaseParamsEditingDone(Sender: TObject);
217   begin
218 <  Browse.Enabled := True;
279 <  Label7.Enabled := False;
280 <  Label8.Enabled := False;
281 <  ServerName.Enabled := False;
282 <  Protocol.Enabled := False;
218 >  UpdateParamEditBoxes;
219   end;
220  
221   procedure TIBDatabaseEditForm.OKBtnClick(Sender: TObject);
# Line 304 | Line 240 | begin
240    Application.HelpContext(HelpContext);
241   end;
242  
243 < procedure TIBDatabaseEditForm.UserNameChange(Sender: TObject);
243 > procedure TIBDatabaseEditForm.PasswordEditingDone(Sender: TObject);
244   begin
245 <  AddParam('user_name', UserName.Text);
245 >  AddParam('password', Password.Text);
246   end;
247  
248 < procedure TIBDatabaseEditForm.PasswordChange(Sender: TObject);
248 > procedure TIBDatabaseEditForm.ProtocolCloseUp(Sender: TObject);
249   begin
250 <  AddParam('password', Password.Text);
250 >  if Protocol.ItemIndex = 3 then
251 >    ConnectionTypeBtn.ItemIndex := 0
252 >  else
253 >    ConnectionTypeBtn.ItemIndex := 1;
254   end;
255  
256 < procedure TIBDatabaseEditForm.SQLRoleChange(Sender: TObject);
256 > procedure TIBDatabaseEditForm.ConnectionTypeBtnSelectionChanged(Sender: TObject);
257 > begin
258 >  if ConnectionTypeBtn.ItemIndex > 0 then
259 >  begin
260 >    Browse.Enabled := False;
261 >    Label7.Enabled := True;
262 >    Label8.Enabled := True;
263 >    Protocol.Enabled := True;
264 >    ServerName.Enabled := True;
265 >    if Protocol.ItemIndex = 3 then
266 >      Protocol.ItemIndex := 4;
267 >  end
268 >  else
269 >  begin
270 >    Browse.Enabled := True;
271 >    Label7.Enabled := False;
272 >    Label8.Enabled := true;
273 >    ServerName.Text := '';
274 >    ServerName.Enabled := False;
275 >    Protocol.Enabled := true;
276 >    Protocol.ItemIndex := 3;
277 >  end;
278 > end;
279 >
280 > procedure TIBDatabaseEditForm.SQLRoleEditingDone(Sender: TObject);
281   begin
282    AddParam('sql_role_name', SQLRole.Text);
283   end;
284  
285   procedure TIBDatabaseEditForm.CharacterSetChange(Sender: TObject);
286   begin
287 <  ShowMessage(CharacterSet.Text);
325 <  if (CharacterSet.Text <> 'None') then {do not localize}
287 >  if (CharacterSet.ItemIndex <> -1 ) then {do not localize}
288      AddParam('lc_ctype', CharacterSet.Text)
289    else
290      DeleteParam('lc_ctype');
# Line 335 | Line 297 | begin
297    Test.Enabled := false;
298    tempDB := TIBDatabase.Create(nil);
299    try
300 <    if LocalRbtn.Checked then
301 <      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;
300 >    tempDB.DatabaseName := MakeConnectString(ServerName.Text, DatabasePath.Text,
301 >      TProtocolAll(Protocol.ItemIndex), PortNo.Text);
302      tempDB.Params.Assign(DatabaseParams.Lines);
303      tempDB.LoginPrompt := LoginPrompt.Checked;
304 <    tempDB.Connected := true;
305 <    ShowMessage('Successful Connection');
304 >    try
305 >      tempDB.Connected := true;
306 >      ShowMessage('Successful Connection');
307 >    except on E: Exception do
308 >      ShowMessage(E.Message)
309 >    end;
310    finally
311      tempDB.Free;
312      Test.Enabled := true;
313    end;
314   end;
315  
316 < initialization
317 <  {$i IBDatabaseEdit.lrs}
316 > procedure TIBDatabaseEditForm.UserNameEditingDone(Sender: TObject);
317 > begin
318 >  AddParam('user_name', UserName.Text);
319 > end;
320 >
321 > procedure TIBDatabaseEditForm.UseSystemDefaultCSChange(Sender: TObject);
322 > begin
323 >  CharacterSet.Enabled := not UseSystemDefaultCS.Checked;
324 >  if UseSystemDefaultCS.Checked then
325 >    DeleteParam('lc_ctype')
326 >  else
327 >  if (CharacterSet.Text <> 'None') then {do not localize}
328 >      AddParam('lc_ctype', CharacterSet.Text)
329 > end;
330 >
331  
332   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines