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 |
< |
try |
143 |
< |
tempService.Active := true; |
144 |
< |
ShowMessage('Successful Connection'); |
145 |
< |
tempService.Active := false; |
146 |
< |
except on E: Exception do |
147 |
< |
ShowMessage(E.Message) |
148 |
< |
end; |
149 |
< |
finally |
150 |
< |
tempService.Free; |
151 |
< |
Test.Enabled := true; |
152 |
< |
end; |
153 |
< |
end; |
154 |
< |
|
155 |
< |
procedure TIBServiceEditorForm.UserNameChange(Sender: TObject); |
156 |
< |
begin |
157 |
< |
AddParam('user_name', UserName.Text); |
158 |
< |
end; |
159 |
< |
|
160 |
< |
function TIBServiceEditorForm.Edit: Boolean; |
161 |
< |
begin |
162 |
< |
if Trim(Service.Params.Text) = '' then |
163 |
< |
ServiceParams.Clear |
164 |
< |
else |
165 |
< |
ServiceParams.Lines.Assign(Service.Params); |
166 |
< |
|
167 |
< |
ServerName.Text := Service.ServerName; |
168 |
< |
LoginPrompt.Checked := Service.LoginPrompt; |
169 |
< |
UserName.Text := GetParam('user_name'); |
170 |
< |
Password.Text := GetParam('password'); |
171 |
< |
RemoteRbtn.Checked := (Service.Protocol <> Local); |
172 |
< |
Result := False; |
173 |
< |
if ShowModal = mrOk then |
174 |
< |
begin |
175 |
< |
if LocalRbtn.Checked then |
176 |
< |
begin |
177 |
< |
Service.Protocol := Local; |
178 |
< |
Service.ServerName := '' |
179 |
< |
end |
180 |
< |
else |
181 |
< |
begin |
182 |
< |
case Protocol.ItemIndex of |
183 |
< |
0: Service.Protocol := TCP; |
184 |
< |
1: Service.Protocol := NamedPipe; |
185 |
< |
2: Service.Protocol := SPX; |
186 |
< |
end; |
187 |
< |
Service.ServerName := ServerName.Text |
188 |
< |
end; |
189 |
< |
Service.Params := ServiceParams.Lines; |
190 |
< |
Service.LoginPrompt := LoginPrompt.Checked; |
191 |
< |
Result := True; |
192 |
< |
end; |
193 |
< |
end; |
194 |
< |
|
195 |
< |
function TIBServiceEditorForm.GetParam(aName: string): string; |
196 |
< |
var |
197 |
< |
i: Integer; |
198 |
< |
begin |
199 |
< |
Result := ''; |
200 |
< |
for i := 0 to ServiceParams.Lines.Count - 1 do |
201 |
< |
begin |
202 |
< |
if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then |
203 |
< |
begin |
204 |
< |
Result := ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]]; |
205 |
< |
break; |
206 |
< |
end; |
207 |
< |
end; |
208 |
< |
end; |
209 |
< |
|
210 |
< |
procedure TIBServiceEditorForm.AddParam(aName, Value: string); |
211 |
< |
var |
212 |
< |
i: Integer; |
213 |
< |
found: boolean; |
214 |
< |
begin |
215 |
< |
found := False; |
216 |
< |
if Trim(Value) <> '' then |
217 |
< |
begin |
218 |
< |
ServiceParams.Lines.NameValueSeparator := '='; |
219 |
< |
for i := 0 to ServiceParams.Lines.Count - 1 do |
220 |
< |
begin |
221 |
< |
if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok} |
222 |
< |
begin |
223 |
< |
ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]] := Value; |
224 |
< |
found := True; |
225 |
< |
break; |
226 |
< |
end; |
227 |
< |
end; |
228 |
< |
if not found then |
229 |
< |
ServiceParams.Lines.Add(aName + '=' + Value); |
230 |
< |
end |
231 |
< |
else |
232 |
< |
DeleteParam(Name); |
233 |
< |
end; |
234 |
< |
|
235 |
< |
procedure TIBServiceEditorForm.DeleteParam(aName: string); |
236 |
< |
var |
237 |
< |
i: Integer; |
238 |
< |
begin |
239 |
< |
for i := 0 to ServiceParams.Lines.Count - 1 do |
240 |
< |
begin |
241 |
< |
if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok} |
242 |
< |
begin |
243 |
< |
ServiceParams.Lines.Delete(i); |
244 |
< |
break; |
245 |
< |
end; |
246 |
< |
end; |
247 |
< |
end; |
248 |
< |
|
249 |
< |
|
250 |
< |
end. |
251 |
< |
|
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, IB; |
36 |
> |
|
37 |
> |
type |
38 |
> |
|
39 |
> |
{ TIBServiceEditorForm } |
40 |
> |
|
41 |
> |
TIBServiceEditorForm = class(TForm) |
42 |
> |
Bevel1: TBevel; |
43 |
> |
CancelBtn: TButton; |
44 |
> |
PortNo: TEdit; |
45 |
> |
Label1: TLabel; |
46 |
> |
ServiceParams: TMemo; |
47 |
> |
Label2: TLabel; |
48 |
> |
Label3: TLabel; |
49 |
> |
Label5: TLabel; |
50 |
> |
Label7: TLabel; |
51 |
> |
Label8: TLabel; |
52 |
> |
LocalRbtn: TRadioButton; |
53 |
> |
LoginPrompt: TCheckBox; |
54 |
> |
OKBtn: TButton; |
55 |
> |
Password: TEdit; |
56 |
> |
Protocol: TComboBox; |
57 |
> |
RemoteRbtn: TRadioButton; |
58 |
> |
ServerName: TEdit; |
59 |
> |
Test: TButton; |
60 |
> |
UserName: TEdit; |
61 |
> |
procedure LocalRbtnClick(Sender: TObject); |
62 |
> |
procedure PasswordChange(Sender: TObject); |
63 |
> |
procedure RemoteRbtnClick(Sender: TObject); |
64 |
> |
procedure TestClick(Sender: TObject); |
65 |
> |
procedure UserNameChange(Sender: TObject); |
66 |
> |
private |
67 |
> |
{ private declarations } |
68 |
> |
function Edit: Boolean; |
69 |
> |
function GetParam(aName: string): string; |
70 |
> |
procedure AddParam(aName, Value: string); |
71 |
> |
procedure DeleteParam(aName: string); |
72 |
> |
public |
73 |
> |
{ public declarations } |
74 |
> |
Service: TIBCustomService; |
75 |
> |
end; |
76 |
> |
|
77 |
> |
function EditIBService(aService: TIBCustomService): boolean; |
78 |
> |
|
79 |
> |
var |
80 |
> |
IBServiceEditorForm: TIBServiceEditorForm; |
81 |
> |
|
82 |
> |
implementation |
83 |
> |
|
84 |
> |
{$R *.lfm} |
85 |
> |
|
86 |
> |
function EditIBService(aService: TIBCustomService): boolean; |
87 |
> |
begin |
88 |
> |
with TIBServiceEditorForm.Create(Application) do |
89 |
> |
try |
90 |
> |
Service := aService; |
91 |
> |
Result := Edit |
92 |
> |
finally |
93 |
> |
Free |
94 |
> |
end |
95 |
> |
end; |
96 |
> |
|
97 |
> |
{ TIBServiceEditorForm } |
98 |
> |
|
99 |
> |
procedure TIBServiceEditorForm.LocalRbtnClick(Sender: TObject); |
100 |
> |
begin |
101 |
> |
Label7.Enabled := False; |
102 |
> |
Label8.Enabled := False; |
103 |
> |
ServerName.Enabled := False; |
104 |
> |
Protocol.Enabled := False; |
105 |
> |
end; |
106 |
> |
|
107 |
> |
procedure TIBServiceEditorForm.PasswordChange(Sender: TObject); |
108 |
> |
begin |
109 |
> |
AddParam('password', Password.Text); |
110 |
> |
end; |
111 |
> |
|
112 |
> |
procedure TIBServiceEditorForm.RemoteRbtnClick(Sender: TObject); |
113 |
> |
begin |
114 |
> |
Label7.Enabled := True; |
115 |
> |
Label8.Enabled := True; |
116 |
> |
Protocol.Enabled := True; |
117 |
> |
ServerName.Enabled := True; |
118 |
> |
if Protocol.Text = '' then |
119 |
> |
Protocol.Text := 'TCP'; |
120 |
> |
end; |
121 |
> |
|
122 |
> |
procedure TIBServiceEditorForm.TestClick(Sender: TObject); |
123 |
> |
var tempService: TIBControlService; {Use as example for test} |
124 |
> |
begin |
125 |
> |
Test.Enabled := false; |
126 |
> |
tempService := TIBControlService.Create(nil); |
127 |
> |
try |
128 |
> |
if LocalRbtn.Checked then |
129 |
> |
begin |
130 |
> |
tempService.ServerName := ''; |
131 |
> |
tempService.Protocol := Local; |
132 |
> |
end |
133 |
> |
else |
134 |
> |
begin |
135 |
> |
case Protocol.ItemIndex of |
136 |
> |
0: tempService.Protocol := TCP; |
137 |
> |
1: tempService.Protocol := NamedPipe; |
138 |
> |
2: tempService.Protocol := SPX; |
139 |
> |
end; |
140 |
> |
tempService.ServerName := ServerName.Text |
141 |
> |
end; |
142 |
> |
tempService.PortNo := PortNo.Text; |
143 |
> |
tempService.Params.Assign(ServiceParams.Lines); |
144 |
> |
tempService.LoginPrompt := true; |
145 |
> |
try |
146 |
> |
tempService.Active := true; |
147 |
> |
ShowMessage('Successful Connection'); |
148 |
> |
tempService.Active := false; |
149 |
> |
except on E: Exception do |
150 |
> |
ShowMessage(E.Message) |
151 |
> |
end; |
152 |
> |
finally |
153 |
> |
tempService.Free; |
154 |
> |
Test.Enabled := true; |
155 |
> |
end; |
156 |
> |
end; |
157 |
> |
|
158 |
> |
procedure TIBServiceEditorForm.UserNameChange(Sender: TObject); |
159 |
> |
begin |
160 |
> |
AddParam('user_name', UserName.Text); |
161 |
> |
end; |
162 |
> |
|
163 |
> |
function TIBServiceEditorForm.Edit: Boolean; |
164 |
> |
begin |
165 |
> |
if Trim(Service.Params.Text) = '' then |
166 |
> |
ServiceParams.Clear |
167 |
> |
else |
168 |
> |
ServiceParams.Lines.Assign(Service.Params); |
169 |
> |
|
170 |
> |
ServerName.Text := Service.ServerName; |
171 |
> |
LoginPrompt.Checked := Service.LoginPrompt; |
172 |
> |
PortNo.Text := Service.PortNo; |
173 |
> |
UserName.Text := GetParam('user_name'); |
174 |
> |
Password.Text := GetParam('password'); |
175 |
> |
RemoteRbtn.Checked := (Service.Protocol <> Local); |
176 |
> |
Result := False; |
177 |
> |
if ShowModal = mrOk then |
178 |
> |
begin |
179 |
> |
if LocalRbtn.Checked then |
180 |
> |
begin |
181 |
> |
Service.Protocol := Local; |
182 |
> |
Service.ServerName := '' |
183 |
> |
end |
184 |
> |
else |
185 |
> |
begin |
186 |
> |
case Protocol.ItemIndex of |
187 |
> |
0: Service.Protocol := TCP; |
188 |
> |
1: Service.Protocol := NamedPipe; |
189 |
> |
2: Service.Protocol := SPX; |
190 |
> |
end; |
191 |
> |
Service.ServerName := ServerName.Text |
192 |
> |
end; |
193 |
> |
Service.Params := ServiceParams.Lines; |
194 |
> |
Service.LoginPrompt := LoginPrompt.Checked; |
195 |
> |
Service.PortNo := PortNo.Text; |
196 |
> |
Result := True; |
197 |
> |
end; |
198 |
> |
end; |
199 |
> |
|
200 |
> |
function TIBServiceEditorForm.GetParam(aName: string): string; |
201 |
> |
var |
202 |
> |
i: Integer; |
203 |
> |
begin |
204 |
> |
Result := ''; |
205 |
> |
for i := 0 to ServiceParams.Lines.Count - 1 do |
206 |
> |
begin |
207 |
> |
if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then |
208 |
> |
begin |
209 |
> |
Result := ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]]; |
210 |
> |
break; |
211 |
> |
end; |
212 |
> |
end; |
213 |
> |
end; |
214 |
> |
|
215 |
> |
procedure TIBServiceEditorForm.AddParam(aName, Value: string); |
216 |
> |
var |
217 |
> |
i: Integer; |
218 |
> |
found: boolean; |
219 |
> |
begin |
220 |
> |
found := False; |
221 |
> |
if Trim(Value) <> '' then |
222 |
> |
begin |
223 |
> |
ServiceParams.Lines.NameValueSeparator := '='; |
224 |
> |
for i := 0 to ServiceParams.Lines.Count - 1 do |
225 |
> |
begin |
226 |
> |
if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok} |
227 |
> |
begin |
228 |
> |
ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]] := Value; |
229 |
> |
found := True; |
230 |
> |
break; |
231 |
> |
end; |
232 |
> |
end; |
233 |
> |
if not found then |
234 |
> |
ServiceParams.Lines.Add(aName + '=' + Value); |
235 |
> |
end |
236 |
> |
else |
237 |
> |
DeleteParam(Name); |
238 |
> |
end; |
239 |
> |
|
240 |
> |
procedure TIBServiceEditorForm.DeleteParam(aName: string); |
241 |
> |
var |
242 |
> |
i: Integer; |
243 |
> |
begin |
244 |
> |
for i := 0 to ServiceParams.Lines.Count - 1 do |
245 |
> |
begin |
246 |
> |
if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok} |
247 |
> |
begin |
248 |
> |
ServiceParams.Lines.Delete(i); |
249 |
> |
break; |
250 |
> |
end; |
251 |
> |
end; |
252 |
> |
end; |
253 |
> |
|
254 |
> |
|
255 |
> |
end. |