procedure TForm1.SendIt;
Var
sh : TSocket;
bOpt : Integer;
ret : Integer;
Buf : TPacketBuffer;
Remote : TSockAddr;
Local : TSockAddr;
iTotalSize : Word;
wsdata : TWSAdata;

begin
// Startup Winsock 2
ret := WSAStartup($0002, wsdata);
if ret<>0 then begin
memo1.lines.add(''''WSA Startup failed.'''');
exit;
end;
with memo1.lines do begin
add(''''WSA Startup:'''');
add(''''Desc.: ''''+wsData.szDescription);
add(''''Status: ''''+wsData.szSystemStatus);
end;

try
// Create socket
sh := Socket(AF_INET, SOCK_RAW, IPPROTO_UDP);
if (sh = INVALID_SOCKET) then begin
memo1.lines.add(''''Socket() failed: ''''+IntToStr(WSAGetLastError));
exit;
end;
Memo1.lines.add(''''Socket Handle = ''''+IntToStr(sh));

// Option: Header Include
bOpt := 1;
ret := SetSockOpt(sh, IPPROTO_IP, IP_HDRINCL, @bOpt, SizeOf(bOpt));
if ret = SOCKET_ERROR then begin
Memo1.lines.add(''''setsockopt(IP_HDRINCL) failed: ''''+IntToStr(WSAGetLastError));
exit;
end;

// Build the packet
BuildHeaders( SrcIP, SrcPort,
DestIP, DestPort,
''''THIS IS A TEST PACKET'''',
Buf, Remote, iTotalSize );

// Send the packet
ret := SendTo(sh, buf, iTotalSize, 0, Remote, SizeOf(Remote));
if ret = SOCKET_ERROR then
Memo1.Lines.Add(''''sendto() failed: ''''+IntToStr(WSAGetLastError))
else
Memo1.Lines.Add(''''send ''''+IntToStr(ret)+'''' bytes.'''');

// Close socket
CloseSocket(sh);
finally
// Close Winsock 2
WSACleanup;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SendIt;
end;

end.

上一页  [1] [2]