ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/design/ibserviceeditor.pas

Comparing ibx/trunk/design/ibserviceeditor.pas (file contents):
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC

#	Line 1 | Line 1
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	<
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.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines