820 lines
23 KiB
Plaintext
820 lines
23 KiB
Plaintext
{
|
|
$Project$
|
|
$Workfile$
|
|
$Revision$
|
|
$DateUTC$
|
|
$Id$
|
|
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|
under the dual-licensing agreement described on the Indy website.
|
|
(http://www.indyproject.org/)
|
|
|
|
Copyright:
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|
}
|
|
{
|
|
$Log$
|
|
}
|
|
{
|
|
Rev 1.9 10/26/2004 8:45:26 PM JPMugaas
|
|
Should compile.
|
|
|
|
Rev 1.8 10/26/2004 8:42:58 PM JPMugaas
|
|
Should be more portable with new references to TIdStrings and TIdStringList.
|
|
|
|
Rev 1.7 5/19/2004 10:44:28 PM DSiders
|
|
Corrected spelling for TIdIPAddress.MakeAddressObject method.
|
|
|
|
Rev 1.6 2/3/2004 11:34:26 AM JPMugaas
|
|
Should compile.
|
|
|
|
Rev 1.5.1.0 2/3/2004 11:32:26 AM JPMugaas
|
|
Should compile.
|
|
|
|
Rev 1.5 2/1/2004 2:44:20 AM JPMugaas
|
|
Bindings editor should be fully functional including IPv6 support.
|
|
|
|
Rev 1.4 2/1/2004 1:03:34 AM JPMugaas
|
|
This now work properly in both Win32 and DotNET. The behavior had to change
|
|
in DotNET because of some missing functionality and because implementing that
|
|
functionality creates more problems than it would solve.
|
|
|
|
Rev 1.3 2003.12.31 10:42:22 PM czhower
|
|
Warning removed
|
|
|
|
Rev 1.2 10/15/2003 10:12:32 PM DSiders
|
|
Added localization comments.
|
|
|
|
Rev 1.1 2003.10.11 5:47:46 PM czhower
|
|
-VCL fixes for servers
|
|
-Chain suport for servers (Super core)
|
|
-Scheduler upgrades
|
|
-Full yarn support
|
|
|
|
Rev 1.0 11/13/2002 08:43:58 AM JPMugaas
|
|
}
|
|
|
|
unit IdDsnPropEdBindingVCL;
|
|
|
|
interface
|
|
|
|
{$I IdCompilerDefines.inc}
|
|
|
|
uses
|
|
Classes,
|
|
{$IFDEF WIDGET_KYLIX}
|
|
QActnList, QStdCtrls, QForms, QExtCtrls, QControls, QComCtrls, QGraphics, Qt,
|
|
{$ENDIF}
|
|
{$IFDEF WIDGET_VCL_LIKE}
|
|
ActnList, StdCtrls, Buttons, ExtCtrls, Graphics, Controls, ComCtrls, Forms, Dialogs,
|
|
{$ENDIF}
|
|
{$IFDEF HAS_UNIT_Types}
|
|
Types,
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
Windows,
|
|
{$ENDIF}
|
|
{$IFDEF LCL}
|
|
LResources,
|
|
{$ENDIF}
|
|
IdSocketHandle;
|
|
{
|
|
Design Note: It turns out that in DotNET, there are no services file functions and
|
|
IdPorts does not work as expected in DotNET. It is probably possible to read the
|
|
services file ourselves but that creates some portability problems as the placement
|
|
is different in every operating system.
|
|
|
|
e.g.
|
|
|
|
Linux and Unix-like systems - /etc
|
|
Windows 95, 98, and ME - c:\windows
|
|
Windows NT systems - c:\winnt\system32\drivers\etc
|
|
|
|
Thus, it will undercut whatever benefit we could get with DotNET.
|
|
|
|
About the best I could think of is to use an edit control because
|
|
we can't offer anything from the services file in DotNET.
|
|
|
|
TODO: Maybe there might be a way to find the location in a more elegant
|
|
manner than what I described.
|
|
}
|
|
|
|
type
|
|
TIdDsnPropEdBindingVCL = class(TForm)
|
|
{$IFDEF USE_TBitBtn}
|
|
btnOk: TBitBtn;
|
|
btnCancel: TBitBtn;
|
|
{$ELSE}
|
|
btnOk: TButton;
|
|
btnCancel: TButton;
|
|
{$ENDIF}
|
|
lblBindings: TLabel;
|
|
edtPort: TComboBox;
|
|
rdoBindingType: TRadioGroup;
|
|
lblIPAddress: TLabel;
|
|
lblPort: TLabel;
|
|
btnNew: TButton;
|
|
btnDelete: TButton;
|
|
ActionList1: TActionList;
|
|
btnBindingsNew: TAction;
|
|
btnBindingsDelete: TAction;
|
|
edtIPAddress: TComboBox;
|
|
lbBindings: TListBox;
|
|
procedure btnBindingsNewExecute(Sender: TObject);
|
|
procedure btnBindingsDeleteExecute(Sender: TObject);
|
|
procedure btnBindingsDeleteUpdate(Sender: TObject);
|
|
procedure edtPortKeyPress(Sender: TObject; var Key: Char);
|
|
procedure edtIPAddressChange(Sender: TObject);
|
|
procedure edtPortChange(Sender: TObject);
|
|
procedure rdoBindingTypeClick(Sender: TObject);
|
|
procedure lbBindingsClick(Sender: TObject);
|
|
private
|
|
procedure SetHandles(const Value: TIdSocketHandles);
|
|
procedure SetIPv4Addresses(const Value: TStrings);
|
|
procedure SetIPv6Addresses(const Value: TStrings);
|
|
procedure UpdateBindingList;
|
|
protected
|
|
FInUpdateRoutine : Boolean;
|
|
FHandles : TIdSocketHandles;
|
|
FDefaultPort : Integer;
|
|
FIPv4Addresses : TStrings;
|
|
FIPv6Addresses : TStrings;
|
|
fCreatedStack : Boolean;
|
|
FCurrentHandle : TIdSocketHandle;
|
|
procedure UpdateEditControls;
|
|
function PortDescription(const PortNumber: integer): string;
|
|
public
|
|
Constructor Create(AOwner : TComponent); overload; override;
|
|
constructor Create; reintroduce; overload;
|
|
Destructor Destroy; override;
|
|
function Execute : Boolean;
|
|
function GetList: string;
|
|
procedure SetList(const AList: string);
|
|
property Handles : TIdSocketHandles read FHandles write SetHandles;
|
|
property DefaultPort : Integer read FDefaultPort write FDefaultPort;
|
|
property IPv4Addresses : TStrings read FIPv4Addresses write SetIPv4Addresses;
|
|
property IPv6Addresses : TStrings read FIPv6Addresses write SetIPv6Addresses;
|
|
end;
|
|
|
|
var
|
|
IdPropEdBindingEntry: TIdDsnPropEdBindingVCL;
|
|
|
|
procedure FillHandleList(const AList: string; ADest: TIdSocketHandles);
|
|
function GetListValues(const ASocketHandles : TIdSocketHandles) : String;
|
|
|
|
implementation
|
|
|
|
uses
|
|
IdGlobal,
|
|
IdIPAddress,
|
|
IdDsnCoreResourceStrings,
|
|
IdStack,
|
|
IdStackBSDBase,
|
|
SysUtils;
|
|
|
|
const
|
|
IPv6Wildcard1 = '::'; {do not localize}
|
|
{CH IPv6Wildcard2 = '0:0:0:0:0:0:0:0'; } {do not localize}
|
|
IPv6Loopback = '::1'; {do not localize}
|
|
IPv4Wildcard = '0.0.0.0'; {do not localize}
|
|
IPv4Loopback = '127.0.0.1'; {do not localize}
|
|
|
|
function IsValidIP(const AAddr : String): Boolean;
|
|
var
|
|
LIP : TIdIPAddress;
|
|
begin
|
|
LIP := TIdIPAddress.MakeAddressObject(AAddr);
|
|
Result := Assigned(LIP);
|
|
if Result then begin
|
|
FreeAndNil(LIP);
|
|
end;
|
|
end;
|
|
|
|
procedure FillHandleList(const AList: string; ADest: TIdSocketHandles);
|
|
var
|
|
LItems: TStringList;
|
|
i: integer;
|
|
LIPVersion: TIdIPVersion;
|
|
LAddr, LText: string;
|
|
LPort: integer;
|
|
LSocket: TIdSocketHandle;
|
|
begin
|
|
ADest.Clear;
|
|
LItems := TStringList.Create;
|
|
try
|
|
LItems.CommaText := AList;
|
|
for i := 0 to LItems.Count-1 do begin
|
|
if Length(LItems[i]) > 0 then begin
|
|
if TextStartsWith(LItems[i], '[') then begin
|
|
// ipv6
|
|
LIPVersion := Id_IPv6;
|
|
LText := Copy(LItems[i], 2, MaxInt);
|
|
LAddr := Fetch(LText, ']:');
|
|
LPort := StrToIntDef(LText, -1);
|
|
end else begin
|
|
// ipv4
|
|
LIPVersion := Id_IPv4;
|
|
LText := LItems[i];
|
|
LAddr := Fetch(LText, ':');
|
|
LPort := StrToIntDef(LText, -1);
|
|
//Note that 0 is legal and indicates the server binds to a random port
|
|
end;
|
|
if IsValidIP(LAddr) and (LPort > -1) and (LPort < 65536) then begin
|
|
LSocket := ADest.Add;
|
|
LSocket.IPVersion := LIPVersion;
|
|
LSocket.IP := LAddr;
|
|
LSocket.Port := LPort;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
LItems.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TIdDsnPropEdBindingVCL }
|
|
|
|
function NumericOnly(const AText : String) : String;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 1 to Length(AText) do
|
|
begin
|
|
if IsNumeric(AText[i]) then begin
|
|
Result := Result + AText[i];
|
|
end else begin
|
|
Break;
|
|
end;
|
|
end;
|
|
if Length(Result) = 0 then begin
|
|
Result := '0';
|
|
end;
|
|
end;
|
|
|
|
function IndexOfNo(const ANo : Integer; AStrings : TStrings) : Integer;
|
|
begin
|
|
for Result := 0 to AStrings.Count-1 do
|
|
begin
|
|
if ANo = IndyStrToInt(NumericOnly(AStrings[Result])) then begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function GetDisplayString(ASocketHandle: TIdSocketHandle): string;
|
|
begin
|
|
Result := '';
|
|
case ASocketHandle.IPVersion of
|
|
Id_IPv4 : Result := Format('%s:%d',[ASocketHandle.IP, ASocketHandle.Port]);
|
|
Id_IPv6 : Result := Format('[%s]:%d',[ASocketHandle.IP, ASocketHandle.Port]);
|
|
end;
|
|
end;
|
|
|
|
function GetListValues(const ASocketHandles : TIdSocketHandles) : String;
|
|
var i : Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 0 to ASocketHandles.Count -1 do begin
|
|
Result := Result + ',' + GetDisplayString(ASocketHandles[i]);
|
|
end;
|
|
Delete(Result,1,1);
|
|
end;
|
|
|
|
constructor TIdDsnPropEdBindingVCL.Create(AOwner: TComponent);
|
|
var
|
|
i : Integer;
|
|
LLocalAddresses: TIdStackLocalAddressList;
|
|
begin
|
|
inherited CreateNew(AOwner, 0);
|
|
{$IFNDEF WIDGET_KYLIX}
|
|
Borderstyle := bsDialog;
|
|
{$ENDIF}
|
|
BorderIcons := [biSystemMenu];
|
|
// Width := 480;
|
|
// Height := 252;
|
|
ClientWidth := 472;
|
|
{$IFDEF USE_TBitBtn}
|
|
ClientHeight := 230;
|
|
{$ELSE}
|
|
ClientHeight := 225;
|
|
{$ENDIF}
|
|
Constraints.MaxWidth := Width;
|
|
Constraints.MaxHeight := Height;
|
|
Constraints.MinWidth := Width;
|
|
Constraints.MinHeight := Height;
|
|
Position := poScreenCenter;
|
|
lblBindings := TLabel.Create(Self);
|
|
lbBindings := TListBox.Create(Self);
|
|
ActionList1 := TActionList.Create(Self);
|
|
btnBindingsNew := TAction.Create(Self);
|
|
btnBindingsDelete := TAction.Create(Self);
|
|
btnNew := TButton.Create(Self);
|
|
btnDelete := TButton.Create(Self);
|
|
lblIPAddress := TLabel.Create(Self);
|
|
edtIPAddress := TComboBox.Create(Self);
|
|
lblPort := TLabel.Create(Self);
|
|
|
|
edtPort := TComboBox.Create(Self);
|
|
rdoBindingType := TRadioGroup.Create(Self);
|
|
|
|
{$IFDEF USE_TBitBtn}
|
|
btnOk := TBitBtn.Create(Self);
|
|
btnCancel := TBitBtn.Create(Self);
|
|
{$ELSE}
|
|
btnOk := TButton.Create(Self);
|
|
btnCancel := TButton.Create(Self);
|
|
{$ENDIF}
|
|
|
|
lblBindings.Name := 'lblBindings'; {do not localize}
|
|
lblBindings.Parent := Self;
|
|
lblBindings.Left := 8;
|
|
lblBindings.Top := 8;
|
|
lblBindings.Width := 35;
|
|
lblBindings.Height := 13;
|
|
lblBindings.Caption := '&Binding'; {do not localize}
|
|
|
|
lbBindings.Name := 'lbBindings'; {do not localize}
|
|
lbBindings.Parent := Self;
|
|
lbBindings.Left := 8;
|
|
lbBindings.Top := 24;
|
|
lbBindings.Width := 137;
|
|
lbBindings.Height := 161;
|
|
lbBindings.ItemHeight := 13;
|
|
lbBindings.TabOrder := 8;
|
|
lbBindings.OnClick := lbBindingsClick;
|
|
|
|
ActionList1.Name := 'ActionList1'; {do not localize}
|
|
{
|
|
ActionList1.Left := 152;
|
|
ActionList1.Top := 32;
|
|
}
|
|
|
|
btnBindingsNew.Name := 'btnBindingsNew'; {do not localize}
|
|
btnBindingsNew.Caption := RSBindingNewCaption;
|
|
btnBindingsNew.OnExecute := btnBindingsNewExecute;
|
|
|
|
btnBindingsDelete.Name := 'btnBindingsDelete'; {do not localize}
|
|
btnBindingsDelete.Caption := RSBindingDeleteCaption;
|
|
btnBindingsDelete.OnExecute := btnBindingsDeleteExecute;
|
|
btnBindingsDelete.OnUpdate := btnBindingsDeleteUpdate;
|
|
|
|
btnNew.Name := 'btnNew'; {do not localize}
|
|
btnNew.Parent := Self;
|
|
btnNew.Left := 152;
|
|
btnNew.Top := 72;
|
|
btnNew.Width := 75;
|
|
btnNew.Height := 25;
|
|
btnNew.Action := btnBindingsNew;
|
|
btnNew.TabOrder := 6;
|
|
|
|
btnDelete.Name := 'btnDelete'; {do not localize}
|
|
btnDelete.Parent := Self;
|
|
btnDelete.Left := 152;
|
|
btnDelete.Top := 104;
|
|
btnDelete.Width := 75;
|
|
btnDelete.Height := 25;
|
|
btnDelete.Action := btnBindingsDelete;
|
|
btnDelete.TabOrder := 7;
|
|
|
|
lblIPAddress.Name := 'lblIPAddress'; {do not localize}
|
|
lblIPAddress.Parent := Self;
|
|
lblIPAddress.Left := 240;
|
|
lblIPAddress.Top := 8;
|
|
lblIPAddress.Width := 54;
|
|
lblIPAddress.Height := 13;
|
|
lblIPAddress.Caption := RSBindingHostnameLabel;
|
|
lblIPAddress.Enabled := False;
|
|
|
|
edtIPAddress.Name := 'edtIPAddress'; {do not localize}
|
|
edtIPAddress.Parent := Self;
|
|
edtIPAddress.Left := 240;
|
|
edtIPAddress.Top := 24;
|
|
edtIPAddress.Width := 221;
|
|
edtIPAddress.Height := 21;
|
|
edtIPAddress.Enabled := False;
|
|
edtIPAddress.ItemHeight := 13;
|
|
edtIPAddress.TabOrder := 3;
|
|
edtIPAddress.OnChange := edtIPAddressChange;
|
|
|
|
lblPort.Name := 'lblPort'; {do not localize}
|
|
lblPort.Parent := Self;
|
|
lblPort.Left := 240;
|
|
lblPort.Top := 56;
|
|
lblPort.Width := 22;
|
|
lblPort.Height := 13;
|
|
lblPort.Caption := RSBindingPortLabel;
|
|
lblPort.Enabled := False;
|
|
lblPort.FocusControl := edtPort;
|
|
|
|
edtPort.Name := 'edtPort'; {do not localize}
|
|
edtPort.Parent := Self;
|
|
edtPort.Left := 240;
|
|
edtPort.Top := 72;
|
|
edtPort.Width := 221;
|
|
edtPort.Height := 21;
|
|
edtPort.Enabled := False;
|
|
edtPort.ItemHeight := 13;
|
|
edtPort.TabOrder := 4;
|
|
edtPort.OnChange := edtPortChange;
|
|
edtPort.OnKeyPress := edtPortKeyPress;
|
|
|
|
rdoBindingType.Name := 'rdoBindingType'; {do not localize}
|
|
rdoBindingType.Parent := Self;
|
|
rdoBindingType.Left := 240;
|
|
rdoBindingType.Top := 120;
|
|
rdoBindingType.Width := 221;
|
|
rdoBindingType.Height := 65;
|
|
rdoBindingType.Caption := RSBindingIPVerLabel;
|
|
rdoBindingType.Enabled := False;
|
|
rdoBindingType.Items.Add(RSBindingIPV4Item);
|
|
rdoBindingType.Items.Add(RSBindingIPV6Item);
|
|
rdoBindingType.TabOrder := 5;
|
|
rdoBindingType.OnClick := rdoBindingTypeClick;
|
|
|
|
btnOk.Name := 'btnOk'; {do not localize}
|
|
btnOk.Parent := Self;
|
|
btnOk.Anchors := [akRight, akBottom];
|
|
btnOk.Left := 306;
|
|
btnOk.Top := 193;
|
|
btnOk.Width := 75;
|
|
{$IFDEF USE_TBitBtn}
|
|
btnOk.Height := 30;
|
|
btnOk.Kind := bkOk;
|
|
{$ELSE}
|
|
btnOk.Height := 25;
|
|
btnOk.Caption := RSOk;
|
|
btnOk.Default := True;
|
|
btnOk.ModalResult := 1;
|
|
{$ENDIF}
|
|
btnOk.TabOrder := 0;
|
|
|
|
btnCancel.Name := 'btnCancel'; {do not localize}
|
|
btnCancel.Parent := Self;
|
|
btnCancel.Anchors := [akRight, akBottom];
|
|
btnCancel.Left := 386;
|
|
btnCancel.Top := 193;
|
|
btnCancel.Width := 75;
|
|
{$IFDEF USE_TBitBtn}
|
|
btnCancel.Height := 30;
|
|
btnCancel.Kind := bkCancel;
|
|
{$ELSE}
|
|
btnCancel.Height := 25;
|
|
btnCancel.Cancel := True;
|
|
btnCancel.Caption := RSCancel;
|
|
btnCancel.ModalResult := 2;
|
|
{$ENDIF}
|
|
btnCancel.Anchors := [akRight, akBottom];
|
|
btnCancel.TabOrder := 1;
|
|
|
|
FHandles := TIdSocketHandles.Create(nil);
|
|
FIPv4Addresses := TStringList.Create;
|
|
FIPv6Addresses := TStringList.Create;
|
|
SetIPv4Addresses(nil);
|
|
SetIPv6Addresses(nil);
|
|
|
|
TIdStack.IncUsage;
|
|
try
|
|
LLocalAddresses := TIdStackLocalAddressList.Create;
|
|
try
|
|
GStack.GetLocalAddressList(LLocalAddresses);
|
|
for i := 0 to LLocalAddresses.Count-1 do
|
|
begin
|
|
case LLocalAddresses[i].IPVersion of
|
|
Id_IPv4: FIPv4Addresses.Add(LLocalAddresses[i].IPAddress);
|
|
Id_IPv6: FIPv6Addresses.Add(LLocalAddresses[i].IPAddress);
|
|
end;
|
|
end;
|
|
finally
|
|
LLocalAddresses.Free;
|
|
end;
|
|
finally
|
|
TIdStack.DecUsage;
|
|
end;
|
|
|
|
edtPort.Items.BeginUpdate;
|
|
try
|
|
edtPort.Items.Add(PortDescription(0));
|
|
for i := 0 to IdPorts.Count - 1 do begin
|
|
edtPort.Items.Add(
|
|
PortDescription(
|
|
{$IFDEF HAS_GENERICS_TList}
|
|
IdPorts[i]
|
|
{$ELSE}
|
|
PtrInt(IdPorts[i])
|
|
{$ENDIF}
|
|
)
|
|
);
|
|
end;
|
|
finally
|
|
edtPort.Items.EndUpdate;
|
|
end;
|
|
|
|
AutoScroll := False;
|
|
Caption := RSBindingFormCaption;
|
|
{$IFDEF WIDGET_VCL}
|
|
Scaled := False;
|
|
{$ENDIF}
|
|
Font.Color := clBtnText;
|
|
Font.Height := -11;
|
|
Font.Name := 'MS Sans Serif'; {Do not Localize}
|
|
Font.Style := [];
|
|
Position := poScreenCenter;
|
|
PixelsPerInch := 96;
|
|
FInUpdateRoutine := False;
|
|
UpdateEditControls;
|
|
end;
|
|
|
|
destructor TIdDsnPropEdBindingVCL.Destroy;
|
|
begin
|
|
FreeAndNil(FIPv4Addresses);
|
|
FreeAndNil(FIPv6Addresses);
|
|
FreeAndNil(FHandles);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TIdDsnPropEdBindingVCL.PortDescription(const PortNumber: integer): string;
|
|
var
|
|
LList: TStringList;
|
|
begin
|
|
if PortNumber = 0 then begin
|
|
Result := IndyFormat('%d: %s', [PortNumber, RSBindingAny]);
|
|
end else begin
|
|
Result := ''; {Do not Localize}
|
|
LList := TStringList.Create;
|
|
try
|
|
GBSDStack.AddServByPortToList(PortNumber, LList);
|
|
if LList.Count > 0 then begin
|
|
Result := Format('%d: %s', [PortNumber, LList.CommaText]); {Do not Localize}
|
|
end;
|
|
finally
|
|
LList.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.SetHandles(const Value: TIdSocketHandles);
|
|
begin
|
|
FHandles.Assign(Value);
|
|
UpdateBindingList;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.btnBindingsNewExecute(Sender: TObject);
|
|
begin
|
|
FCurrentHandle := FHandles.Add;
|
|
FCurrentHandle.IP := IPv4Wildcard;
|
|
FCurrentHandle.Port := FDefaultPort;
|
|
UpdateBindingList;
|
|
edtIPAddress.Items.Assign(FIPv4Addresses);
|
|
UpdateEditControls;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.UpdateEditControls;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
if Assigned(FCurrentHandle) then
|
|
begin
|
|
i := IndexOfNo(FCurrentHandle.Port,edtPort.Items);
|
|
if i = -1 then begin
|
|
edtPort.Text := IntToStr(FCurrentHandle.Port);
|
|
end else begin
|
|
edtPort.ItemIndex := i;
|
|
end;
|
|
|
|
case FCurrentHandle.IPVersion of
|
|
Id_IPv4 :
|
|
begin
|
|
rdoBindingType.ItemIndex := 0;
|
|
edtIPAddress.Items.Assign(FIPv4Addresses);
|
|
end;
|
|
Id_IPv6 :
|
|
begin
|
|
rdoBindingType.ItemIndex := 1;
|
|
edtIPAddress.Items.Assign(FIPv6Addresses);
|
|
end;
|
|
end;
|
|
if edtIPAddress.Style = csDropDown then begin
|
|
edtIPAddress.Text := FCurrentHandle.IP;
|
|
end else begin
|
|
edtIPAddress.ItemIndex := edtIPAddress.Items.IndexOf(FCurrentHandle.IP);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
edtIPAddress.Text := '';
|
|
//in LCL, the line below caused an index out of range error.
|
|
{$IFDEF WIDGET_VCL}
|
|
edtPort.ItemIndex := -1; //-2;
|
|
{$ENDIF}
|
|
edtPort.Text := '';
|
|
end;
|
|
|
|
lblIPAddress.Enabled := Assigned(FCurrentHandle);
|
|
edtIPAddress.Enabled := Assigned(FCurrentHandle);
|
|
lblPort.Enabled := Assigned(FCurrentHandle);
|
|
edtPort.Enabled := Assigned(FCurrentHandle);
|
|
rdoBindingType.Enabled := Assigned(FCurrentHandle);
|
|
{$IFDEF WIDGET_KYLIX}
|
|
//WOrkaround for CLX quirk that might be Kylix 1
|
|
for i := 0 to rdoBindingType.ControlCount -1 do begin
|
|
rdoBindingType.Controls[i].Enabled := Assigned(FCurrentHandle);
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF WIDGET_VCL_LIKE}
|
|
//The Win32 VCL does not change the control background to a greyed look
|
|
//when controls are disabled. This quirk is not present in CLX.
|
|
if Assigned(FCurrentHandle) then
|
|
begin
|
|
edtIPAddress.Color := clWindow;
|
|
edtPort.Color := clWindow;
|
|
end else
|
|
begin
|
|
edtIPAddress.Color := clBtnFace;
|
|
edtPort.Color := clBtnFace;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.btnBindingsDeleteExecute(Sender: TObject);
|
|
var
|
|
LSH : TIdSocketHandle;
|
|
begin
|
|
if lbBindings.ItemIndex >= 0 then
|
|
begin
|
|
// Delete is not available in D4's collection classes
|
|
// This should work just as well.
|
|
LSH := Handles[lbBindings.ItemIndex];
|
|
FreeAndNil(LSH);
|
|
FCurrentHandle := nil;
|
|
UpdateBindingList;
|
|
end;
|
|
lbBindingsClick(nil);
|
|
UpdateEditControls;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.btnBindingsDeleteUpdate(Sender: TObject);
|
|
begin
|
|
btnBindingsDelete.Enabled := lbBindings.ItemIndex >= 0;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.SetIPv4Addresses(const Value: TStrings);
|
|
begin
|
|
if Assigned(Value) then begin
|
|
FIPv4Addresses.Assign(Value);
|
|
end;
|
|
// Ensure that these two are always present
|
|
if FIPv4Addresses.IndexOf(IPv6Loopback) = -1 then begin
|
|
FIPv4Addresses.Insert(0, IPv4Loopback);
|
|
end;
|
|
if FIPv4Addresses.IndexOf(IPv4Wildcard) = -1 then begin
|
|
FIPv4Addresses.Insert(0, IPv4Wildcard);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.SetIPv6Addresses(const Value: TStrings);
|
|
begin
|
|
if Assigned(Value) then begin
|
|
FIPv6Addresses.Assign(Value);
|
|
end;
|
|
// Ensure that these two are always present
|
|
if FIPv6Addresses.IndexOf(IPv6Loopback) = -1 then begin
|
|
FIPv6Addresses.Insert(0, IPv6Loopback);
|
|
end;
|
|
if FIPv6Addresses.IndexOf(IPv6Wildcard1) = -1 then begin
|
|
FIPv6Addresses.Insert(0, IPv6Wildcard1);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.edtPortKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
// RLebeau 1/7/09: using Char() for #128-#255 because in D2009, the compiler
|
|
// may change characters >= #128 from their Ansi codepage value to their true
|
|
// Unicode codepoint value, depending on the codepage used for the source code.
|
|
// For instance, #128 may become #$20AC...
|
|
|
|
if (Key > Chr(31)) and (Key < Chr(128)) then begin
|
|
if not IsNumeric(Key) then begin
|
|
Key := #0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.edtIPAddressChange(Sender: TObject);
|
|
begin
|
|
FCurrentHandle.IP := edtIPAddress.Text;
|
|
UpdateBindingList;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.edtPortChange(Sender: TObject);
|
|
begin
|
|
if Assigned(FCurrentHandle) then begin
|
|
FCurrentHandle.Port := IndyStrToInt(NumericOnly(edtPort.Text), 0);
|
|
end;
|
|
UpdateBindingList;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.rdoBindingTypeClick(Sender: TObject);
|
|
begin
|
|
case rdoBindingType.ItemIndex of
|
|
0 :
|
|
begin
|
|
if FCurrentHandle.IPVersion <> Id_IPv4 then
|
|
begin
|
|
FCurrentHandle.IPVersion := Id_IPv4;
|
|
edtIPAddress.Items.Assign(FIPv4Addresses);
|
|
FCurrentHandle.IP := IPv4Wildcard;
|
|
end;
|
|
end;
|
|
1 :
|
|
begin
|
|
if FCurrentHandle.IPVersion <> Id_IPv6 then
|
|
begin
|
|
FCurrentHandle.IPVersion := Id_IPv6;
|
|
edtIPAddress.Items.Assign(FIPv6Addresses);
|
|
FCurrentHandle.IP := IPv6Wildcard1;
|
|
end;
|
|
end;
|
|
end;
|
|
UpdateEditControls;
|
|
UpdateBindingList;
|
|
end;
|
|
|
|
function TIdDsnPropEdBindingVCL.GetList: string;
|
|
begin
|
|
Result := GetListValues(Handles);
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.lbBindingsClick(Sender: TObject);
|
|
begin
|
|
if lbBindings.ItemIndex >= 0 then begin
|
|
FCurrentHandle := FHandles[lbBindings.ItemIndex];
|
|
end else begin
|
|
FCurrentHandle := nil;
|
|
end;
|
|
UpdateEditControls;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.SetList(const AList: string);
|
|
begin
|
|
FCurrentHandle := nil;
|
|
FillHandleList(AList, Handles);
|
|
UpdateBindingList;
|
|
UpdateEditControls;
|
|
end;
|
|
|
|
procedure TIdDsnPropEdBindingVCL.UpdateBindingList;
|
|
var
|
|
i: integer;
|
|
selected: integer;
|
|
s: string;
|
|
begin
|
|
//in Lazarus, for some odd reason, if you have more than one binding,
|
|
//the routine is called while the items are updated
|
|
if FInUpdateRoutine then begin
|
|
Exit;
|
|
end;
|
|
FInUpdateRoutine := True;
|
|
try
|
|
selected := lbBindings.ItemIndex;
|
|
lbBindings.Items.BeginUpdate;
|
|
try
|
|
if lbBindings.Items.Count = FHandles.Count then begin
|
|
for i := 0 to FHandles.Count - 1 do begin
|
|
s := GetDisplayString(FHandles[i]);
|
|
if s <> lbBindings.Items[i] then begin
|
|
lbBindings.Items[i] := s;
|
|
end;
|
|
end;
|
|
end else begin
|
|
lbBindings.Items.Clear;
|
|
for i := 0 to FHandles.Count-1 do begin
|
|
lbBindings.Items.Add(GetDisplayString(FHandles[i]));
|
|
end;
|
|
end;
|
|
finally
|
|
lbBindings.Items.EndUpdate;
|
|
if Assigned(FCurrentHandle) then begin
|
|
lbBindings.ItemIndex := FCurrentHandle.Index;
|
|
end else begin
|
|
lbBindings.ItemIndex := IndyMin(selected, lbBindings.Items.Count-1);
|
|
end;
|
|
end;
|
|
finally
|
|
FInUpdateRoutine := False;
|
|
end;
|
|
end;
|
|
|
|
function TIdDsnPropEdBindingVCL.Execute: Boolean;
|
|
begin
|
|
Result := ShowModal = mrOk;
|
|
end;
|
|
|
|
constructor TIdDsnPropEdBindingVCL.Create;
|
|
begin
|
|
Create(nil);
|
|
end;
|
|
|
|
end.
|