用Socket API实现UDP

unit udp;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls, Buttons, ExtCtrls, Spin, ComCtrls, ToolWin, Menus,Inifiles;
const
WM_SOCK = WM_USER + 1; //自定义windows消息
UDPPORT = 6767; //设定UDP端口号
NBTPORT = 137;
type
Tfrmmain = class(TForm)
ListBox1: TListBox;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton2: TSpeedButton;
ListView1: TListView;
Splitter1: TSplitter;
StatusBar1: TStatusBar;
CoolBar1: TCoolBar;
Panel2: TPanel;
Edit1: TEdit;
Edit2: TEdit;
SpinEdit1: TSpinEdit;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
SpeedButton4: TSpeedButton;
SaveDlg: TSaveDialog;
SpeedButton5: TSpeedButton;
PopupMenu1: TPopupMenu;
N3: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure ListView1Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn : TSockAddrIn; //利用消息实时获知UDP消息
procedure ReadData(var Message: TMessage); message WM_SOCK;
procedure RecvNbMsg(buffer: Array of byte;len:integer;IP:string);
procedure OpenIni;
procedure SaveIni;
public
{ Public declarations }
procedure SendData(b:array of byte;IP:string);
end;
TSendDataThread=class(TThread)
private
IP,IP2:string;
protected
procedure Execute; override;
procedure GetIP;
procedure Send;
procedure OnExit;
end;
type
PListItem = ^TMyListItem;
TMyListItem = record
//dirName,group: string;
index: integer;
end;
var
frmmain: Tfrmmain;
B1,B2: array [0..3]of byte;
SendDataThread: TSendDataThread;
WAIT_ACK_EVENT: Thandle;
wait_time: integer;
exit_thread: boolean;
ListItemPtr: PListItem;
ini: Tinifile;
mydir: string;
implementation
{$R *.DFM}
function IsLegalIP(IP:string):boolean;
begin
if Longword(inet_addr(pchar(IP)))=INADDR_NONE then
begin
result:=false;
exit;
end
else result:=true;
end;
procedure GetAddrByte(IP:string;var B:array of byte);
var i,j:integer;
s:string;
begin
s:='';
j:=0;
IP:=IP+'.';
for i:=1 to length(IP)do
begin
if IP[i]<>'.' then s:=s+IP[i]
else
begin
B[j]:=byte(strtoint(s));
inc(j);
s:='';
end;
end;
end;
procedure TSendDataThread.Send;
const NbtstatPacket:array[0..49]of byte
=($0,$0,$0,$0,$0,$1,
$0,$0,$0,$0,$0,$0,$20,$43,$4b,
$41,$41,$41,$41,$41,$41,$41,$41,
$41,$41,$41,$41,$41,$41,$41,$41,
$41,$41,$41,$41,$41,$41,$41,$41,
$41,$41,$41,$41,$41,$41,$0,$0,$21,$0,$1);
begin
with frmmain do
begin
StatusBar1.Panels[0].Text := '正在测试：'+IP;
senddata(NbtstatPacket,IP);
end;
end;
procedure TSendDataThread.GetIP;
begin
with frmmain do
begin
IP:= Edit1.Text;
IP2:=Edit2.Text;
end;
end;
procedure TSendDataThread.OnExit;
begin
with frmmain do
begin
SpeedButton1.Enabled := true;
SpeedButton2.Enabled := false;
SpeedButton3.Enabled := false;
StatusBar1.Panels[0].Text := '完成';
end;
end;
procedure TSendDataThread.Execute;
begin
Synchronize(GetIP);
if (not IsLegalIP(IP))or(not IsLegalIP(IP2)) then
begin
showmessage('Illegal IP address!');
exit;
end;
GetAddrByte(IP,B1);
GetAddrByte(IP2,B2);
repeat
if exit_thread then
begin
Synchronize(OnExit);
exit;
end;
IP:=format('%d.%d.%d.%d',[B1[0],B1[1],B1[2],B1[3]]);
Synchronize(Send);
waitforsingleobject(WAIT_ACK_EVENT,wait_time);
ResetEvent(WAIT_ACK_EVENT);
if(B1[2]<=B2[2]) then
begin
if(B1[3]<B2[3]) then inc(B1[3])
else if((B1[2]<B2[2]) and (B1[3]<255))then inc(B1[3])
else if((B1[2]<B2[2]) and (B1[3]=255)) then
begin
B1[3]:=1;
inc(B1[2]);
end;
end
else break;
if((B1[3]>=B2[3]) and (B1[2]>=B2[2])) then break;
until ((B1[2]=255));// or (B1[3]=255));
Synchronize(OnExit);
end;
procedure Tfrmmain.OpenIni;
begin
ini:=Tinifile.create(mydir+'Nbtstat.ini');
if not fileexists('Nbtstat.ini')
then
begin
ini.writeInteger('window position','top',top);
ini.writeInteger('window position','left',left);
ini.writeInteger('window position','width',width);
ini.writeInteger('window position','height',height);
ini.writeString('IP','IP1',Edit1.Text);
ini.writeString('IP','IP2',Edit2.Text);
end
else
begin
top:=ini.ReadInteger('window position','top',50);
left:=ini.ReadInteger('window position','left',50);
width:=ini.ReadInteger('window position','width',500);
height:=ini.ReadInteger('window position','height',50);
Edit1.Text:=ini.ReadString('IP','IP1',Edit1.Text);
Edit2.Text:=ini.ReadString('IP','IP2',Edit2.Text);
end;
ini.Free;

end;
procedure Tfrmmain.SaveIni;
begin
if mydir[1]='/' then exit; //open on the LAN
//showmessage(mydir);
ini:=Tinifile.create(mydir+'Nbtstat.ini');
ini.writeInteger('window position','top',top);
ini.writeInteger('window position','left',left);
ini.writeInteger('window position','width',width);
ini.writeInteger('window position','height',height);
ini.writeString('IP','IP1',Edit1.Text);
ini.writeString('IP','IP2',Edit2.Text);
ini.Free;

end;
procedure Tfrmmain.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
//optval: integer;
begin
// 初始化SOCKET
if WSAStartup($101, TempWSAData)=1 then
showmessage('StartUp Error!');
s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
showmessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(s);
end;
//本机SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(UDPPORT);
if Bind(s, addr, sizeof(addr)) <> 0 then
begin
showmessage('bind fail');
end;
WSAAsyncSelect(s, frmmain.Handle , WM_SOCK, FD_READ);
//对方SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
WAIT_ACK_EVENT:=CreateEvent(nil,true,false,pchar('WAIT_ACK'));
//ResetEvent(WAIT_ACK_EVENT);
wait_time:=100;
mydir:=ExtractFilePath(ParamStr(0));
OpenIni;
end;
procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseSocket(s);
SaveIni
end;
procedure Tfrmmain.RecvNbMsg(buffer: Array of byte;len:integer;IP:string);
var
str:string;
i,j,pos,name_num: integer;
item : TListItem;
begin
item:=ListView1.Items.Insert(0);
item.Caption := IP;
for i:=0 to 4 do item.SubItems.Add('');
ListBox1.Items.Add('IP: '+IP);
//
new(ListItemPtr);
ListItemPtr.index := ListBox1.Items.Count;
item.data:= ListItemPtr;
name_num:=0;
for i:=1 to len do
begin
if((buffer[i]=$21)and(buffer[i+1]=$00)and(buffer[i+2]=$01))
then
begin
name_num:=buffer[i+9];
break;
end;
end;
if name_num=0 then exit;
pos:=i+10;
str:='';
for i:=pos to (pos+18*name_num-1) do
begin
if (((i-pos)mod 18) =0) then
begin
for j:=0 to 14 do
begin
if trim(char(buffer[i+j]))='' then buffer[i+j]:=ord(' ');
str:=str+char(buffer[i+j]);
end;
if (buffer[i+16] and $80)=$80 then
begin
if buffer[i+15]=$0 then item.SubItems[0]:=str;
str:=str+format('<%x>',[buffer[i+15]]);
str:=str+'<GROUP>';
end
else
begin
if buffer[i+15]=$20 then item.SubItems[1]:=str
else
if buffer[i+15]=$3 then item.SubItems[2]:=str;
str:=str+format('<%x>',[buffer[i+15]]);
str:=str+'<UNIQUE>';
end;
ListBox1.Items.Add(str);
str:='';
end;
end;
for i:=0 to 5 do
begin
str:=str+format('%.2x.',[buffer[i+pos+18*name_num]]);
end;
delete(str,length(str),1);
item.SubItems[3]:=str;
str:='MAC:'+str;
ListBox1.Items.Add(str);
ListBox1.Items.Add('------------------------------------------------------');
ListBox1.TopIndex :=ListBox1.Items.count-1;

end;
procedure Tfrmmain.ReadData(var Message: TMessage);
var
buffer: Array [1..500] of byte;
flen,len: integer;
Event: word;
IP:string;
begin
flen:=sizeof(FSockAddrIn);
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
if len> 0 then
begin
//FSockAddrIn.sin_addr.S_un_b.s_b1
with FSockAddrIn.sin_addr.S_un_b
do IP:=format('%d.%d.%d.%d',[ord(s_b1),ord(s_b2),ord(s_b3),ord(s_b4)]);
RecvNbMsg(buffer,len,IP);

end;
SetEvent(WAIT_ACK_EVENT);
end;
end;
procedure Tfrmmain.SendData(b:array of byte;IP:string);
var
len: integer;
begin
FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(IP));
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
len := sendto(s, b[0],50, 0, FSockAddrIn, sizeof(FSockAddrIn));
//if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('SOCKET_ERROR,send fail.');
if len <> 50 then
showmessage('Not Send all');
end;
procedure Tfrmmain.SpeedButton1Click(Sender: TObject);
begin
exit_thread:=false;
SendDataThread:=TSendDataThread.Create(true);
SpeedButton1.Enabled := false;
SpeedButton2.Enabled := true;
SpeedButton3.Enabled := true;
wait_time:=SpinEdit1.Value;
SendDataThread.Resume;
end;
procedure Tfrmmain.SpeedButton2Click(Sender: TObject);
begin
exit_thread:=true;
end;
procedure Tfrmmain.SpeedButton3Click(Sender: TObject);
begin
if SpeedButton3.Down then
begin
SpeedButton2.Enabled := false;
SendDataThread.Suspend;
end
else
begin
SpeedButton2.Enabled := true;
SendDataThread.Resume;
end;
end;
procedure Tfrmmain.SpinEdit1Change(Sender: TObject);
begin
wait_time:=SpinEdit1.Value;
end;
procedure Tfrmmain.ListView1Click(Sender: TObject);
var ListIndex:integer;
begin
if ListView1.Selected=nil then exit;
ListIndex:=PListitem(ListView1.Selected.Data)^.index;
ListBox1.TopIndex := ListIndex-1;

end;
procedure Tfrmmain.SpeedButton4Click(Sender: TObject);
begin
ListView1.Items.Clear;
ListBox1.Items.Clear;
end;
procedure Tfrmmain.SpeedButton5Click(Sender: TObject);
var f:textfile; i:integer; st:string;
begin
if listview1.Items.Count = 0 then
begin
Application.MessageBox('没有可保存的内容！ ','Save File',MB_OK );
exit;
end;
st:=timeToStr(time);
for i:=1 to length(st) do if st[i]=':' then st[i]:='-';
SaveDlg.FileName := 'NbtstatLog('+datetostr(now)+'-'+st+')';
if SaveDlg.Execute then
begin
assignfile(f,SaveDlg.filename);
rewrite(f);
for i:=0 to listview1.Items.Count-1 do
begin
writeln(f,listview1.Items[i].Caption+': '
+listview1.Items[i].SubItems[0]+' '
+listview1.Items[i].SubItems[1]+' '
+listview1.Items[i].SubItems[2]+' '
+listview1.Items[i].SubItems[3]+' '
{+listview1.Items[i].SubItems[4]+' byte)'});
writeln(f);
end;
closefile(f);

end;

end;
procedure Tfrmmain.N3Click(Sender: TObject);
var i:integer; st:string;
begin
if listBox1.Items.Count = 0 then
begin
Application.MessageBox('没有可保存的内容！ ','Save File',MB_OK );
exit;
end;
st:=timeToStr(time);
for i:=1 to length(st) do if st[i]=':' then st[i]:='-';
SaveDlg.FileName := 'NbtstatLog2('+datetostr(now)+'-'+st+')';
if SaveDlg.Execute then
begin
ListBox1.Items.SaveToFile(SaveDlg.FileName+'.txt');
end;
end;
end.