iddsnpropedbinding.pas

网络控件适用于Delphi6

    ItemHeight := 13;
    TabOrder := 3;
    OnChange := edtIPAddressChange;
  end;
  with lblPort do
  begin
    Name := 'lblPort';  {do not localize}
    Parent := Self;
    Left := 240;
    Top := 56;
    Width := 22;
    Height := 13;
    Caption := RSBindingPortLabel;
    Enabled := False;
    FocusControl := edtPort;
  end;
  with edtPort do
  begin
    Name := 'edtPort';  {do not localize}
    Parent := Self;
    Left := 240;
    Top := 72;
    Width := 221;
    Height := 21;
    Enabled := False;
    {$IFNDEF DOTNET}
    ItemHeight := 13;
    {$ENDIF}
    TabOrder := 4;
    OnChange := edtPortChange;
    OnKeyPress := edtPortKeyPress;
  end;
  with rdoBindingType do
  begin
    Name := 'rdoBindingType'; {do not localize}
    Parent := Self;
    Left := 240;
    Top := 120;
    Width := 221;
    Height := 65;
    Caption := RSBindingIPVerLabel;
    Enabled := False;
    Items.Add(RSBindingIPV4Item);
    Items.Add(RSBindingIPV6Item);
    TabOrder := 5;
    OnClick := rdoBindingTypeClick;
  end;
  with btnOk do
  begin
    Name := 'btnOk';  {do not localize}
    Parent := Self;
    Left := 306;
    Top := 193;
    Width := 75;
    Height := 25;
    Anchors := [akRight, akBottom];
    Caption := RSOk;
    Default := True;
    ModalResult := 1;
    TabOrder := 0;
  end;
  with btnCancel do
  begin
    Name := 'btnCancel';  {do not localize}
    Parent := Self;
    Left := 386;
    Top := 193;
    Width := 75;
    Height := 25;
    Anchors := [akRight, akBottom];
    Cancel := True;
    Caption := RSCancel;
    ModalResult := 2;
    TabOrder := 1;
  end;
  FHandles := TIdSocketHandles.Create(nil);
  FIPv4Addresses := TIdStringList.Create;
  FIPv6Addresses := TIdStringList.Create;
  SetIPv4Addresses(nil);
  SetIPv6Addresses(nil);

  if Assigned(GStack) then begin
    fCreatedStack := False;
  end else begin
    TIdStack.Make;
    fCreatedStack := True;
  end;
  IPv4Addresses := GStack.LocalAddresses;
  {$IFNDEF DOTNET}
  try
    edtPort.Items.Add(PortDescription(0));
    edtPort.Items.BeginUpdate;
    for i := 0 to IdPorts.Count - 1 do
    begin
      edtPort.Items.Add(PortDescription(Integer(IdPorts[i])));
    end;
  finally
    edtPort.Items.EndUpdate;
  end;
  {$ENDIF}
  AutoScroll := False;
  Caption := RSBindingFormCaption;
  Scaled := False;
  Font.Color := clBtnText;
  Font.Height := -11;
  Font.Name := 'MS Sans Serif';    {Do not Localize}
  Font.Style := [];
  Position := poScreenCenter;
  PixelsPerInch := 96;
  UpdateEditControls;
end;

destructor TIdPropEdBindingEntry.Destroy;
begin
  FreeAndNil(FIPv4Addresses);
  FreeAndNil(FIPv6Addresses);
  FreeAndNil(FHandles);
  if fCreatedStack then
  begin
    FreeAndNil(GStack);
  end;
  inherited;
end;

function TIdPropEdBindingEntry.PortDescription(
  const PortNumber: integer): string;

begin
  {$IFDEF DOTNET}
    Result := IntToStr(PortNumber);
  {$ELSE}
  with GBSDStack.WSGetServByPort(PortNumber) do try
    if PortNumber = 0 then
    begin
      Result := Format('%d: %s', [PortNumber, RSBindingAny]);
    end
    else
    begin
      Result := '';    {Do not Localize}
      if Count > 0 then begin
        Result := Format('%d: %s', [PortNumber, CommaText]);    {Do not Localize}
      end;
    end;
  finally
    Free;
  end;
  {$ENDIF}
end;

procedure TIdPropEdBindingEntry.SetHandles(const Value: TIdSocketHandles);
begin
  FHandles.Assign(Value);
  UpdateBindingList;
end;

procedure TIdPropEdBindingEntry.btnBindingsNewExecute(Sender: TObject);
begin
  FCurrentHandle := FHandles.Add;
  FCurrentHandle.IP := IPv4Wildcard;
  FCurrentHandle.Port := FDefaultPort;
  UpdateBindingList;
  edtIPAddress.Items.Assign(FIPv4Addresses);
  UpdateEditControls;
end;

procedure TIdPropEdBindingEntry.UpdateEditControls;
var i : Integer;
begin
  if Assigned(FCurrentHandle) then
  begin
    {$IFNDEF DOTNET}
    i := IndexOfNo(FCurrentHandle.Port,edtPort.Items);
    if i = -1 then
    begin
      edtPort.Text := IntToStr(FCurrentHandle.Port);
    end
    else
    begin
      edtPort.ItemIndex := i;
    end;
    {$ELSE}
    edtPort.Text := IntToStr(FCurrentHandle.Port);
    {$ENDIF}
    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;
    edtIPAddress.ItemIndex := edtIPAddress.Items.IndexOf(FCurrentHandle.IP);
  end
  else
  begin
    edtIPAddress.Text := '';
    {$IFNDEF DOTNET}
    edtPort.ItemIndex := -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 LINUX}
  //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}
  {$IFNDEF LINUX}
  //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 TIdPropEdBindingEntry.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 TIdPropEdBindingEntry.btnBindingsDeleteUpdate(Sender: TObject);
begin
  btnBindingsDelete.Enabled := lbBindings.ItemIndex >= 0;
end;

procedure TIdPropEdBindingEntry.SetIPv4Addresses(const Value: TIdStrings);
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 TIdPropEdBindingEntry.SetIPv6Addresses(const Value: TIdStrings);
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 TIdPropEdBindingEntry.edtPortKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key > #31) and (Key <  #128) then
    if not IsNumeric(Key) then    {Do not Localize}
    begin
      Key := #0;
    end;
end;

procedure TIdPropEdBindingEntry.edtIPAddressChange(Sender: TObject);
begin
  FCurrentHandle.IP := edtIPAddress.Text;
  UpdateBindingList;
end;

procedure TIdPropEdBindingEntry.edtPortChange(Sender: TObject);
begin
  if Assigned(FCurrentHandle) then
  begin
  FCurrentHandle.Port := StrToIntDef(NumericOnly(edtPort.Text),0);
  end;
  UpdateBindingList;
end;

procedure TIdPropEdBindingEntry.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 TIdPropEdBindingEntry.GetList: string;
begin
  Result := GetListValues(Handles);
end;

procedure TIdPropEdBindingEntry.lbBindingsClick(Sender: TObject);
begin
  if lbBindings.ItemIndex >= 0 then begin
    FCurrentHandle := FHandles[lbBindings.ItemIndex];
  end else begin
    FCurrentHandle := nil;
  end;
  UpdateEditControls;
end;

procedure TIdPropEdBindingEntry.SetList(const AList: string);
begin
  FCurrentHandle := nil;
  FillHandleList(AList, Handles);
  UpdateBindingList;
  UpdateEditControls;
end;

procedure TIdPropEdBindingEntry.UpdateBindingList;
var
  i: integer;
  selected: integer;
  s: string;
begin
  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].IP, FHandles[i].Port, FHandles[i].IPVersion);
        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].IP, FHandles[i].Port,FHandles[i].IPVersion));
      end;
    end;
  finally
    lbBindings.Items.EndUpdate;
    if Assigned(FCurrentHandle) then begin
      lbBindings.ItemIndex := FCurrentHandle.Index;
    end else begin
      lbBindings.ItemIndex := Min(selected, lbBindings.Items.Count-1);
    end;
  end;
end;

end.