restemplate/indy/Core/IdDsnPropEdBindingVCL.pas

{
  $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.