给你个控件,里面有对IP地址的检查:
{******************************************************************************}
unit IPAddressControl;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls;
resourcestring RangeError =
'给定的值: $%x 无效, 应该在 $%x..$%x 之间.';
type
PNMIPAddress=^TNMIPAddress;
tagNMIPADDRESS=packed record
hdr:NMHDR;
iField
Word;
iValue
word ;
end;
{$EXTERNALSYM tagNMIPADDRESS}
TNMIPAddress = TAGNMIPADDRESS;
NMIPADDRESS = TAGNMIPADDRESS;
{$EXTERNALSYM NMIPADDRESS}
type
TIPAddrRange = class(TPersistent)
private
FLowerLimit:byte;
FUpperLimit:byte;
FField:Byte;
FOwner:TComponent;
function GetIPRange(Index:Integer): Byte;
procedure SetIPRange(Index: Integer
Value: Byte);
public
constructor Create(AOwner:TComponent;AField:Byte);
published
property LowerLimit:Byte index 1 read GetIPRange write SetIPRange default 0;
property UpperLimit:Byte index 2 read GetIPRange write SetIPRange default 255;
end;
type
TRangeErrorEvent=procedure(Sender:TObject;var IPRange:TIPAddrRange;Value,Field:byte)of Object;
type
TCustomIPAddressControl = class(TWinControl)
private
FOnChange: TNotifyEvent;
FOnEnter: TNotifyEvent;
FOnExit: TNotifyEvent;
FRanges1:TIPAddrRange;
FRanges2:TIPAddrRange;
FRanges3:TIPAddrRange;
FRanges4:TIPAddrRange;
FFirstIPAddress:byte;
FSecondIPAddress:byte;
FThirdIPAddress:byte;
FFourthIPAddress:byte;
FOnRangeError:TRangeErrorEvent;
FField: Byte;
procedure CNNotify(var Message: TWMNotify)
message CN_NOTIFY;
procedure CNCommand(var Message: TWMCommand)
message CN_COMMAND;
procedure SetFirstIPAddress(const Value: Byte);
procedure SetIPAddress;
procedure SetFourthIPAddress(const Value: byte);
procedure SetSecondIPAddress(const Value: byte);
procedure SetThirdIPAddress(const Value: byte);
function GetIsBlank: boolean;
procedure SetIsBlank(const Value: boolean);
procedure SetField(const Value: Byte);
procedure SetAddress( const Value: String );
function GetAddress: String;
protected
procedure CreateParams(var Params: TCreateParams)
override;
procedure CreateWindowHandle(const Params: TCreateParams)
override;
procedure CreateWnd
override;
procedure DestroyWnd
override;
procedure Change;
procedure Enter;
procedure Exit;
procedure RaiseRangeError(var IPRange:TIPAddrRange;Value,Field:byte);
public
constructor Create(AOwner: TComponent)
override;
destructor Destroy
override;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
property OnExit: TNotifyEvent read FOnExit write FOnExit;
property Address : String read GetAddress write SetAddress;
property IPAddress1 :Byte read FFirstIPAddress write SetFirstIPAddress nodefault;
property IPAddress2 :byte read FSecondIPAddress write SetSecondIPAddress nodefault;
property IPAddress3 :byte read FThirdIPAddress write SetThirdIPAddress nodefault;
property IPAddress4 :byte read FFourthIPAddress write SetFourthIPAddress nodefault;
property IsBlank:boolean read GetIsBlank write SetIsBlank;
property Field:Byte read FField write SetField;
property Range1IPAddr:TIPAddrRange read FRanges1 write FRanges1;
property Range2IPAddr:TIPAddrRange read FRanges2 write FRanges2;
property Range3IPAddr:TIPAddrRange read FRanges3 write FRanges3;
property Range4IPAddr:TIPAddrRange read FRanges4 write FRanges4;
property OnRangeError:TRangeErrorEvent read FOnRangeError write FOnRangeError;
end;
type
TIPAddressControl = class(TCustomIPAddressControl)
public
property Address;
published
property OnChange;
property OnEnter;
property OnExit;
property OnRangeError;
property IPAddress1;
property IPAddress2;
property IPAddress3;
property IPAddress4;
property Range1IPAddr;
property Range2IPAddr;
property Range3IPAddr;
property Range4IPAddr;
end;
const
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
function MakeIPAddress(b1,b2,b3,b4:Byte)
Word;
function MakeIPRange(min,max:Byte)
Word;
procedure Register;
implementation
uses Commctrl;
procedure Register;
begin
RegisterComponents('Internet', [TIPAddressControl]);
end;
function MakeIPAddress(b1,b2,b3,b4:byte)
Word;
begin
result:=((b1*16777216)+(b2*65536)+(b3*256)+b4);
end;
function MakeIPRange(min,max:Byte)
Word;
begin
Result:=(max*256)+min;
end;
{ TCustomIPAddressControl }
procedure TCustomIPAddressControl.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TCustomIPAddressControl.CNCommand(var Message: TWMCommand);
begin
inherited;
case Message.NotifyCode of
EN_SETFOCUS :Enter;
EN_KILLFOCUS:Exit;
EN_CHANGE :Change;
end;
end;
procedure TCustomIPAddressControl.CNNotify(var Message: TWMNotify);
var IP_a:TNMIPAddress ;
begin
with Message do
begin
if NMHdr^.code = IPN_FIELDCHANGED then
begin
IP_a:=PNMIPADDRESS(Message.NMHdr)^;
with IP_a do
case iField of
0: IPAddress1 := iValue;
1: IPAddress2 := iValue;
2: IPAddress3 := iValue;
3: IPAddress4 := iValue;
end;
end;
end;
end;
constructor TCustomIPAddressControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 121;
Height := 21;
FRanges1 := TIPAddrRange.Create(self,1);
FRanges2 := TIPAddrRange.Create(self,2);
FRanges3 := TIPAddrRange.Create(self,3);
FRanges4 := TIPAddrRange.Create(self,4);
end;
procedure TCustomIPAddressControl.CreateParams(var Params: TCreateParams);
begin
InitCommonControl(ICC_INTERNET_CLASSES);
inherited CreateParams(Params);
CreateSubClass(Params, WC_IPADDRESS);
with Params do
begin
Style := WS_CHILD;
end;
end;
procedure TCustomIPAddressControl.CreateWindowHandle(
const Params: TCreateParams);
begin
inherited CreateWindowHandle(Params);
end;
procedure TCustomIPAddressControl.CreateWnd;
begin
inherited CreateWnd;
end;
destructor TCustomIPAddressControl.Destroy;
begin
FRanges1.Free;
FRanges2.Free;
FRanges3.Free;
FRanges4.Free;
inherited Destroy;
end;
procedure TCustomIPAddressControl.DestroyWnd;
begin
inherited DestroyWnd;
end;
procedure TCustomIPAddressControl.Enter;
begin
if Assigned(FOnEnter) then FOnEnter(Self);
end;
procedure TCustomIPAddressControl.Exit;
begin
if Assigned(FOnExit) then FOnExit(Self);
end;
function TCustomIPAddressControl.GetIsBlank: boolean;
begin
if SendMessage(Handle,IPM_ISBLANK,0,0)=0 then
Result:=False
else
Result:=True;
end;
procedure TCustomIPAddressControl.RaiseRangeError(
var IPRange: TIPAddrRange;Value,Field: byte);
begin
if Assigned(FOnRangeError) then
FOnRangeError(Self,IPRange,Value,Field)
else
raise ERangeError.CreateFmt(RangeError,[Value,IPRange.LowerLimit,IPRange.UpperLimit ]);
end;
procedure TCustomIPAddressControl.SetField(const Value: Byte);
begin
if (Value < 1) or (Value >4)then
raise ERangeError.CreateFmt(RangeError,[Value, 1, 4]);
FField := Value;
SendMessage(Handle,IPM_SETFOCUS,Value-1,0);
end;
procedure TCustomIPAddressControl.SetFirstIPAddress(const Value: Byte);
begin
if Value <> FFirstIPAddress then
begin
if (Value < FRanges1.LowerLimit) or (Value >FRanges1.UpperLimit)then
RaiseRangeError(FRanges1,Value,1);
FFirstIPAddress := Value;
SetIPAddress;
end;
end;
procedure TCustomIPAddressControl.SetFourthIPAddress(const Value: byte);
begin
if Value <> FFourthIPAddress then
begin
if (Value < FRanges4.LowerLimit) or (Value >FRanges4.UpperLimit)then
RaiseRangeError(FRanges4,Value,4);
FFourthIPAddress := Value;
SetIPAddress;
end;
end;
procedure TCustomIPAddressControl.SetIPAddress;
begin
SendMessage(Handle,IPM_SETADDRESS,0,
MakeIPAddress(FFirstIPAddress,FSecondIPAddress,FThirdIPAddress,FFourthIPAddress));
end;
procedure TCustomIPAddressControl.SetIsBlank(const Value: boolean);
begin
If Value=True then SendMessage(Handle,IPM_CLEARADDRESS,0,0);
end;
procedure TCustomIPAddressControl.SetAddress( const Value: String );
var str: String;
begin
str := Value;
try
FFirstIPAddress := StrToInt( Copy(str, 1, Pos('.', str) - 1) );
except
FFirstIPAddress := 0;
end;
try
str := Copy( str, Pos('.', str) + 1, 255 );
FSecondIPAddress := StrToInt( Copy(str, 1, Pos('.', str) - 1) );
except
FSecondIPAddress := 0;
end;
try
str := Copy( str, Pos('.', str) + 1, 255 );
FThirdIPAddress := StrToInt( Copy(str, 1, Pos('.', str) - 1) );
except
FThirdIPAddress := 0;
end;
try
str := Copy( str, Pos('.', str) + 1, 255 );
FFourthIPAddress := StrToInt( str );
except
FFourthIPAddress := 0;
end;
SetIPAddress;
end;
function TCustomIPAddressControl.GetAddress: String;
begin
Result := IntToStr(FFirstIPAddress) + '.' +
IntToStr(FSecondIPAddress) + '.' +
IntToStr(FThirdIPAddress) + '.' +
IntToStr(FFourthIPAddress);
end;
procedure TCustomIPAddressControl.SetSecondIPAddress(const Value: byte);
begin
if Value <> FSecondIPAddress then
begin
if (Value < FRanges2.LowerLimit) or (Value >FRanges2.UpperLimit)then
RaiseRangeError(FRanges2,Value,2);
FSecondIPAddress := Value;
SetIPAddress;
end;
end;
procedure TCustomIPAddressControl.SetThirdIPAddress(const Value: byte);
begin
if Value <> FThirdIPAddress then
begin
if (Value < FRanges3.LowerLimit) or (Value >FRanges3.UpperLimit)then
RaiseRangeError(FRanges3,Value,3);
FThirdIPAddress := Value;
SetIPAddress;
end;
end;
{ TIPAddrRange }
constructor TIPAddrRange.Create(AOwner: TComponent;AField:Byte);
begin
inherited Create;
FOwner:=AOwner;
FField:=AField;
FLowerLimit:=0;
FUpperLimit:=255;
end;
function TIPAddrRange.GetIPRange(Index: Integer): Byte;
begin
Result:=255;
case Index of
1:Result:=FLowerLimit;
2:Result:=FUpperLimit;
end;
end;
procedure TIPAddrRange.SetIPRange(Index: Integer
Value: Byte);
var TempRange:Byte;
begin
TempRange:=0;
case Index of
1:begin
TempRange:=FLowerLimit;
FLowerLimit:=Value;
end;
2:begin
TempRange:=FUpperLimit;
FUpperLimit:=Value;
end;
end;
if TempRange<>Value then
begin
SendMessage(TIPAddressControl(FOwner).Handle,IPM_SETRANGE,FField-1,MakeIPRange(FLowerLimit,FUpperLimit));
end;
end;
end.