ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/ibserviceeditor.pas
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (6 years, 6 months ago) by tony
File size: 6290 byte(s)
Log Message:
Committing updates for Release R1-0-5
Line File contents
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2011 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26
27 unit ibserviceeditor;
28
29 {$mode objfpc}
30
31 interface
32
33 uses
34 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
35 ExtCtrls, StdCtrls, IBServices;
36
37 type
38
39 { TIBServiceEditorForm }
40
41 TIBServiceEditorForm = class(TForm)
42 Bevel1: TBevel;
43 CancelBtn: TButton;
44 ServiceParams: TMemo;
45 Label2: TLabel;
46 Label3: TLabel;
47 Label5: TLabel;
48 Label7: TLabel;
49 Label8: TLabel;
50 LocalRbtn: TRadioButton;
51 LoginPrompt: TCheckBox;
52 OKBtn: TButton;
53 Password: TEdit;
54 Protocol: TComboBox;
55 RemoteRbtn: TRadioButton;
56 ServerName: TEdit;
57 Test: TButton;
58 UserName: TEdit;
59 procedure LocalRbtnClick(Sender: TObject);
60 procedure PasswordChange(Sender: TObject);
61 procedure RemoteRbtnClick(Sender: TObject);
62 procedure TestClick(Sender: TObject);
63 procedure UserNameChange(Sender: TObject);
64 private
65 { private declarations }
66 function Edit: Boolean;
67 function GetParam(aName: string): string;
68 procedure AddParam(aName, Value: string);
69 procedure DeleteParam(aName: string);
70 public
71 { public declarations }
72 Service: TIBCustomService;
73 end;
74
75 function EditIBService(aService: TIBCustomService): boolean;
76
77 var
78 IBServiceEditorForm: TIBServiceEditorForm;
79
80 implementation
81
82 {$R *.lfm}
83
84 function EditIBService(aService: TIBCustomService): boolean;
85 begin
86 with TIBServiceEditorForm.Create(Application) do
87 try
88 Service := aService;
89 Result := Edit
90 finally
91 Free
92 end
93 end;
94
95 { TIBServiceEditorForm }
96
97 procedure TIBServiceEditorForm.LocalRbtnClick(Sender: TObject);
98 begin
99 Label7.Enabled := False;
100 Label8.Enabled := False;
101 ServerName.Enabled := False;
102 Protocol.Enabled := False;
103 end;
104
105 procedure TIBServiceEditorForm.PasswordChange(Sender: TObject);
106 begin
107 AddParam('password', Password.Text);
108 end;
109
110 procedure TIBServiceEditorForm.RemoteRbtnClick(Sender: TObject);
111 begin
112 Label7.Enabled := True;
113 Label8.Enabled := True;
114 Protocol.Enabled := True;
115 ServerName.Enabled := True;
116 if Protocol.Text = '' then
117 Protocol.Text := 'TCP';
118 end;
119
120 procedure TIBServiceEditorForm.TestClick(Sender: TObject);
121 var tempService: TIBControlService; {Use as example for test}
122 begin
123 Test.Enabled := false;
124 tempService := TIBControlService.Create(nil);
125 try
126 if LocalRbtn.Checked then
127 begin
128 tempService.ServerName := '';
129 tempService.Protocol := Local;
130 end
131 else
132 begin
133 case Protocol.ItemIndex of
134 0: tempService.Protocol := TCP;
135 1: tempService.Protocol := NamedPipe;
136 2: tempService.Protocol := SPX;
137 end;
138 tempService.ServerName := ServerName.Text
139 end;
140 tempService.Params.Assign(ServiceParams.Lines);
141 tempService.LoginPrompt := true;
142 tempService.Active := true;
143 ShowMessage('Successful Connection');
144 tempService.Active := false;
145 finally
146 tempService.Free;
147 Test.Enabled := true;
148 end;
149 end;
150
151 procedure TIBServiceEditorForm.UserNameChange(Sender: TObject);
152 begin
153 AddParam('user_name', UserName.Text);
154 end;
155
156 function TIBServiceEditorForm.Edit: Boolean;
157 begin
158 if Trim(Service.Params.Text) = '' then
159 ServiceParams.Clear
160 else
161 ServiceParams.Lines.Assign(Service.Params);
162
163 ServerName.Text := Service.ServerName;
164 LoginPrompt.Checked := Service.LoginPrompt;
165 UserName.Text := GetParam('user_name');
166 Password.Text := GetParam('password');
167 RemoteRbtn.Checked := (Service.Protocol <> Local);
168 Result := False;
169 if ShowModal = mrOk then
170 begin
171 if LocalRbtn.Checked then
172 begin
173 Service.Protocol := Local;
174 Service.ServerName := ''
175 end
176 else
177 begin
178 case Protocol.ItemIndex of
179 0: Service.Protocol := TCP;
180 1: Service.Protocol := NamedPipe;
181 2: Service.Protocol := SPX;
182 end;
183 Service.ServerName := ServerName.Text
184 end;
185 Service.Params := ServiceParams.Lines;
186 Service.LoginPrompt := LoginPrompt.Checked;
187 Result := True;
188 end;
189 end;
190
191 function TIBServiceEditorForm.GetParam(aName: string): string;
192 var
193 i: Integer;
194 begin
195 Result := '';
196 for i := 0 to ServiceParams.Lines.Count - 1 do
197 begin
198 if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then
199 begin
200 Result := ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]];
201 break;
202 end;
203 end;
204 end;
205
206 procedure TIBServiceEditorForm.AddParam(aName, Value: string);
207 var
208 i: Integer;
209 found: boolean;
210 begin
211 found := False;
212 if Trim(Value) <> '' then
213 begin
214 ServiceParams.Lines.NameValueSeparator := '=';
215 for i := 0 to ServiceParams.Lines.Count - 1 do
216 begin
217 if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok}
218 begin
219 ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]] := Value;
220 found := True;
221 break;
222 end;
223 end;
224 if not found then
225 ServiceParams.Lines.Add(aName + '=' + Value);
226 end
227 else
228 DeleteParam(Name);
229 end;
230
231 procedure TIBServiceEditorForm.DeleteParam(aName: string);
232 var
233 i: Integer;
234 begin
235 for i := 0 to ServiceParams.Lines.Count - 1 do
236 begin
237 if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok}
238 begin
239 ServiceParams.Lines.Delete(i);
240 break;
241 end;
242 end;
243 end;
244
245
246 end.
247