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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 17 by tony, Sat Dec 28 19:22:24 2013 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;
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	>

Diff Legend

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