netfun.pas

网络监听程序

unit netfun;

interface

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

function Bind(hVxD:THandle;inBuffer:PChar):integer;
function GetHardEtherAddr(hVxD:THandle;pethaddr:PEtherAddr):SmallInt;
function QueryOid(hVxD:THandle; ulOid,ulLength:ULong):PByte;
function QueryPacket(hVxD:THandle; ioctl:ULong; inBuffer:PByte; cbIn:DWord;
				  outBuffer:PByte; cbOut:DWord):DWord;
function SetOid(hVxD:THandle; ulOid,ulLength,data:ULong):PBYTE;
function RecvPacket(hVxD:THandle; pbuf:PByte):SmallInt;
function RecvStart(hVxD:THandle;packtab:PPacketTable):SmallInt;
function swapl(x:DWord):DWord;
function IPAddrToStr(addr:PIPAddr):string;
function SendStart(hVxD:THandle;packtab:PPacketTable):SmallInt;
function SendPacket(hVxD:Thandle;pbuf:PByte;len:Word):SmallInt;
function SendEtherPacket(hVxD:THandle;psourether,pdestether:PEtherAddr;
                       ServeType:Word;pbuf:PByte;len:Word):SmallInt;

implementation

function Bind(hVxD:THandle;inBuffer:PChar):integer;
var hEvent:THandle;
    cbRet:DWord;
    ovlp:OVERLAPPED;
    Povlp:POverlapped;
    cbIn:integer;
    dwresult:Bool;
    inB:array [0..9] of char;
    PinB:PChar;
begin
    cbIn := 5;
    cbRet:=0;
    move(inBuffer^,inB,5);
    PinB:=inB;

    hEvent := CreateEvent(nil, TRUE, false, nil);
    if(hEvent=0) then
    begin
      showmessage('Can not create event');
      result:=SYSERR;
      exit;
    end;

    ovlp.Internal:=0;
    ovlp.InternalHigh:=0;
    ovlp.Offset:=0;
    ovlp.OffsetHigh:=0;
    ovlp.hEvent:=hEvent;
    Povlp:=@ovlp;

    dwresult := DeviceIoControl(hVxD,
		 IOCTL_PROTOCOL_BIND,
		 PinB,
		 cbIn,
		 PinB,
		 cbIn,
		 cbRet,
		 Povlp);

    if (not(dwresult)) then
    begin
        cbRet:=GetLastError();
        showmessage(inttohex(cbRet,8));
        GetOverlappedResult(hVxD, ovlp, cbRet, TRUE);
    end;

    CloseHandle(hEvent);
    result:= OK;
end;

function GetHardEtherAddr(hVxD:THandle;pethaddr:PEtherAddr):SmallInt;
var
  buffer:PByte;
begin
    buffer := QueryOid(hVxD, OID_802_3_CURRENT_ADDRESS, 6);

    if (buffer<>nil) then
    begin
      move(buffer^,pethaddr.AddrByte,6);
      result:=OK;
    end else
    result:=SYSERR;
end;

function QueryOid(hVxD:THandle; ulOid,ulLength:ULong):PByte;
var
  cbin,cbRet,a:DWord;
  ioctl:ULong;
  pOidData:PPACKET_OID_DATA;
begin
    cbIn := sizeof(PACKET_OID_DATA) + ulLength;
    pOidData:= PPACKET_OID_DATA(@InBuff);

    if (ulOid >= OID_802_3_PERMANENT_ADDRESS) then
      ioctl:= IOCTL_PROTOCOL_QUERY_OID
    else ioctl:= IOCTL_PROTOCOL_STATISTICS;

    fillChar(InBuff, 0, cbIn+1);

    pOidData.Oid:= ulOid;
    pOidData.Length := ulLength;

    cbRet := QueryPacket( hVxD, ioctl, @InBuff, cbIn, @InBuff, cbIn );

    if ( cbRet > 0 ) then
    begin
      a:=sizeof(PACKET_OID_DATA);
      result:= PByte(Cardinal(@InBuff)+a-1)
    end
    else
      result:=  nil;
end;

function QueryPacket(hVxD:THandle; ioctl:ULong; inBuffer:PByte; cbIn:DWord;
				  outBuffer:PByte; cbOut:DWord):DWord;
var hEvent:THandle;
    cbRet,dwResult:DWord;
    boolResult:boolean;
    ovlp:TOVERLAPPED;
    Povlp:POverlapped;
begin
    hEvent := CreateEvent(nil, TRUE, false, nil);
    if(hEvent=0) then
    begin
      showmessage('Can not create event');
      CloseHandle(hEvent);
      result:=0;
      exit;
    end;

    ovlp.Internal:=0;
    ovlp.InternalHigh:=0;
    ovlp.Offset:=0;
    ovlp.OffsetHigh:=0;
    ovlp.hEvent:=hEvent;
    Povlp:=@ovlp;

    boolresult := DeviceIoControl(hVxD,
		 ioctl,
		 inBuffer,
		 cbIn,
		 outBuffer,
		 cbOut,
		 cbRet,
		 Povlp);
    if (not(boolresult)) then
    begin
        dwResult:=GetLastError();
//        showmessage(inttohex(cbRet,8));
        if (dwResult=ERROR_IO_PENDING) then
//          ShowMessage('VxD correctly returned operation incomplete.')
        else begin
          ShowMessage('VxD does not support the requested API!!!');
          CloseHandle(hEvent);
          result:=0;
          exit;
        end;
        boolResult:=GetOverlappedResult(hVxD, ovlp, cbRet, FALSE);
        if(not(boolResult)) then
        begin
          if(GetLastError()=ERROR_IO_INCOMPLETE) then
            ShowMessage('GetOverlappedResult returned expected value.')
          else begin
            ShowMessage('GetOverlappedResult returned unexpected error.');
            CloseHandle(hEvent);
            result:=0;
            exit;
          end;
        end;
        boolResult:=GetOverLappedResult(hVxD,ovlp,cbRet,TRUE);
    end;
    result:=cbRet;
end;

function SetOid(hVxD:THandle; ulOid,ulLength,data:ULong):PBYTE;
var
  cbin,cbRet,a:DWord;
  ioctl:ULong;
  pOidData:PPACKET_OID_DATA;
begin
    cbIn := sizeof(PACKET_OID_DATA) + ulLength;
    pOidData:= PPACKET_OID_DATA(@InBuff);

    if (ulOid = OID_GEN_CURRENT_PACKET_FILTER) then
        ioctl := ULONG (IOCTL_PROTOCOL_SET_OID);

    fillchar(InBuff, 0, cbIn+1);

    pOidData.Oid     := ulOid;
    pOidData.Length  := ulLength;
    pOidData.Data[0] := UCHAR(data);

    cbRet := QueryPacket( hVxD, ioctl, @InBuff, cbIn, @InBuff, cbIn );
    result:=0;
end;

function RecvPacket(hVxD:THandle; pbuf:PByte):SmallInt;
var
  hEvent:THandle;
  i,j,k:integer ;
  len:WORD;
  PLength:PDWord;
  temp:_OVERLAPPED;
  boolResult:boolean;
  temp1:DWord;
  temp2:PWOHandleArray;
begin
  temp1:=0;
  if(pbuf=nil) then
  begin
    result:=OK;
    exit;
  end;
  temp2:=@EventTab;
//  i:=MsgWaitForMultipleObjects(RECV_MAX,EventTab,FALSE,INFINITE,QS_ALLINPUT);
  i:=WaitForMultipleObjects(RECV_MAX,@EventTab,FALSE,INFINITE);
  if(i=WAIT_FAILED) then
  begin
    result:=SYSERR;
    exit;
  end;
  for j:=0 to RECV_MAX-1 do
    if(EventTab[i]=RecvTab[j].hEvent) then break;
  k:=j;
  if((RecvTab[k].PackType=FLAG_READ) and (RecvTab[k].Active=TRUE)) then
  begin
  //* read complete */
    boolResult:=GetOverlappedResult(hVxD,RecvTab[k].Overlap,temp1,FALSE);
    RecvTab[k].length:=temp1;
    if(RecvTab[k].Length>BUFFER_SIZE) then RecvTab[k].Length:=BUFFER_SIZE;
    move(RecvTab[k].Buffer,pbuf^,temp1);
    len:=RecvTab[k].Length;
    CloseHandle(RecvTab[k].hEvent);
    for j:=i to RECV_MAX-2 do
    begin
      EventTab[j]:=EventTab[j+1];
    end;
    hEvent := CreateEvent(nil, TRUE, false, nil);
    if(hEvent=0) then
    begin
      showmessage('Can not create event');
      result:=SYSERR;
      exit;
    end;
    RecvTab[k].hEvent:=hEvent;
    fillchar(RecvTab[k].Buffer,0,BUFFER_SIZE);
    RecvTab[k].Size:=BUFFER_SIZE;
    RecvTab[k].Active:=TRUE;
    RecvTab[k].PackType:=FLAG_READ;
    EventTab[RECV_MAX-1]:=hEvent;
    RecvStart(hVxD,@RecvTab[k]);
    result:=len;
  end
  else result:=SYSERR;
end;

function RecvStart(hVxD:THandle;packtab:PPacketTable):SmallInt;
var
  PLength:PDWord;
  boolResult:boolean;
begin
  packtab.Overlap.Internal:=0;
  packtab.Overlap.InternalHigh:=0;
  packtab.Overlap.Offset:=0;
  packtab.Overlap.OffsetHigh:=0;
  packtab.Overlap.hEvent:=packtab.hEvent;

  boolResult:=DeviceIoControl(hVxD,
     IOCTL_PROTOCOL_READ,
     @packtab.Buffer,
     packtab.Size,
     @packtab.Buffer,
     packtab.Size,
     packtab.length,
     @packtab.Overlap);

  if (boolResult) then
    result:=SYSERR
  else result:=OK;  
end;

function SendPacket(hVxD:Thandle;pbuf:PByte;len:Word):SmallInt;
var
  hEvent:THandle;
begin
  hEvent := CreateEvent(nil, TRUE, false, nil);
  if(hEvent=0) then
  begin
    showmessage('Can not create event');
    result:=SYSERR;
    exit;
  end;

  SendTab.hEvent:=hEvent;
  move(pbuf^,SendTab.Buffer,len);
  SendTab.Size:=len;
  SendTab.Length:=BUFFER_SIZE;
  SendTab.Active:=TRUE;
  SendTab.PackType:=FLAG_WRITE;
  SendStart(hVxD,@SendTab);

  GetOverlappedResult(hVxD,SendTab.Overlap,SendTab.Length,TRUE);
  result:=OK;
end;

function SendStart(hVxD:THandle;packtab:PPacketTable):SmallInt;
var
  boolResult:boolean;
begin
  packtab.Overlap.Internal:=0;
  packtab.Overlap.InternalHigh:=0;
  packtab.Overlap.Offset:=0;
  packtab.Overlap.OffsetHigh:=0;
  packtab.Overlap.hEvent:=packtab.hEvent;

  boolResult:=DeviceIoControl(hVxD,
     IOCTL_PROTOCOL_WRITE,
     @packtab.Buffer,
     packtab.Size,
     @packtab.Buffer,
     packtab.Size,
     packtab.length,
     @packtab.Overlap);

  if (boolResult) then
    result:=SYSERR
  else result:=OK;
end;

function SendEtherPacket(hVxD:THandle;psourether,pdestether:PEtherAddr;
                       ServeType:Word;pbuf:PByte;len:Word):SmallInt;
var
  pEtherHead:PEtherPacketHead;
  Buffer:array [0..BUFFER_SIZE-1] of byte;
  pdata:PByte;
begin
  fillchar(Buffer,0,BUFFER_SIZE);
  pEtherHead:=PEtherPacketHead(@Buffer);
  pdata:=PByte(DWord(pEtherHead)+ETHER_HEAD_LEN);
  //* Set ether head */
  move(psourether^,pEtherHead.SourEther,6);
  move(pdestether^,pEtherHead.DestEther,6);
  pEtherHead.ServType:=ServeType;
  //* Set data */
  move(pbuf^,pdata^,len);
  if(SendPacket(hVxD,@Buffer,len+ETHER_HEAD_LEN)=SYSERR) then
  begin
    showmessage('Can not send Ether packet.');
    result:=SYSERR;
  end else result:=OK;
end;

function swapl(x:DWord):DWord;
var
  b1,b2,b3,b4:DWord;
begin
	b1:=x and $ff;
	b2:=x and $ff00;
	b3:=x and $ff0000;
	b4:=x and $ff000000;

	b1:=b1 shl 24;
	b2:=b2 shl 8;
	b3:=b3 shr 8;
	b4:=b4 shr 24;

	result:=b1 or b2 or b3 or b4;
end;

function IPAddrToStr(addr:PIPAddr):string;
begin
  result:=inttostr(byte(addr.AddrByte[0]))+'.'
    +inttostr(byte(addr.AddrByte[1]))+'.'
    +inttostr(byte(addr.AddrByte[2]))+'.'
    +inttostr(byte(addr.AddrByte[3]));
end;

end.