pcap.pas

Magenta Systems Internet Packet Monitoring Components are a set of Delphi components designed to cap

end;


//------------------------------------------------------------------------------
//int pcap_read(pcap_t *p, int cnt, pcap_handler callback, u_char *user)
//
//------------------------------------------------------------------------------
function pcap_read( p:PPcap;cnt:integer;CallBack:Tpcap_handler;User:pointer)
         : integer;
var cc   : Longword;//Counter ?
    n    : integer;
    bp,ep: pointer; //Begin and End Point ?
    //bhp  : Pbpf_hdr;//pointer to BPF header struct - removed by Lars Peter
    hdrlen,         //Length of Header
    caplen: integer;//Length of captured
begin
  if NOT LoadPacketDll then
  begin
     p.errbuf := 'Cannot load packet.dll';
     result:=-1;
     exit;
  end;
  cc := p.cc;
  n  := 0;

  if p.cc = 0 then
    begin

       // *Capture the Packets*
         if PacketReceivePacket(p.adapter,p.packet,TRUE)=false then
         begin
           // ERROR!
           p.errbuf :='Read Error: PacketRecievePacket failed';
           result:=-1;
           exit;
         end;
         cc := p.packet.ulBytesReceived;

         bp := p.buffer;

    end else bp := p.bp;


    // Loop through each packet.

    ep := ptr(longword(bp)+cc); //move end pointer
    while (longword(bp) < longword(ep) ) do
      begin
        caplen := Pbpf_hdr(bp).bh_caplen;
        hdrlen := Pbpf_hdr(bp).bh_hdrlen;

        // XXX A bpf_hdr matches apcap_pkthdr.

        callback(user,
                 Ppcap_pkthdr(bp),
                 ptr(longword(bp)+longword(HdrLen)));

        LongWord(bp) := LongWord(bp) + BPF_WORDALIGN(caplen + hdrlen);
        inc(n);
        if (n >= cnt)and(cnt>0) then
          begin
            p.bp := bp;
            p.cc := longword(ep)-longword(bp);
            result := n;
            exit;
          end;
      end;

   p.cc := 0;
   result:=n;
end;


//------------------------------------------------------------------------------
// int pcap_stats(pcap_t *p, struct pcap_stat *ps)
//
//------------------------------------------------------------------------------
function pcap_stats(P: pPcap;ps:PPcap_stat) : integer;
var s:Tbpf_stat;
begin
    if NOT LoadPacketDll then
    begin
        p.errbuf := 'Cannot load packet.dll';
        result:=-1;
        exit;
    end;
    if PacketGetStats(
                      P.Adapter,
                      @s) = false then
    begin
      P.errbuf := 'PacketGetStats error';
      result := -1;
      exit;
    end;

    ps.ps_recv := s.bs_recv;
    ps.ps_drop := s.bs_drop;
    result:= 0;
end;

//------------------------------------------------------------------------------
// int pcap_setbuff(pcap_t *p, int dim)
//
//------------------------------------------------------------------------------
function pcap_setbuff(p : Ppcap;dim:integer) : integer;
begin

    if NOT LoadPacketDll then
    begin
        p.errbuf := 'Cannot load packet.dll';
        result:=-1;
        exit;
    end;
    if p=nil then
    begin
      result:=-2;
      P.errbuf := 'invalid pcap handle';
      exit;
    end;

    if PacketSetBuff(p.adapter,dim)=false then
    begin
      P.Errbuf := 'Driver error : Not enough memory to allocate buffer';
      result := -1;
      exit;
    end;
    result := 0;
end;


//------------------------------------------------------------------------------
//  void pcap_close(pcap_t *p)
//
// Very simplified from the original
//------------------------------------------------------------------------------
procedure pcap_close(var p : ppcap);
begin

  if NOT LoadPacketDll then exit ;
  if p=nil then exit;
  if p.Adapter<>nil then
    begin
      PacketCloseAdapter(p.adapter);
      p.adapter:=nil;
    end;

  if p.buffer<>nil then
    begin
      FreeMem(P.buffer,p.bufsize);
      p.buffer := nil;
    end;
  FreeMem(p,sizeof(Tpcap));
  p:=nil;
end;



//------------------------------------------------------------------------------
//
//     Following procedures is taken from inet.c part of Pcap
//
//------------------------------------------------------------------------------


//------------------------------------------------------------------------------
//int pcap_loop(pcap_t *p, int cnt, pcap_handler callback, u_char *user)
//------------------------------------------------------------------------------
{pcap_loop() is similar to pcap_dispatch() except it keeps reading
packets until cnt packets are processed or an error occurs. It does
not return when live read timeouts occur. Rather, specifying a
non-zero read timeout to pcap_open_live() and then calling
pcap_dispatch() allows the reception and processing of any
packets that arrive when the timeout occurs. A negative cnt
causes pcap_loop() to loop forever (or at least until an error
occurs).
}
function pcap_loop(P:Ppcap;cnt:integer;Callback:Tpcap_handler;user:pointer):integer;
begin
  result:=-1;
  if NOT LoadPacketDll then
  begin
     p.errbuf := 'Cannot load packet.dll';
     exit;
  end;
  if p=nil then exit;
  while true do begin

      if p.sf.rfile<>0 then
        begin
          result:= -1; //pcap_offline_read(p,cnt,callback,user);
          exit;
        end
      else Repeat
          // Keep reading until we get something(or get an error)
             result := pcap_read(p,cnt,callback,user);
           until result<>0;

      if result<=0 then exit;

      if cnt>0 then
        begin
          cnt:=cnt-result;
          if cnt<=0 then
            begin
              result:=0;
              exit;
            end;
        end;
  end;
end;



//------------------------------------------------------------------------------
{int pcap_dispatch(pcap_t *p, int cnt, pcap_handler callback, u_char *user)}
//------------------------------------------------------------------------------
{pcap_dispatch() is used to collect and process packets. cnt
specifies the maximum number of packets to process before returning.
A cnt of -1 processes all the packets received in one buffer.
A cnt of 0 processes all packets until an error occurs, EOF is
reached, or the read times out (when doing live reads and a
non-zero read timeout is specified). callback specifies a routine
to be called with three arguments: a u_char pointer which is
passed in from pcap_dispatch(), a pointer to the pcap_pkthdr
struct (which precede the actual network headers and data),
and a u_char pointer to the packet data. The number of packets read
is returned. Zero is returned when EOF is reached in a
``savefile.'' A return of -1 indicates an error in which
case pcap_perror() or pcap_geterr() may be used to display the
error text.}

function pcap_dispatch(P :pPcap;cnt:integer;CallBack:Tpcap_handler;User:pointer)
         :integer;
begin
  if NOT LoadPacketDll then
  begin
     p.errbuf := 'Cannot load packet.dll';
     result:=-1;
     exit;
  end;
  if P.sf.rfile<>0 Then
      result := -1//pcap_offline_read(p,cnt,callback,user)
  else
      result := pcap_read(p,cnt,callback,user)
end;


//------------------------------------------------------------------------------
//char * pcap_lookupdev(errbuf)
//------------------------------------------------------------------------------
//*
// * Return the name of a network interface attached to the system, or NULL
// * if none can be found.  The interface must be configured up; the
// * lowest unit number is preferred; loopback is ignored.
//
function pcap_lookupdev(var ErrStr:string) : pchar;
var   NameLength   : integer;
      AdapterNames : array[0..1024-1] of char;
      WadapterNames: array[0..1024-1] of widechar;
      i            : integer;
      AdapterName1 : Pchar;
      pversion     : string;
      wideflag     : boolean ;
//      Ver          : Twinversion;
begin
   Result := Nil ;
   if NOT LoadPacketDll then
   begin
     ErrStr:='Cannot load packet.dll';
     exit;
   end;
   NameLength := 1024;
   pversion := PacketGetVersion ;  // of packet.dll
   wideflag := false ;
   if ((Length (pversion) > 3)) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
   begin
       if pversion [1] = '2' then wideflag := true ;
       if Pos ('3.0', pversion) = 1 then wideflag := true ;
   end ;
//   Ver := pcap_GetwinVersion(S);

   // WINDOWS 95,98 or ME
//   if (Ver=wv_Win9x) then     // Angus 
   if NOT wideflag then
   begin
     GetMem(AdapterName1,NameLength);
     PacketGetAdapterNames(AdapterNames,@NameLength);
     i:=0;
     While i<NameLength do
     begin
       if AdapterNames[i]=' ' then AdapterName1[i]:=#0
                             else AdapterName1[i]:= AdapterNames[i];
       if AdapterNames[i]=#0 then break else inc(i);
     end;

     AdapterName1[i-1] := #0;
     AdapterName1[i+1] := #0;
     AdapterName1[i]   := #0;

     result := Adaptername1;
   end
   // WINDOWS NT,2000 or XP
   Else{ if (ver=wv_winNT) or (ver=wv_win2000) or (ver=wv_winXP) then }
   begin
     Getmem(AdapterName1,1024*Sizeof(char));
     PacketGetAdapterNames(Pchar(@wAdapterNames),@NameLength);

     for i:=0 to NameLength-1 do
     begin
       if (Wadapternames[i]=#0)and(wadapternames[i+1]=#0) then break;
       AdapterName1[i] := char(wAdapterNames[i]);
     end;

     result := adaptername1;
   end;

end;

//------------------------------------------------------------------------------
// int pcap_datalink(pcap_t *p)
//------------------------------------------------------------------------------
// Returns the link type of the device
function pcap_datalink(P:PPcap) : integer;
begin
  result := p.linktype;
end;


//------------------------------------------------------------------------------
// Get OS version // Added By Lars Peter
//------------------------------------------------------------------------------
function pcap_GetWinVersion(var VerStr:string) : TWinVersion;
var
OSversion:OSVERSIONINFO;
begin
  OSversion.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
  result := wv_unknown;
  if not GetVersionEx(osversion) then exit;

  with OSversion do begin
  Case dwPlatformId of
    VER_PLATFORM_WIN32s:
      begin
        verStr:=Format('Windows %d.%d',[dwMajorVersion,dwMinorVersion]);
        result:=Wv_wins;
      end;
    VER_PLATFORM_WIN32_WINDOWS:
      begin
  	case dwMinorVersion of
          0 : verstr := 'Windows 95';
         10 : verstr := 'Windows 98';
         90 : verstr := 'Windows Me';
        end;
        Result := Wv_win9x;