delphi - 求源码 IPv4地址选择器VCL组件

Question

严格用于保留地址范围，因此 IPv4 足够好。我还不知道我是否会使用 A、B 或 C 类(可能是 C，但是......)所以能够处理所有问题将是一种奖励。

如果我还可以输入诸如“localhost”之类的内容，还有额外的奖励，尽管我可以没有它。

因此，最低要求是指定 192.xxx.xxx.xxx 并确保 xxx 不超过 255。

当然，我可以通过一些蒙版编辑来敲定一个，但肯定有人以前发明过那个特定的 (FOSS) 轮？

---

自言自语:如果您确实必须对其进行编码，this page看起来很有用

Answer 1

Windows 有一个内置的 IP Address edit control .您可以将其包装在自定义 TWinControl 后代组件中，以便于访问和重用，例如:

type
  TIPAddressFieldChange = procedure(Sender: TObject; Field: Integer; Value: Integer) of object;

  TIPAddress = class(TWinControl)
  private
    FOnFieldChange: TIPAddressFieldChange;
    function GetIP: String; 
    function GetIsEmpty: Boolean; 
    procedure SetIP(const Value: String);    
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE; 
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
  public
    constructor Create(Owner: TComponent); override; 
    procedure Clear;
    property IP: String read GetIP write SetIP; 
    property IsEmpty: Boolean read GetIsEmpty; 
  published:
    property OnFieldChange: TIPAddressFieldChange read FOnFieldChange write FOnFieldChange;
  end; 

.

uses
  Commctrl;

constructor TIPAddress.Create(Owner: TComponent);
begin
  inherited;
  InitCommonControl(ICC_INTERNET_CLASSES}; 
end;

procedure TIPAddress.CreateParams(var Params: TCreateParams);
begin
  inherited;
  CreateSubClass(Params, WC_IPADDRESS); 
  Params.Style := WS_CHILD or WS_TABSTOP or WS_VISIBLE; 
  if NewStyleControls and Ctl3D then
  begin 
    Params.Style := Params.Style and not WS_BORDER; 
    Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; 
  end;
  Params.WindowClass.style := Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); 
end;

procedure TIPAddress.Clear;
begin
  Perform(IPM_CLEARADDRESS, 0, 0);
end;

function TIPAddress.GetIP: String;
var
  dwIp: DWORD; 
begin
  dwIp := 0; 
  Perform(IPM_GETADDRESS, 0, LPARAM(@dwIp)); 
  Result := Format('%d.%d.%d.%d', [FIRST_IPADDRESS(dwIp), SECOND_IPADDRESS(dwIp), 
THIRD_IPADDRESS(dwIp), FOURTH_IPADDRESS(dwIp)]); 
end;

function TIPAddress.GetIsEmpty: Boolean;
begin
  Result := Perform(IPM_ISBLANK, 0, 0) <> 0; 
end;

procedure TIPAddress.SetIP(const Value: String);
var
  dwIP: LPARAM;
begin
  with TStringList.Create do try
    Delimiter := '.';
    StrictDelimiter := True;
    DelimitedText := Value;
    Assert(Count = 4);
    dwIP := MAKEIPADDRESS(StrToInt(Strings[0]), StrToInt(Strings[1]), StrToInt(Strings[2]), StrToInt(Strings[3]));
  finally
    Free;
  end;
  Perform(IPM_SETADDRESS, 0, dwIP);
end;

procedure TIPAddress.CNNotify(var Message: TWMNotify);
begin
  inherited;
  if (Message.NMHdr^.code = IPN_FIELDCHANGED) and Assigned(FOnFieldChange) then
  begin
    with PNMIPAddress(Message.NMHdr)^ do
      FOnFieldChange(Self, iField, iValue);
  end;
end;

procedure TIPAddress.WMGetDlgCode(var Message: TMessage);
begin
  inherited; 
  Message.Result := Message.Result or DLGC_WANTARROWS; 
end;

procedure TIPAddress.WMSetFont(var Message: TWMSetFont); 
var 
  LF: LOGFONT; 
begin 
  if GetObject(Message.Font, SizeOf(LF), @LF) <> 0 then
  begin 
    Message.Font := CreateFontIndirect(LF); 
    inherited; 
  end; 
end;