iddsnpropedbinding.pas

网络控件适用于Delphi6

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11934: IdDsnPropEdBinding.pas
{
{   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 IdDsnPropEdBinding;

interface
 {$I IdCompilerDefines.inc}
uses
  IdTStrings,
  {$IFDEF LINUX}
  Classes, IdSocketHandle, QActnList, QStdCtrls, QForms, QExtCtrls, QControls, QComCtrls, QGraphics, Qt, Types;
  {$ELSE}
  ActnList, Classes,  Controls,
  ExtCtrls, Forms, Graphics, IdSocketHandle,

  StdCtrls;
  {$ENDIF}

{
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 eligant
manner than what I described.
}
type
  TIdPropEdBindingEntry = class(TForm)
    btnOk: TButton;
    btnCancel: TButton;
    lblBindings: TLabel;
    {$IFNDEF DOTNET}
    edtPort: TComboBox;
    {$ELSE}
    edtPort : TEdit;
    {$ENDIF}
    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: TIdStrings);
    procedure SetIPv6Addresses(const Value: TIdStrings);
    procedure UpdateBindingList;
  protected
    FHandles : TIdSocketHandles;
    FDefaultPort : Integer;
    FIPv4Addresses : TIdStrings;
    FIPv6Addresses : TIdStrings;
    fCreatedStack : Boolean;
    FCurrentHandle : TIdSocketHandle;
    procedure UpdateEditControls;
    function PortDescription(const PortNumber: integer): string;
  public
    Constructor Create(AOwner : TComponent);  override;
    Destructor Destroy; override;
    function GetList: string;
    procedure SetList(const AList: string);
    property Handles : TIdSocketHandles read FHandles write SetHandles;
    property DefaultPort : Integer read FDefaultPort write FDefaultPort;
    property IPv4Addresses : TIdStrings read FIPv4Addresses write SetIPv4Addresses;
    property IPv6Addresses : TIdStrings read FIPv6Addresses write SetIPv6Addresses;
  end;

var
  IdPropEdBindingEntry: TIdPropEdBindingEntry;

procedure FillHandleList(const AList: string; ADest: TIdSocketHandles);
function GetListValues(const ASocketHandles : TIdSocketHandles) : String;

implementation

uses
  IdGlobal,
  IdIPAddress,
  IdDsnCoreResourceStrings, IdStack,
    {$IFNDEF DOTNET}
  IdStackBSDBase,
  {$ENDIF}
   SysUtils;

const
  IPv6Wildcard1 = '::';                 {do not localize}
  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: TIdStringList;
  i: integer;
  LIPVersion: TIdIPVersion;
  LAddr, LText: string;
  LPort: integer;
begin
  ADest.Clear;
  LItems := TIdStringList.Create;
  try
    LItems.CommaText := AList;
    for i := 0 to LItems.Count-1 do begin
      if Length(LItems[i]) > 0 then begin
        if LItems[i][1] = '[' 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
          with ADest.Add do begin
            IPVersion := LIPVersion;
            IP := LAddr;
            Port := LPort;
          end;
        end;
      end;
    end;
  finally
    LItems.Free;
  end;
end;

{ TIdPropEdBindingEntry }

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 : TIdStrings) : Integer;
begin
  for Result := 0 to AStrings.Count -1 do
  begin
    if ANo = StrToInt( NumericOnly(AStrings[Result])) then
    begin
      Exit;
    end;
  end;
  Result := -1;
end;

function GetDisplayString(const AIP : String; const APort : Integer; AIPVer : TIdIPVersion): string;
begin
  Result := '';
  case AIPVer of
      Id_IPv4 : Result := Format('%s:%d',[AIP,APort]);
      Id_IPv6 : Result := Format('[%s]:%d',[AIP,APort]);
  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].IP,ASocketHandles[i].Port,ASocketHandles[i].IPVersion );
  end;
  Delete(Result,1,1);
end;

constructor TIdPropEdBindingEntry.Create(AOwner: TComponent);
{$IFNDEF DOTNET}
var i : Integer;
{$ENDIF}
begin
  inherited CreateNew(AOwner);
  {$IFNDEF LINUX}
  Borderstyle := bsDialog;
  {$ENDIF}
  BorderIcons := [biSystemMenu];
 // Width := 480;
 // Height := 252;
  ClientWidth  := 472;
  ClientHeight := 225;
  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);
  {$IFNDEF DOTNET}
  edtPort := TComboBox.Create(Self);
  {$ELSE}
  edtPort := TEdit.Create(Self);
  {$ENDIF}
  rdoBindingType := TRadioGroup.Create(Self);
  btnOk := TButton.Create(Self);
  btnCancel := TButton.Create(Self);
  with lblBindings do
  begin
    Name := 'lblBindings';  {do not localize}
    Parent := Self;
    Left := 8;
    Top := 8;
    Width := 35;
    Height := 13;
    Caption := '&Binding';  {do not localize}
  end;
  with lbBindings do
  begin
    Name := 'lbBindings';   {do not localize}
    Parent := Self;
    Left := 8;
    Top := 24;
    Width := 137;
    Height := 161;
    ItemHeight := 13;
    TabOrder := 8;
    OnClick := lbBindingsClick;
  end;
  with ActionList1 do
  begin
    Name := 'ActionList1';  {do not localize}
    Left := 152;
    Top := 32;
  end;
  with btnBindingsNew do
  begin
    Name := 'btnBindingsNew'; {do not localize}
    Caption := RSBindingNewCaption;
    OnExecute := btnBindingsNewExecute;
  end;
  with btnBindingsDelete do
  begin
    Name := 'btnBindingsDelete';  {do not localize}
    Caption := RSBindingDeleteCaption;
    OnExecute := btnBindingsDeleteExecute;
    OnUpdate := btnBindingsDeleteUpdate;
  end;
  with btnNew do
  begin
    Name := 'btnNew'; {do not localize}
    Parent := Self;
    Left := 152;
    Top := 72;
    Width := 75;
    Height := 25;
    Action := btnBindingsNew;
    TabOrder := 6;
  end;
  with btnDelete do
  begin
    Name := 'btnDelete';  {do not localize}
    Parent := Self;
    Left := 152;
    Top := 104;
    Width := 75;
    Height := 25;
    Action := btnBindingsDelete;
    TabOrder := 7;
  end;
  with lblIPAddress do
  begin
    Name := 'lblIPAddress'; {do not localize}
    Parent := Self;
    Left := 240;
    Top := 8;
    Width := 54;
    Height := 13;
    Caption := RSBindingHostnameLabel;
    Enabled := False;
  end;
  with edtIPAddress do
  begin
    Name := 'edtIPAddress'; {do not localize}
    Parent := Self;
    Left := 240;
    Top := 24;
    Width := 221;
    Height := 21;
    Style := csDropDownList;
    Enabled := False;