main.pas

网络监听程序

unit main;

interface

uses
  Windows, Messages, StdCtrls, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, netfun, communit, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Memo1: TMemo;
    BitBtn1: TBitBtn;
    Button3: TButton;
    Button4: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    procedure DealRecvIPPack(PPack:PByte);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  dwErrorCode:DWORD;
  i:integer;
  hEvent:THandle;
begin
    packnum:=0;
    filter:=NDIS_PACKET_TYPE_PROMISCUOUS;
///* Open device */
    hVxD := CreateFile('\\.\VPACKET.VXD',
                      GENERIC_READ or GENERIC_WRITE,
                      0,
                      nil,
                      OPEN_EXISTING,
                      FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED or
                      FILE_FLAG_DELETE_ON_CLOSE,
                      0);

    if (hVxD = INVALID_HANDLE_VALUE) then
    begin
        dwErrorCode := GetLastError();
        if (dwErrorCode = ERROR_NOT_SUPPORTED) then
            showmessage('Unable to open VxD,device does not support DeviceIOCTL')
        else
            showmessage('Unable to open VxD, Error code'+inttohex(dwErrorCode,4))
    end;

///* Device opened successfully */
///* Bind driver to NDIS3 adapter	*/
    Bind(hVxd,'0001');
//    if(GetHardEtherAddr(hVxD,@m_EtherAddr)<>OK) then exit;
    ///* Set Filter */
    SetOid(hVxD, OID_GEN_CURRENT_PACKET_FILTER, 4, filter);

  for i:=0 to RECV_MAX-1 do
  begin
    hEvent := CreateEvent(nil, TRUE, false, nil);
    if(hEvent=0) then
    begin
      showmessage('Can not create event');
      exit;
    end;

    RecvTab[i].hEvent:=hEvent;
    fillchar(RecvTab[i].Buffer,0,BUFFER_SIZE);
    RecvTab[i].Size:=BUFFER_SIZE;
    RecvTab[i].Active:=TRUE;
    RecvTab[i].PackType:=FLAG_READ;
    EventTab[i]:=hEvent;
    RecvStart(hVxD,@RecvTab[i]);
  end;
  temp:='adfasdfsd';
  m_EtherAddr1.AddrByte[0]:=$aa;
  m_EtherAddr1.AddrByte[1]:=$0;
  m_EtherAddr1.AddrByte[2]:=$4;
  m_EtherAddr1.AddrByte[3]:=$0;
  m_EtherAddr1.AddrByte[4]:=$8;
  m_EtherAddr1.AddrByte[5]:=$4;
  m_EtherAddr2.AddrByte[0]:=$ab;
  m_EtherAddr2.AddrByte[1]:=$0;
  m_EtherAddr2.AddrByte[2]:=$0;
  m_EtherAddr2.AddrByte[3]:=$6;
  m_EtherAddr2.AddrByte[4]:=$0;
  m_EtherAddr2.AddrByte[5]:=$0;
  i:=0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hVxD);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption:=inttohex(DWord(m_EtherAddr.AddrByte[0]),2)+'.'+
    inttohex(DWord(m_EtherAddr.AddrByte[1]),2)+'.'+
    inttohex(DWord(m_EtherAddr.AddrByte[2]),2)+'.'+
    inttohex(DWord(m_EtherAddr.AddrByte[3]),2)+'.'+
    inttohex(DWord(m_EtherAddr.AddrByte[4]),2)+'.'+
    inttohex(DWord(m_EtherAddr.AddrByte[5]),2);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  flag:boolean;
  DataLen:Word;
  Buffer:array [0..BUFFER_SIZE-1] of Byte;
  pEtherHead:PEtherPacketHead;
  i:integer;
  pdata:PByte;
begin
  ///* Do listen */
  for i:=1 to 300 do
  begin
    DataLen:=RecvPacket(hVxD,@Buffer);
    if(DataLen=SYSERR) then
      ShowMessage('Recv Error!');
      ///* Begin to process data */
    pEtherHead:=@Buffer;
    pdata:=PByte(DWOrd(pEtherHead)+14);
//    if (pEtherHead.DestEther.AddrByte[0]=$ab) then
    memo1.Lines.Add(inttohex(DWord(pEtherHead.DestEther.AddrByte[0]),2)+'.'+
    inttohex(DWord(pEtherHead.DestEther.AddrByte[1]),2)+'.'+
    inttohex(DWord(pEtherHead.DestEther.AddrByte[2]),2)+'.'+
    inttohex(DWord(pEtherHead.DestEther.AddrByte[3]),2)+'.'+
    inttohex(DWord(pEtherHead.DestEther.AddrByte[4]),2)+'.'+
    inttohex(DWord(pEtherHead.DestEther.AddrByte[5]),2)+':'+inttostr(DataLen));
  end;
end;

procedure TForm1.DealRecvIPPack(PPack:PByte);
var
  pIPHead:PIPPacketHead;
  headlen,totallen:integer;
  psourip,pdestip:PIPAddr;
  pTCPHead:PTCPPacketHead;
  sourport,destport:Word;
  seqno,ackno:DWord;
  pdata:PByte;
  pICMPHead:PICMPPacketHead;
begin
      	pIPHead:=PIPPacketHead(PPack);
      	headlen:=(pIPHead.VerHLen) and $f;
      	headlen:=4*headlen;
      	totallen:=swap(pIPHead.TtlLen);
      	psourip:=@(pIPHead.SourIP);
      	pdestip:=@(pIPHead.DestIP);
     	case (pIPHead.Proto) of
      	 IP_PROTO_TCP: ///* TCP packet */
          begin
      	    pTCPHead:=PTCPPacketHead(PPack);
      	    totallen:=totallen-headlen;
      	    sourport:=swap(pTCPHead.SourPort);
      	    destport:=swap(pTCPHead.DestPort);
      	    seqno:=swapl(pTCPHead.SeqNo);
      	    ackno:=swapl(pTCPHead.AckNo);
      	    headlen:=(pTCPHead.HLen) shr 4;
      	    headlen:=4*headlen;
      	    totallen:=totallen-headlen;
      	    pdata:=PByte(DWord(pTCPHead)+headlen);
      	    ///* TODO */
            memo1.Lines.Add('TCP packet  '+IPAddrToStr(psourip)
              +':'+inttostr(sourport)
              +'->'+IPAddrToStr(pdestip)
              +':'+inttostr(destport)
              +'  Bytes:'+inttostr(totallen));
          end;
{      	case IP_PROTO_UDP:	//* UDP packet */
      		pUDPHead=(struct UDPPacketHead *)(Buffer+ETHER_HEAD_LEN+headlen);
      		totallen-=headlen;
      		sourport=swaps(pUDPHead->SourPort);
      		destport=swaps(pUDPHead->DestPort);
      		pdata=((BYTE *)pUDPHead)+UDP_HEAD_LEN;
      		//* TODO */
      		totallen-=UDP_HEAD_LEN;
      		flag=TRUE;
      		if(cmdline.option&OPT_LISTEN_PORT) {
      			flag=FALSE;
      			if((cmdline.option&OPT_LISTEN_PORT_1)&&
      			   (cmdline.queport[0]==sourport||
      			    cmdline.queport[0]==destport))
      				flag=TRUE;
      			else if((cmdline.option&OPT_LISTEN_PORT_2)&&
      				     ((cmdline.queport[0]==sourport&&cmdline.queport[1]==destport)||
      					  (cmdline.queport[0]==destport&&cmdline.queport[1]==sourport)))
      				flag=TRUE;
      		}
{      		else if(cmdline.option&OPT_LISTEN_INIT) {
      			flag=FALSE;
      			for(i=0;i<inifile.portno;i++)
      				if(sourport==inifile.qport[i]||
      				   destport==inifile.qport[i]) break;
      			if(i<inifile.portno) flag=TRUE;
      		}
{      		if(flag) {
      			PrintIPAddr(pfout,psourip);
      			fprintf(pfout,":%d -> ",sourport);
      			PrintIPAddr(pfout,pdestip);
      			fprintf(pfout,":%d\n",destport);
      			fprintf(pfout,"%d Byte(s) UDP Message:",totallen);
      			PrintData(pfout,pdata,totallen);
      			fprintf(pfout,"\n");
      		}
//      		break;
      	 IP_PROTO_ICMP:	//* ICMP packet */
      	  begin
      	    pICMPHead:=PICMPPacketHead(PPack);
      	    totallen:=totallen-headlen;
      	    pdata:=PByte(DWord(pICMPHead)+ICMP_HEAD_LEN);
      	    totallen:=totallen-ICMP_HEAD_LEN;
      	    //* TODO */
            memo1.Lines.Add('ICMP packet  '+IPAddrToStr(psourip)
              +':'+inttostr(sourport)
              +'->'+IPAddrToStr(pdestip)
              +':'+inttostr(destport)
              +'  Bytes:'+inttostr(totallen));
          end;
      	 else;	//* Unknown packet */
//      	   memo1.lines.add('Unknown ip packet type.');
         end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Memo1.clear;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  temp[0]:=char(i);
  inc(i);
  SendEtherPacket(hVxd,@m_EtherAddr1,@m_EtherAddr2,$5060,@temp,10);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  timer1.Enabled:=true;
end;

end.