pcap.pas

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

      end;
   VER_PLATFORM_WIN32_NT:
     begin
  	 if (dwMajorVersion=5)and (dwMinorVersion=0) then
           begin
              verstr:='Windows 2000';
              if szCSDVersion<>'' then Verstr:=verstr+' with '+szCSDVersion;
              result := wv_win2000;
           end
         else if (dwMajorVersion=5)and(dwMinorVersion=1) then
           begin
             verstr:=Format('Windows XP %s',[szCSDVersion]);
             if szCSDVersion<>'' then Verstr:=verstr+' with '+szCSDVersion;
             result := wv_winxp;
           end
         else if(dwMajorVersion<=4) then
	    begin
              verstr:=Format('Windows NT %d.%d',[dwMajorVersion,dwMinorVersion]);
              if szCSDVersion<>'' then Verstr:=verstr+' with '+szCSDVersion;
              result:=wv_winNT;
            end
         else
             //for newest windows version
	    verstr:=format('Windows %d.%d ',[dwMajorVersion,dwMinorVersion]);
     end;
   end;
  end;
end;

//------------------------------------------------------------------------------
// Get All AdapterNames seperated with chosen delimiter // Added By Lars Peter
// angus - note this function does not return the adaptor friendly descriptions
//------------------------------------------------------------------------------
function Pcap_GetAdapternames(Delimiter:char;var ErrStr:string):string;
var
    NameList : Array [0..(4096*2)-1] of char;
    NameLength,  i :Longword;
//    Ver      :Twinversion;
    pversion : string;
    wideflag : boolean ;
begin
   result := '' ;
   ErrStr := '' ;
   if NOT LoadPacketDll then
   begin
      ErrStr:='Cannot load packet.dll';
      exit;
   end;
//   Ver := pcap_GetwinVersion(S);
    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 ;
   NameLength := 4096;
   FillChar (NameList, Sizeof(NameList), 0) ;
   PacketGetAdapterNames(NameList,@NameLength);

   // WINDOWS 95,98 or ME and all Windows for Winpcap 3.1 and later, 8bits per character
//   if (Ver=wv_Win9x) or (Ver=wv_WinXP)then
   if NOT wideflag then
   begin
     for i:=0 to NameLength-1 do
     begin
       if ((NameList[i]=#0) and (NameList[i+1]=#0))then
           break
       else if {(NameList[i]=' ') or} (NameList[i]=#0) then  // Angus - spaces allowed in names
           NameList[i]:=delimiter;
     end;
     result := NameList;
   end

   // WINDOWS NT,2000 or XP     16bits per character - only for Wincap 3.0 and earlier
   Else
   begin
     for i:=0 to NameLength-1 do
     begin
       if (Pwidechar(@NameList)[i]=#0) and (PwideChar(@namelist)[i+1]=#0) then
          break
       else if (Pwidechar(@NameList)[i]=#0) then
           PwideChar(@NameList)[i]:=WideChar(delimiter);
     end;
     result := WideCharToString(PWideChar(@NameList)) ;
   end;

end;

//------------------------------------------------------------------------------
// Get All AdapterNames into two TStringLists, return total adaptors
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetAdapternamesEx (NameList, DescList: TStringList; var ErrStr: string): integer ;
var
    NameBuff : Array [0..4096-1] of char;
    CurChar, CurName: PChar ;
    CurWChar, CurWName: PWideChar ;
    newname, pversion: string;
    BuffLen: integer;
    wideflag, descflag: boolean ;
begin
    result := 0 ;
    ErrStr := '' ;
    if NOT LoadPacketDll then
    begin
        ErrStr:='Cannot load packet.dll';
        exit;
    end;
    if (NOT Assigned (NameList)) or (NOT Assigned (DescList)) then
    begin
        ErrStr:='String List not intialised';
        exit;
    end;
    NameList.Clear ;
    DescList.Clear ;
    BuffLen := 4096;
    FillChar (NameBuff, BuffLen, 0) ;
    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 ;
    if NOT PacketGetAdapterNames (NameBuff, @BuffLen) then
    begin
        ErrStr:= 'Failed to get adaptor names';
        exit;
    end;
    descflag := false ;
    CurChar := NameBuff ;
    CurName := CurChar ;
    if wideflag then   // winpcap 3.0 returns lists of unicode adapter names followed by list of ASCII adapter descriptions
    begin
        CurWChar := PWideChar (@NameBuff) ;
        CurWName := CurWChar ;
        while true do
        begin
            if NOT descflag then  // get adaptor names first
            begin
                if (CurWChar^ = #0) then
                begin
                    if (CurWChar = CurWName) then  // double null
                    begin
                        descflag := true ;
                        CurChar := PChar (CurWChar) ;  // next string is ASCII
                        inc (CurChar, 2) ;
                        CurName := CurChar ;
                    end
                    else
                    begin
                        newname := Trim (WideCharToString (CurWName)) ;  // convert WPChar to string 
                        NameList.Add (newname) ;
                    end ;
                    CurWName := CurWChar ;
                    inc (CurWName) ;
                end ;
                inc (CurWChar) ;
            end
            else
            begin         // getting ASCII adaptor descriptions
               if (CurChar^ = #0) then
               begin
                    if (CurChar = CurName) then break ; // second double null 
                    newname := Trim (CurName) ;  // convert PChar to string
                    DescList.Add (newname) ;
                    CurName := CurChar + 1 ;
                    if NameList.Count = DescList.Count then break ;  // found same number, stop
                end ;
                inc (CurChar) ;
            end ;
        end;
    end
    else
    begin
       while true do
       begin
           if (CurChar^ = #0) then
           begin
                if (CurChar = CurName) then    // double null 
                begin
                    if descflag then break ;   // second double null
                    descflag := true ;
                end
                else
                begin
                    newname := Trim (CurName) ;  // convert PChar to string
                    if descflag then
                        DescList.Add (newname)
                    else
                        NameList.Add (newname) ;
                    if NameList.Count = DescList.Count then break ;  // found same number, stop
                end ;
                CurName := CurChar + 1 ;
            end ;
            inc (CurChar) ;
        end;
    end ;
    result := NameList.Count ;
end ;

//------------------------------------------------------------------------------
// Get netgroup packet filter driver version - npf.sys   - 3.1 and later only
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetDriverVersion: string ;
begin
   result := '' ;
   if NOT LoadPacketDll then
   begin
      result:='Cannot load packet.dll';
      exit;
   end;
   if NOT Assigned (PacketGetDriverVersion) then
   begin
      result:='Version not available';
      exit;
   end;
   result := PacketGetDriverVersion ;
end ;

//------------------------------------------------------------------------------
// Get packet driver DLL version - packet.dll
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetPacketVersion: string ;
begin
   result := '' ;
   if NOT LoadPacketDll then
   begin
      result:='Cannot load packet.dll';
      exit;
   end;
   result := PacketGetVersion ;
end ;

//------------------------------------------------------------------------------
// Get adaptor link information, IP addresses, masks and broadcast addresses
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetIPAddresses (AdapterName: string ; var IPArray, MaskArray,
                             BcastArray: IPAddrArray; var ErrStr:string): integer ;
var
    NetInfo, CurInfo: Pnpf_if_addr ;
    CurInfo30: Pnpf_if_addr30 ;
    BuffLen, MaxEntries, I: integer ;
    pversion: string ;
    v30flag: boolean ;
begin
   result := 0 ;
   ErrStr := '' ;
   if NOT LoadPacketDll then
   begin
      ErrStr:='Cannot load packet.dll';
      exit;
   end;
   pversion := PacketGetVersion ;  // of packet.dll
   v30flag := false ;
   if ((Length (pversion) > 3)) then
   begin
       if pversion [1] = '2' then v30flag := true ;
       if Pos ('3.0', pversion) = 1 then v30flag := true ;
   end ;
   MaxEntries := 10 ;
   BuffLen := SizeOf (Tnpf_if_addr) * MaxEntries ;
   GetMem (NetInfo, BuffLen) ;
   FillChar (NetInfo^, BuffLen, 0) ;
   if NOT Assigned (PacketGetNetInfoEx) then exit ;
   if NOT PacketGetNetInfoEx (Pchar (AdapterName), NetInfo, @MaxEntries) then
   begin
      ErrStr:= 'Failed to get adaptor names';
      FreeMem (NetInfo) ;
      exit;
   end;
   SetLength (IPArray, MaxEntries) ;
   SetLength (MaskArray, MaxEntries) ;
   SetLength (BcastArray, MaxEntries) ;
   CurInfo := NetInfo ;
   CurInfo30 := Pnpf_if_addr30 (NetInfo) ;
   for I := 0 to Pred (MaxEntries) do
   begin
        if v30flag then
        begin
            IPArray [I] := CurInfo30.IPAddress.sin_addr ;
            MaskArray [I] := CurInfo30.SubnetMask.sin_addr ;
            BcastArray [I] := CurInfo30.Broadcast.sin_addr ;
            Pchar (CurInfo30) := Pchar (CurInfo30) + SizeOf (Tnpf_if_addr30) ;
        end
        else
        begin
            Move (CurInfo.IPAddress.__ss_pad1 [2], IPArray [I], 4) ;
            Move (CurInfo.SubnetMask.__ss_pad1 [2], MaskArray [I], 4) ;
            Move (CurInfo.Broadcast.__ss_pad1 [2], BcastArray [I], 4) ;
            Pchar (CurInfo) := Pchar (CurInfo) + SizeOf (Tnpf_if_addr) ;
        end ;
   end ;
   FreeMem (NetInfo) ;
   result := MaxEntries ;
end ;

//------------------------------------------------------------------------------
// Set minimum data for driver to return
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_SetMinToCopy (P: pPcap ; nbytes: integer) : integer;
begin
    if NOT LoadPacketDll then
    begin
        p.errbuf := 'Cannot load packet.dll';
        result:=-1;
        exit;
    end;
    if NOT PacketSetMinToCopy (P.Adapter, nbytes) then
    begin
      P.errbuf := 'PacketSetMinToCopy error';
      result := -1;
      exit;
    end;
    result:= 0;
end;

//------------------------------------------------------------------------------
// Get adaptor MAC address
// Added By Angus Robertson
//------------------------------------------------------------------------------
function Pcap_GetMacAddress (P: pPcap; var ErrStr:string): TMacAddr ;
var
    OidData: array [0..20] of char ;
    POidData :PPACKET_OID_DATA ;
begin
    FillChar (Result, SizeOf (Result), 0) ;
    ErrStr := '' ;
    if NOT LoadPacketDll then
    begin
        ErrStr:='Cannot load packet.dll';
        exit;
    end;
    FillChar (OidData [0], SizeOf (OidData), 0) ;
    POidData := @OidData ;
    POidData.Oid := OID_802_3_CURRENT_ADDRESS ;
    POidData.Length := 6 ;
    if NOT PacketRequest (P.Adapter, false, POidData) then  // get data, not set it!
    begin
        ErrStr:= 'Failed to get adaptor MAC';
        exit;
    end;
    Move (POidData.Data, Result, SizeOf (Result)) ;
end ;


end.