用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.