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;
    PortNo: TEdit;
    Label1: TLabel;
    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.PortNo := PortNo.Text;
    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;
  PortNo.Text := Service.PortNo;
  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;
    Service.PortNo := PortNo.Text;
    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:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	6274 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	33	(*
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	tony	45	ExtCtrls, StdCtrls, IBServices, IB;
36	tony	33
37			type
38
39			{ TIBServiceEditorForm }
40
41			TIBServiceEditorForm = class(TForm)
42			Bevel1: TBevel;
43			CancelBtn: TButton;
44	tony	209	PortNo: TEdit;
45			Label1: TLabel;
46	tony	33	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	tony	209	tempService.PortNo := PortNo.Text;
143	tony	33	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	tony	209	PortNo.Text := Service.PortNo;
173	tony	33	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	tony	209	Service.PortNo := PortNo.Text;
196	tony	33	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.