核心提示：interface uses Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms, Dialogs,StdCtrls,...
interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Winsock2, YRecords;
type
TForm1 = class(TForm)
Button1: TButton;
edtDestIP: TEdit;
edtFromIP: TEdit;
edtDestPort: TEdit;
edtFromPort: TEdit;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CheckSum( p: PU16; size: U16 ):U16;
var
chksum : U32;
pbuf : PU16;
begin
pbuf := p;
chksum := 0;
while size > 1 do
begin
chksum := chksum + pbuf^;
Inc( pBuf );
Dec( size, sizeof(U16) );
end;
if Size=1 then
ChkSum := ChkSum + PByte(pBuf)^;
chksum := (chksum shr 16 )+(chksum and $ffff);
chksum := chksum + (chksum shr 16);
chksum := not chksum;
result := U16(chksum);
end;
//填充IP Header
procedure FillIPHeader( pip: PIPHeader; ttl:u8; datalen: u32; proto: U8;
destip, fromip: U32 );
var
b : u8;
w : u16;
begin
b := 4;
pip^.u8verlen := ( b shl 4 ) or (sizeof(YIPHeader) div sizeof(u32));
pip^.u8tos := 0;
w := u16( sizeof(YIPHeader) + sizeof(YUDPHeader) + datalen );
pip^.u16totallen := htons( w );
pip^.u16id := u16(GetCurrentProcessID);
pip^.u16offset := htons(1 shl 14);//do not fragment
pip^.u8ttl := ttl;
pip^.u8protol := proto;
pip^.u16checksum := 0;
pip^.u32srcaddr := fromip;
pip^.u32destaddr := destip;
pip^.u16checksum := CheckSum( PU16(pip), sizeof(YIPHeader) );
end;
//填充UDP头
procedure FillUDPHeader( pudp: PUDPHeader; datalen: u32; destport, fromport: U32 );
var
b : u8;
w : u16;
begin
pudp^.u16srcport := fromport;
pudp^.u16destport := destport;
pudp^.u16len := htons( sizeof(YUDPHeader) + datalen );
pudp^.u16chksum := 0;
end;
procedure ErrMsg( msg: string );
begin
MessageBox( 0, PChar(msg), ’Ping Program Error’, MB_ICONERROR );
end;
procedure TForm1.FormCreate(Sender: TObject);
var
wsa : TWSAData;
begin
if WSAStartup( $0202, wsa ) <> 0 then
ErrMsg( ’Windows socket is not responed.’ );
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if WSACleanup <> 0 then
ErrMsg( ’Windows socket can not be closed.’ );
end;
procedure TForm1.Button1Click(Sender: TObject);
var
udpsock : TSocket;
opt : s32;
DestAdr,
FromAdr : TSockAddr;
pIPHdr : PIPHeader;
pUDPHdr : PUDPHeader;
pDataBuf : PChar;
begin
//创建一个UDPSOCK发送探测包
udpsock := socket( AF_INET, SOCK_RAW, IPPROTO_UDP );
//设置SOCKET选项--我们自己操作IP头
opt := 1;
setsockopt( udpsock, IPPROTO_IP, IP_HDRINCL, @opt, SizeOf(opt));
//为IP Header / UDP header /Data buf 分配内存
pIPHdr := AllocMem( sizeof(YIPHeader) + sizeof(YUDPHeader) + PACKET_SIZE );
pUDPHdr := PUDPHeader( PChar(pIPHdr) + sizeof(YIPHeader) );
pDataBuf := PChar(pUDPHdr) + sizeof(YUDPHeader);
//本地Addr
FillChar( FromAdr, sizeof(FromAdr), 0 );
FromAdr.sin_family := AF_INET;
FromAdr.sin_port := htons( StrToInt(edtFromPort.text) );
FromAdr.sin_addr.S_addr := inet_addr( PChar(edtFromIP.Text) );
//远程Addr
FillChar( DestAdr, sizeof(DestAdr), 0 );
DestAdr.sin_family := AF_INET;
DestAdr.sin_port := htons( StrToInt(edtDestPort.text) );
DestAdr.sin_addr.S_addr := inet_addr( PChar(edtDestIP.Text) );
//填充IP头和UDP头
FillIPHeader( pIPHdr, 55, PACKET_SIZE, IPPROTO_UDP, DestAdr.sin_addr.S_addr,
FromAdr.sin_addr.S_addr );
FillUDPHeader( pUDPHdr, PACKET_SIZE, DestAdr.sin_port, FromAdr.sin_port );
FillChar( pDataBuf^, PACKET_SIZE, ’Y’ );
//发送UDP包到HOST
sendto( udpsock, pIPHdr^, sizeof(YIPHeader) + sizeof(YUDPHeader) + PACKET_SIZE,
0, DestAdr, sizeof(DestAdr) );
ListBox1.Items.Add( ’发送了’ +IntToStr(ret)+ ’字节到：’ + edtDestIP.Text );
closesocket(udpsock);
FreeMem( pIPHdr );
end;
end.
