Hi,

I was try this code to block the ICMP connections but not work (block all connections).

The complete project is here: www.pro-software.it/filter.zip


Private Const FILTER_PROTO_ANY = 0
Private Const FILTER_PROTO_ICMP = 1
Private Const FILTER_PROTO_TCP = 6
Private Const FILTER_PROTO_UDP = 11
Private Const FILTER_TCPUDP_PORT_ANY = 0
Private Const FILTER_ICMP_TYPE_ANY = 255
Private Const FILTER_ICMP_CODE_ANY = 255

Private Const FD_FLAGS_NOSYN = 1
Private Const FD_FLAGS_ALLFLAGS = FD_FLAGS_NOSYN

Private Const IP_LOCALHOST = "andreavb.ipowermysql.com"
Private Const IP_MASKALL = "0.0.0.0"
Private Const IP_MASKNONE = "255.255.255.255"

Private Enum ENUM_PFADDRESSTYPE
    PF_IPV4 = 0
    PF_IPV6 = 1
End Enum

Private Enum ENUM_PF_ACTION
    PF_ACTION_FORWARD = 0
    PF_ACTION_DROP = 1
End Enum

Private Type PPF_FILTER_DESCRIPTOR
    dwFilterFlags As Long
    dwRule As Long
    pfatType As ENUM_PFADDRESSTYPE ' Long
    SrcAddr As Long
    SrcMask As Long
    DstAddr As Long
    DstMask As Long
    dwProtocol As Long
    fLateBound As Long
    wSrcPort As Integer
    wDstPort As Integer
    wSrcPortHighRange As Integer
    wDstPortHighRange As Integer
End Type

Private Declare Function PfCreateInterface Lib "Iphlpapi.dll" Alias "_PfCreateInterface@24" (dwName As Long, inAction As ENUM_PF_ACTION, outAction As ENUM_PF_ACTION, bUseLog As Boolean, bMustBeUnique As Boolean, ppInterface As Long) As Long

Private Declare Function PfBindInterfaceToIPAddress Lib "Iphlpapi.dll" Alias "_PfBindInterfaceToIPAddress@12" (ByVal pInterface As Long, PFADDRESSTYPE As ENUM_PFADDRESSTYPE, IPAddress As Any) As Long

Private Declare Function PfAddFiltersToInterface Lib "Iphlpapi.dll" Alias "_PfAddFiltersToInterface@24" (ByVal ih As Long, ByVal cInFilters As Long, ByRef pfiltIn As Any, ByVal cOutFilters As Long, ByRef pfiltOut As Any, ByRef pfHandle As Any) As Long

Public Function Test() As Long

    Dim Result As Long
    Dim Handle As Long
    Dim Handle3 As Long
    Dim ArrIP(3) As Byte
    Dim ArrIP2(3) As Byte
    Dim ArrIP3(3) As Byte
    Dim InFilter As PPF_FILTER_DESCRIPTOR
    Dim OutFilter As PPF_FILTER_DESCRIPTOR
    Dim StrHostIP As String
            
    'For detect local IP
    'Debug.Print Form1.Winsock1.LocalIP
            
    'My local IP (change it if is different)
    ArrIP(0) = 82
    ArrIP(1) = 57
    ArrIP(2) = 73
    ArrIP(3) = 156
    
    'OK
    Result = PfCreateInterface(0&, PF_ACTION_FORWARD, PF_ACTION_FORWARD, False, True, Handle)
    
    'After this all connections are blocked
    Result = PfBindInterfaceToIPAddress(Handle, ByVal PF_IPV4, ArrIP(0))
  
    InFilter.dwFilterFlags = FD_FLAGS_NOSYN
    InFilter.pfatType = PF_IPV4
    InFilter.dwRule = 0
    InFilter.dwProtocol = FILTER_PROTO_ICMP
    InFilter.wSrcPort = FILTER_ICMP_CODE_ANY
    InFilter.wSrcPortHighRange = FILTER_TCPUDP_PORT_ANY
    InFilter.wDstPort = FILTER_TCPUDP_PORT_ANY
    InFilter.wDstPortHighRange = FILTER_TCPUDP_PORT_ANY
    InFilter.fLateBound = 0
    
    OutFilter.dwFilterFlags = FD_FLAGS_NOSYN
    OutFilter.pfatType = PF_IPV4
    OutFilter.dwRule = 0
    OutFilter.dwProtocol = FILTER_PROTO_ICMP
    OutFilter.wSrcPort = FILTER_TCPUDP_PORT_ANY
    OutFilter.wSrcPortHighRange = FILTER_TCPUDP_PORT_ANY
    OutFilter.wDstPort = FILTER_TCPUDP_PORT_ANY
    OutFilter.wDstPortHighRange = FILTER_TCPUDP_PORT_ANY
    OutFilter.fLateBound = 0
    
    InFilter.SrcAddr = VarPtr(InFilter.SrcAddr)
    InFilter.SrcMask = VarPtr(InFilter.SrcMask)
    InFilter.DstAddr = VarPtr(InFilter.DstAddr)
    InFilter.DstMask = VarPtr(InFilter.DstMask)

    OutFilter.SrcAddr = VarPtr(OutFilter.SrcAddr)
    OutFilter.SrcMask = VarPtr(OutFilter.SrcMask)
    OutFilter.DstAddr = VarPtr(OutFilter.DstAddr)
    OutFilter.DstMask = VarPtr(OutFilter.DstMask)
    
    'After and previous this all connections are blocked
    Result = PfAddFiltersToInterface(Handle, 1, InFilter, 1, OutFilter, Handle3)
    
End Function


Can anyone help me to solve this problem ?