trunk/design/ibserviceeditor.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2011 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit ibserviceeditor;

{$mode objfpc}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, IBServices, IB;

type

  { TIBServiceEditorForm }

  TIBServiceEditorForm = class(TForm)
    Bevel1: TBevel;
    CancelBtn: TButton;
    ServiceParams: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    LocalRbtn: TRadioButton;
    LoginPrompt: TCheckBox;
    OKBtn: TButton;
    Password: TEdit;
    Protocol: TComboBox;
    RemoteRbtn: TRadioButton;
    ServerName: TEdit;
    Test: TButton;
    UserName: TEdit;
    procedure LocalRbtnClick(Sender: TObject);
    procedure PasswordChange(Sender: TObject);
    procedure RemoteRbtnClick(Sender: TObject);
    procedure TestClick(Sender: TObject);
    procedure UserNameChange(Sender: TObject);
  private
    { private declarations }
    function Edit: Boolean;
    function GetParam(aName: string): string;
    procedure AddParam(aName, Value: string);
    procedure DeleteParam(aName: string);
  public
    { public declarations }
    Service: TIBCustomService;
  end;

function EditIBService(aService: TIBCustomService): boolean;

var
  IBServiceEditorForm: TIBServiceEditorForm;

implementation

{$R *.lfm}

function EditIBService(aService: TIBCustomService): boolean;
begin
  with TIBServiceEditorForm.Create(Application) do
  try
    Service := aService;
    Result := Edit
  finally
    Free
  end
end;

{ TIBServiceEditorForm }

procedure TIBServiceEditorForm.LocalRbtnClick(Sender: TObject);
begin
  Label7.Enabled := False;
  Label8.Enabled := False;
  ServerName.Enabled := False;
  Protocol.Enabled := False;
end;

procedure TIBServiceEditorForm.PasswordChange(Sender: TObject);
begin
  AddParam('password', Password.Text);
end;

procedure TIBServiceEditorForm.RemoteRbtnClick(Sender: TObject);
begin
  Label7.Enabled := True;
  Label8.Enabled := True;
  Protocol.Enabled := True;
  ServerName.Enabled := True;
  if Protocol.Text = '' then
    Protocol.Text := 'TCP';
end;

procedure TIBServiceEditorForm.TestClick(Sender: TObject);
var tempService: TIBControlService; {Use as example for test}
begin
  Test.Enabled := false;
  tempService := TIBControlService.Create(nil);
  try
    if LocalRbtn.Checked then
    begin
      tempService.ServerName := '';
      tempService.Protocol := Local;
    end
    else
    begin
      case Protocol.ItemIndex of
      0: tempService.Protocol := TCP;
      1: tempService.Protocol := NamedPipe;
      2: tempService.Protocol := SPX;
      end;
      tempService.ServerName := ServerName.Text
    end;
    tempService.Params.Assign(ServiceParams.Lines);
    tempService.LoginPrompt := true;
    try
      tempService.Active := true;
      ShowMessage('Successful Connection');
      tempService.Active := false;
    except on E: Exception do
      ShowMessage(E.Message)
    end;
  finally
    tempService.Free;
    Test.Enabled := true;
  end;
end;

procedure TIBServiceEditorForm.UserNameChange(Sender: TObject);
begin
  AddParam('user_name', UserName.Text);
end;

function TIBServiceEditorForm.Edit: Boolean;
begin
  if Trim(Service.Params.Text) = '' then
    ServiceParams.Clear
  else
    ServiceParams.Lines.Assign(Service.Params);

  ServerName.Text := Service.ServerName;
  LoginPrompt.Checked := Service.LoginPrompt;
  UserName.Text := GetParam('user_name');
  Password.Text := GetParam('password');
  RemoteRbtn.Checked := (Service.Protocol <> Local);
  Result := False;
  if ShowModal = mrOk then
  begin
    if LocalRbtn.Checked then
    begin
      Service.Protocol := Local;
      Service.ServerName := ''
    end
    else
    begin
      case Protocol.ItemIndex of
      0: Service.Protocol := TCP;
      1: Service.Protocol := NamedPipe;
      2: Service.Protocol := SPX;
      end;
      Service.ServerName := ServerName.Text
    end;
    Service.Params := ServiceParams.Lines;
    Service.LoginPrompt := LoginPrompt.Checked;
    Result := True;
  end;
end;

function TIBServiceEditorForm.GetParam(aName: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to ServiceParams.Lines.Count - 1 do
  begin
    if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then
    begin
      Result := ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]];
      break;
    end;
  end;
end;

procedure TIBServiceEditorForm.AddParam(aName, Value: string);
var
  i: Integer;
  found: boolean;
begin
  found := False;
  if Trim(Value) <> '' then
  begin
    ServiceParams.Lines.NameValueSeparator := '=';
    for i := 0 to ServiceParams.Lines.Count - 1 do
    begin
      if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok}
      begin
        ServiceParams.Lines.Values[ServiceParams.Lines.Names[i]] := Value;
        found := True;
        break;
      end;
    end;
    if not found then
      ServiceParams.Lines.Add(aName + '=' + Value);
  end
  else
    DeleteParam(Name);
end;

procedure TIBServiceEditorForm.DeleteParam(aName: string);
var
  i: Integer;
begin
    for i := 0 to ServiceParams.Lines.Count - 1 do
    begin
      if (Pos(aName, LowerCase(ServiceParams.Lines.Names[i])) = 1) then {mbcs ok}
      begin
        ServiceParams.Lines.Delete(i);
        break;
      end;
    end;
end;


end.
Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	6128 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	Content
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	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.