netthr.pas

网络监听程序

unit netthr;

interface

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

type
  TNetThread = class(TThread)
    MainWnd:THandle;
    HCloseEvent:THandle;
    hVxD:THandle;
    filter:WORD;
    RecvTab:array [0..RECV_MAX-1] of PacketTable;
    EventTab:array [0..RECV_MAX] of THandle;
    InBuff:array [0..(sizeof(PACKET_OID_DATA) + 127)] of Byte;
  protected
    procedure Execute; override;
    procedure RecvPacket(i:DWord);
    procedure HandleMSG(msg:Tmsg);
//    procedure SendEtherPacket(msg:Tmsg);
  public
    constructor Create(w:THandle);
    procedure DoTerminate; override;
  end;

implementation

constructor TNetThread.Create(w:THandle);
var
  dwErrorCode:DWORD;
  i:integer;
  hEvent:THandle;
begin
  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');

    ///* Set Filter */
  SetOid(hVxD, OID_GEN_CURRENT_PACKET_FILTER, 4, filter, InBuff);

  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;
  MainWnd:=w;
  HCloseEvent:=CreateEvent(nil,True,False,nil);
  inherited Create(False);
  postmessage(MainWnd,WM_Net_Msg,Msg_Create,ThreadID);
end;

procedure TNetThread.DoTerminate;
begin
  CloseHandle(HCloseEvent);
  postmessage(MainWnd,WM_Net_Msg,Msg_Close,ThreadID);
  Terminate;
  Destroy;
end;

procedure TNetThread.Execute;
var
  dwWait: THandle;
  msg:TMsg;
begin
  EventTab[RECV_MAX]:=HCloseEvent;
  repeat
    if not PeekMessage(msg,0,0,0,PM_REMOVE) then
    begin
      dwWait := MsgWaitForMultipleObjects(RECV_MAX+1, EventTab, False,
                              INFINITE,QS_ALLINPUT);
      case dwWait of
        WAIT_OBJECT_0..WAIT_OBJECT_0+RECV_MAX-1:
          RecvPacket(dwWait-WAIT_OBJECT_0);
        WAIT_OBJECT_0 + RECV_MAX:
          break;
        WAIT_OBJECT_0 + RECV_MAX+1:
          continue;
      else
        Break;
      end;
    end else
    begin
      if msg.hwnd <> 0 then
      begin
        TranslateMessage(msg);
        DispatchMessage(msg);
        continue;
      end;
      HandleMSG(msg);
    end;
  until Terminated;
end;

procedure TNetThread.HandleMSG(msg:Tmsg);
begin
  case msg.message of
    TM_Close: SetEvent(HCloseEvent);
    TM_Send:
     begin
      if(SendPacket(hVxD,PByte(msg.wParam),msg.lParam)=SYSERR) then
        showmessage('Can not send Ether packet.');
      LocalFree(msg.wParam);
     end;
  end;
end;

procedure TNetThread.RecvPacket(i:DWord);
var
  hEvent:THandle;
  j,k:integer ;
  pbuf:PByte;
  pEtherHead:PEtherPacketHead;
begin
  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 */
    GetOverlappedResult(hVxD,RecvTab[k].Overlap,RecvTab[k].length,FALSE);
    pEtherHead:=PEtherPacketHead(@RecvTab[k].Buffer);
//    if (pEtherHead.DestEther.AddrByte[0]=$ab) then
    begin
      pbuf:=PByte(LocalAlloc(LMEM_FIXED,MAX_PACKET_SIZE));
      move(RecvTab[k].Buffer,pbuf^,15);
      postmessage(MainWnd,WM_Net_Recv,DWord(pbuf),RecvTab[k].length);
    end;
    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');
      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]);
  end
end;

end.