netfun.~pa

网络监听程序

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;
           InBuff:array of Byte):PBYTE;
function RecvStart(hVxD:THandle;packtab:PPacketTable):SmallInt;
function swapl(x:DWord):DWord;
function SendPacket(hVxD:Thandle;pbuf:PByte;len:Word):SmallInt;
function SendStart(hVxD:THandle;packtab:PPacketTable):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;
  InBuff:array [0..(sizeof(PACKET_OID_DATA) + 127)] of Byte;
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;
        GetOverLappedResult(hVxD,ovlp,cbRet,TRUE);
    end;
    result:=cbRet;
end;

function SetOid(hVxD:THandle; ulOid,ulLength,data:ULong;
           InBuff:array of Byte):PBYTE;
var
  cbin: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);

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

function RecvStart(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_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;
  SendTab:PacketTable;
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 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;

end.