谁有DELPHI的IP地址的控件？(50分)

我现在需要一个可以输入IP地址并能自动检查合法性的控件，就象95网络设置时输入IP地址那样的,如那位大侠有，请EMAIL一份给我，wavestar@126.com.
谢谢了，50分啊.

找个能够完成ping功能的控件。
here:
<a href="ftp://202.120.100.49/vcl/internet/icmp.zip">Icmp.zip</a>

Walong这不是瞎掺和吗？
他只要输入的VCL.

wavestar:

不好意思，理会错了。中午现做了一个，不是特别好使，但也能凑合着用。
1，在form上加一Tmaskedit控件。
2，在Tmaskedit的editmask属性中
imput mask设为999.999.999.999
character for blank 设为' ' //空格
save literal character 不选
Autoselect 设为false;
3,在maskedit的onchange句柄中，填入以下代码

procedure TForm1.MaskEdit1Change(Sender: TObject);
var t:array[0..3]of string;
i,j,len:integer;
begin
len:=strlen(pchar(maskedit1.text)); //取字符串长度
for i:=0 to 3 do //分四段读取
begin
t:='';
if len<i*3+1 then break;
for j:=i*3+1 to i*3+3 do //读三个字符
if j<=len then t:=t+maskedit1.Text[j]
else break;
if strtoint(t)>255
then
begin
showmessage('error,'+t+' is not a valid address');
break;
end;
end;

end;

以上执行存在小问题，对每一个数必须是最后一位不能空，否则出错。
即 .26 .222. 必须写成 . 26.222.
^^ ^^
你再研究一下。


tqz:
您在说谁？（看看身后，并没有别人的说）我可不叫walong。 *_^
自己草草写了几句，请您多指点。

怎么回事，贴的东西和显示的不一样？
只好再来一次了。


procedure TForm1.MaskEdit1Change(Sender: TObject);
var t:array[0..3]of string;
i,j,len:integer;
begin
len:=strlen(pchar(maskedit1.text)); //取字符串长度
for i:=0 to 3 do //分四段读取
begin
t:='';
if len<i*3+1 then break;
for j:=i*3+1 to i*3+3 do //读三个字符
if j<=len then t:=t+maskedit1.Text[j]
else break;
if strtoint(t)>255
then
begin
showmessage('error,'+t+' is not a valid address');
break;
end;
end;

end;

啊，不好！还是不一样！但查看源文件是正确的。
len 和255之间正好括在一对<>之中，这可怎么办，再来一次吧
这次用《》来代替， 看它还出错！！！

procedure TForm1.MaskEdit1Change(Sender: TObject);
var t:array[0..3]of string;
i,j,len:integer;
begin
len:=strlen(pchar(maskedit1.text)); //取字符串长度
for i:=0 to 3 do //分四段读取
begin
t:='';
if len《 i*3+1 then break;
for j:=i*3+1 to i*3+3 do //读三个字符
if j <= len then t:=t+maskedit1.Text[j]
else break;
if strtoint(t) 》 255
then
begin
showmessage('error,'+t+' is not a valid address');
break;
end;
end;

end;

到http://www.shrw.chn.net去找!!!!!!!!

就我来看，能自己写还是自己写吧。
Walone的也基本能完成任务。
要不还有啥要求我再给加点功能。
嘻嘻！

这是一个：用COMMCTRL做的，所以要安装IE4的机器才行：

注意自己添加Register函数。

////////////////////////////////////////////////////////////////////////////////
// IPADRESS98 //
////////////////////////////////////////////////////////////////////////////////
// An implementation of IE4's IPADDRESS Control //
////////////////////////////////////////////////////////////////////////////////
// Version 1.00 Beta //
// Date de cr閍tion : 20/10/1997 //
// Date derni鑢e modification : 21/10/1997 //
////////////////////////////////////////////////////////////////////////////////
// Jean-Luc Mattei //
// jlucm@club-internet.fr / jlucm@mygale.org //
////////////////////////////////////////////////////////////////////////////////
// IMPORTANT NOTICE : //
// //
// //
// This program is FreeWare //
// //
// Please do not release modified versions of this source code. //
// If you've made any changes that you think should have been there, //
// feel free to submit them to me at jlucm@club-internet.fr //
////////////////////////////////////////////////////////////////////////////////
// REVISIONS : //
// //
////////////////////////////////////////////////////////////////////////////////

unit IpAdress98;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, CommCtrl, Comctl98;

type

TCustomIPAdress98 = class;

TIPAdressFieldChangeEvent = procedure (Sender: TCustomIPAdress98; OldField, Value: Byte) of object;
TIPAdressChangeEvent = procedure (Sender: TCustomIPAdress98; IPAdress: String) of object;

TCustomIPAdress98 = class(TWinControl)
private
FOnIPChange: TIPAdressChangeEvent;
FOnIPFieldChange: TIPAdressFieldChangeEvent;
FMinIPAdress: Longint;
FMaxIPAdress: Longint;
FActiveField: Byte;
FAutoSize: Boolean;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
protected
procedure CreateParams(var Params: TCreateParams); override;
function GetMinIPAdress: String;
function GetMaxIPAdress: String;
function GetIPAdress: String;
procedure SetMinIPAdress(Value: String);
procedure SetMaxIPAdress(Value: String);
procedure SetIPAdress(Value: String);
function GetEmpty: Boolean;
procedure SetActiveField(Value: Byte);
public
constructor Create(AOwner: TComponent); override;
function IPToString(Ip: Longint): String;
function StringToIP(Value: String): Longint;
procedure Clear;
property ActiveField: Byte read FActiveField write SetActiveField;
property Empty: Boolean read GetEmpty;
property MinIPAdress: String read GetMinIPAdress write SetMinIPAdress;
property MaxIPAdress: String read GetMaxIPAdress write SetMaxIPAdress;
property IPAdress: String read GetIPAdress write SetIPAdress;
property OnIPChange: TIPAdressChangeEvent read FOnIPChange write FOnIPChange;
property OnIPFieldChange: TIPAdressFieldChangeEvent read FOnIPFieldChange write FOnIPFieldChange;
end;

TIPAdress98 = class(TCustomIPAdress98)
published
property ActiveField;
property Empty;
property MinIPAdress;
property MaxIPAdress;
property IPAdress;
property OnIPChange;
property OnIPFieldChange;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Tag;
property DragCursor;
property DragMode;
property HelpContext;
end;

implementation

constructor TCustomIPAdress98.Create(AOwner: TComponent);

begin
inherited Create(AOwner);
if NewStyleControls then
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight]
else
ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight, csFramed];
ParentColor := False;
FAutoSize := True;
Width:= 100;
Height:= 25;
TabStop:= True;
FMinIPAdress:= 0;
{$WARNINGS OFF}
FMaxIPAdress:= $0FFFFFFFF;
{$WARNINGS ON}
FActiveField:= 0;
FOnIPChange:= nil;
FOnIPFieldChange:= nil;
end;

procedure TCustomIPAdress98.CreateParams(var Params: TCreateParams);
begin
InitCommonControl(ICC_INTERNET_CLASSES);
inherited CreateParams(Params);
CreateSubClass(Params, WC_IPADDRESS);
with Params do
begin
Style := WS_VISIBLE or WS_BORDER or WS_CHILD;
if NewStyleControls and Ctl3D then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
end;
end;

procedure TCustomIPAdress98.CNNotify(var Message: TWMNotify);
begin
with Message.NMHdr^ do begin
case Code of
IPN_FIELDCHANGED :
begin
FActiveField:= PNMIPAdress(Message.NMHdr)^.iField;
if Assigned(OnIpFieldChange) then
with PNMIPAdress(Message.NMHdr)^ do begin
OnIPFieldChange(Self, iField, iValue);
end;
end;
end;
end;
end;

function TCustomIPAdress98.GetIPAdress: String;
var Ip: Longint;
begin
SendMessage(Handle, IPM_GETADDRESS, 0, Longint(@Ip));
Result:= IPToString(Ip);
end;

function TCustomIPAdress98.GetMinIPAdress: String;
begin
Result:= IPToString(FMinIPAdress);
end;

procedure TCustomIPAdress98.SetMinIPAdress(Value: String);
begin
FMinIPAdress:= StringToIp(Value);
SendMessage(Handle, IPM_SETRANGE, 0, MakeIpRange(First_IPAdress(FMinIPAdress), First_IPAdress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 1, MakeIpRange(Second_IPAdress(FMinIPAdress), Second_IPAdress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 2, MakeIpRange(Third_IPAdress(FMinIPAdress), Third_IPAdress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 3, MakeIpRange(Fourth_IPAdress(FMinIPAdress), Fourth_IPAdress(FMaxIPAdress)));
end;

function TCustomIPAdress98.GetMaxIPAdress: String;
begin
Result:= IPToString(FMaxIPAdress);
end;

procedure TCustomIPAdress98.SetMaxIPAdress(Value: String);
begin
FMaxIPAdress:= StringToIp(Value);
SendMessage(Handle, IPM_SETRANGE, 0, MakeIpRange(First_IPAdress(FMinIPAdress), First_IPAdress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 1, MakeIpRange(Second_IPAdress(FMinIPAdress), Second_IPAdress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 2, MakeIpRange(Third_IPAdress(FMinIPAdress), Third_IPAdress(FMaxIPAdress)));
SendMessage(Handle, IPM_SETRANGE, 3, MakeIpRange(Fourth_IPAdress(FMinIPAdress), Fourth_IPAdress(FMaxIPAdress)));
end;

procedure TCustomIPAdress98.SetIPAdress(Value: String);
begin
SendMessage(Handle, IPM_SETADDRESS, 0, StringToIp(Value));
end;

function TCustomIPAdress98.GetEmpty: Boolean;
begin
Result:= Boolean(SendMessage(Handle, IPM_ISBLANK, 0, 0));
end;

procedure TCustomIPAdress98.Clear;
begin
SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);
end;

procedure TCustomIPAdress98.SetActiveField(Value: Byte);
begin
if ( Value < 4 ) then begin
SendMessage(Handle, IPM_SETFOCUS, wParam(Value), 0);
FActiveField:= Value;
end;
end;

function TCustomIPAdress98.StringToIp(Value: String): Longint;
var B: Array[0..3] of Byte;
Str: String;
i, Cnt : Integer;
begin
B[0]:= 0;
B[1]:= 0;
B[2]:= 0;
B[3]:= 0;
Cnt:= 0;
i:= Pos('.', Value);
while (Length(Value) > 0) and ( Cnt < 4 ) do begin
if ( i = 0 ) then i:= Length(Value)+1;
Str:= Copy(Value, 0, i-1);
B[Cnt]:= StrToInt(Str);
Value:= Copy(Value, i+1, Length(Value));
i:= Pos('.', Value);
Inc(Cnt);
end;
Result:= MakeIPAdress(b[0], b[1], b[2], b[3]);
end;

function TCustomIPAdress98.IPToString(Ip: Longint): String;
begin
Result:= IntToStr(First_IPAdress(Ip))+'.'+IntToStr(Second_IPAdress(Ip))+'.'+
IntToStr(Third_IPAdress(Ip))+'.'+IntToStr(Fourth_IPAdress(Ip));
end;

procedure TCustomIPAdress98.CNCommand(var Message: TWMCommand);
begin
if (Message.NotifyCode = EN_CHANGE) and Assigned(OnIpChange) then
OnIPChange(Self, IPAdress);
end;

end.

哎呀，lhz您怎么那么快呢？我的TIPEdit都快写好了

tqz:

仍然可以继续呀！写好了发我一份如何？

lhz 所贴总是一针见血(分)!

你好，lhz，谢谢你的程序，不过Comctl98是自己写的控件吗？好象DELPHI中没有啊？

不知能否给一个完整的可以运行的程序？

谢谢。

LHZ 的东东基本可以呀
实际上，用个 MASKEDIT，自己在 ONEXIT 中判断不就得了？

感叹（lhz太狠了！）
TO EveryBody:毕业论文太不爽了！
一大堆废话，还非的写那么多！
累死我了！

to tqz:
你接着写吧,我给的那个要有IE4才能运行,总感觉不爽.写好了
别忘了放在你的主页上让我下载

to wavestar
DELPHI有的我贴在这里干嘛?用法太简单了:
安装控件->选择控件->放到FORM上->运行.这还要例子吗?

to D4:
我哪里狠呀?

DELPHI有的???在那，我怎么没找到？？？

Comctl98是DELPHI的控件？好象也不是IE4。0的控件啊？

请说的详细一些啦。

to lhz:我正在写的也是封装IPAddress的。MSDN说需要Commctrl版本4.71以上。
我看这个VCL似乎比不上我写的不过还没写完，因为我的专用机给人占了
to WaveStar:CommCtrl是Win95/98的DLL,包含了Windows的Common Controls,
比如ListView,TreeView等。

我知道CommCtrl，而且DELPHI已经把它封装到自己的类库中了，我只是不知道Comctl98这个控件那来的？

刚把计算机抢回来，但是，感觉没必要写了。lhz提供的已经够好了。
刚才用Opera看，lhz的程序看不全，现在用IE看全了...

强烈谴责 WaveStar！ 你玩什么呀？