[RESOLVED] Block IP

Hey guys I was wondering by using VB is there a way to block a certain IP address from accessing my computer?

Thanks

In what way? You can use sockets to listen on a certain port and deny the access..

RDP port is 3389..

chem

Do you have your computer, or folders on your computer, set up as Shared?

You can't really block an IP address with VB like firewalls do. The closest you'll probably get with VB, is disconnecting already established connections with the GetTcpTable and SetTcpEntry API's.

Well you know the program Peer Guardian that blocks IP I would prefer to have a specific IP blocked,

Has anyone heard of it?

@ Hack, yes I do.

This is what you can do. If can have the Ip load into a textbox or a label that is not visable and have it check with the following code:

Code:

---

If Text1.Caption = "Ip Address" Then
'Do The Following
Else
'Do This
End if

---

that code doesnt do anything. :confused:

Post #4 is what the solution would be. Just execute it on a timer checking every couple of seconds or so as not to take up too many system resources.

lol I was about to say, so I can use GetTcpTable to stop connections. I never heard of it before.

So if I have a textbox with a certain Ip in it, GetTcpTable would check to see if it was connected and then stop it?

How do I do that?

You have to use the SetTcpEntry to close the port.

GetTcpTable:
http://msdn2.microsoft.com/en-us/library/aa366026.aspx

SetTcpEntry:
http://msdn2.microsoft.com/en-us/library/aa366378.aspx


If you use the structure's data you can set the state of the port to closed (MIB_TCP_STATE_CLOSED).
http://msdn2.microsoft.com/en-us/lib...09(VS.85).aspx

Ok, so this code with print the state of each connection.

VB Code:

#include <winsock2.h>
#include <ws2tcpip.h>
#include <iphlpapi.h>
#include <stdio.h>
 
// Need to link with Iphlpapi.lib and Ws2_32.lib
 
 
#define MALLOC(x) HeapAlloc(GetProcessHeap(), 0, (x))
#define FREE(x) HeapFree(GetProcessHeap(), 0, (x))
/* Note: could also use malloc() and free() */
 
int main()
{
 
    // Declare and initialize variables
    PMIB_TCPTABLE pTcpTable;
    DWORD dwSize = 0;
    DWORD dwRetVal = 0;
 
    char szLocalAddr[128];
    char szRemoteAddr[128];
 
    struct in_addr IpAddr;
 
    int i;
 
    pTcpTable = (MIB_TCPTABLE *) MALLOC(sizeof (MIB_TCPTABLE));
    if (pTcpTable == NULL) {
        printf("Error allocating memory\n");
        return 1;
    }
 
    dwSize = sizeof (MIB_TCPTABLE);
// Make an initial call to GetTcpTable to
// get the necessary size into the dwSize variable
    if ((dwRetVal = GetTcpTable(pTcpTable, &dwSize, TRUE)) ==
        ERROR_INSUFFICIENT_BUFFER) {
        FREE(pTcpTable);
        pTcpTable = (MIB_TCPTABLE *) MALLOC(dwSize);
        if (pTcpTable == NULL) {
            printf("Error allocating memory\n");
            return 1;
        }
    }
// Make a second call to GetTcpTable to get
// the actual data we require
    if ((dwRetVal = GetTcpTable(pTcpTable, &dwSize, TRUE)) == NO_ERROR) {
        printf("\tNumber of entries: %d\n", (int) pTcpTable->dwNumEntries);
        for (i = 0; i < (int) pTcpTable->dwNumEntries; i++) {
            IpAddr.S_un.S_addr = (u_long) pTcpTable->table[i].dwLocalAddr;
            strcpy_s(szLocalAddr, sizeof (szLocalAddr), inet_ntoa(IpAddr));
            IpAddr.S_un.S_addr = (u_long) pTcpTable->table[i].dwRemoteAddr;
            strcpy_s(szRemoteAddr, sizeof (szRemoteAddr), inet_ntoa(IpAddr));
 
            printf("\n\tTCP[%d] State: %ld - ", i,
                   pTcpTable->table[i].dwState);
            switch (pTcpTable->table[i].dwState) {
            case MIB_TCP_STATE_CLOSED:
                printf("CLOSED\n");
                break;
            case MIB_TCP_STATE_LISTEN:
                printf("LISTEN\n");
                break;
            case MIB_TCP_STATE_SYN_SENT:
                printf("SYN-SENT\n");
                break;
            case MIB_TCP_STATE_SYN_RCVD:
                printf("SYN-RECEIVED\n");
                break;
            case MIB_TCP_STATE_ESTAB:
                printf("ESTABLISHED\n");
                break;
            case MIB_TCP_STATE_FIN_WAIT1:
                printf("FIN-WAIT-1\n");
                break;
            case MIB_TCP_STATE_FIN_WAIT2:
                printf("FIN-WAIT-2 \n");
                break;
            case MIB_TCP_STATE_CLOSE_WAIT:
                printf("CLOSE-WAIT\n");
                break;
            case MIB_TCP_STATE_CLOSING:
                printf("CLOSING\n");
                break;
            case MIB_TCP_STATE_LAST_ACK:
                printf("LAST-ACK\n");
                break;
            case MIB_TCP_STATE_TIME_WAIT:
                printf("TIME-WAIT\n");
                break;
            case MIB_TCP_STATE_DELETE_TCB:
                printf("DELETE-TCB\n");
                break;
            default:
                printf("UNKNOWN dwState value\n");
                break;
            }
            printf("\tTCP[%d] Local Addr: %s\n", i, szLocalAddr);
            printf("\tTCP[%d] Local Port: %d \n", i,
                   ntohs((u_short)pTcpTable->table[i].dwLocalPort));
            printf("\tTCP[%d] Remote Addr: %s\n", i, szRemoteAddr);
            printf("\tTCP[%d] Remote Port: %d\n", i,
                   ntohs((u_short)pTcpTable->table[i].dwRemotePort));
        }
    } else {
        printf("\tGetTcpTable failed with %d\n", dwRetVal);
        FREE(pTcpTable);
        return 1;
    }
 
    return 0;    
}

but where would it print to?

I dont know C++ so couldnt say for sure but looks like it would go to a console sessions screen?

http://en.wikipedia.org/wiki/Printf

So this would work in VB 6 right?

you would have to convert it to or complete write it in VB 6 and then it would work.

Actually I created a little tool to disconnect IP's a few months ago. The TCP table checking code is in a Timer with an interval of 1 millisecond (although it will probably only fire once every 15 milliseconds or so). It loads IP's from a text file. It can easily handle 100.000 ranges with more than 100 million IP's and it barely uses any resources.

Make sure there is an empty line at the end of the IP list or else there's an error at the end when loading the list. I haven't looked into that, because I've stopped working on it.

I know this is pretty old, but I with the thing Christ001 posted, I can't figure out how to open the file with all the IPs so it can be updated.

Chris's code does not include the facility to edit the list of IPs. You could always use Notepad. (or write your own Editor)

Ok I have gotten a bit lost, Chris's code will disconnect certain Ips?

How would he know which Ip's should be disconnecteD?

I suspect he spent some time doing some research on 'rogue' IP Address usage. Presumably, as you asked the question, you know of some IP Addresses that you don't want to connect to your machine (or if they do, you want to disconnect tham).

Ok so what I can do is make a database of these IP addresses I do not want connected.

So I have created my own simple listview where there are 3 columns, how may I load the database file to the corresponding columns in the listview and ahve the program search for the ip adresses in the first column and if theey find them connected, disconnect.

Or maybe I am going about this wrong, maybe i could have a list1 listview hat shows the ips trying to connect to the comp, and if there is a match between the list1 listbox and the first column of the listview then it disconnects it.

Another question I had is I have a listbox called list1, how would I be able to have all the IP addresses trying to connect to my PC be shown in that? All the ones that use TCP protocol?

Wait I got an idea, Can I have a listbox that shows all incoming IP's and have a another listbox of blacklisted IPs, where if there was a match between an incoming Ip and a black list IP it would get disconnected? How could I do this?

Well, using Chris's code as a sort of template, I knocked up this. It will read a series of IP Addresses from a text file (c:\Blacklist.txt - One IP Address per line) and populate a ListBox (lstBlacklist). It then grabs the TCP Table and extracts all the Remote Host IP Addresses, which are refreshed every second, and puts them into lstRemote. The two lists are compared, and if anything in lstBlacklist connects, or is connected, it is disconnected and a line is written to txtAction (a multiline TextBox)

Code:

---

Option Explicit

Private Declare Function GetTcpTable Lib "iphlpapi.dll" _
                (ByRef pTcpTable As Any, _
                ByRef pdwSize As Long, _
                ByVal bOrder As Long) As Long
               
Private Declare Function SetTcpEntry Lib "iphlpapi.dll" _
                (pTcpTableEx As MIB_TCPROW) As Long
               
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                (ByRef pDest As Any, _
                ByRef pSource As Any, _
                ByVal Length As Long)

Private Declare Function RtlIpv4AddressToString Lib "ntdll.dll" Alias "RtlIpv4AddressToStringA" _
                (ByRef lngAddr As Long, ByVal strAddr As String) As Long
               
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_INSUFFICIENT_BUFFER = 122

Private Type MIB_TCPROW
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
End Type

Private udtTCP() As MIB_TCPROW

Private Function GetIPInfo() As Boolean
Dim bytBuffer() As Byte
Dim lngSize As Long
Dim lngEntries As Long
Dim lngReturn As Long
Dim lngState As Long
Dim intI As Integer
Dim intOffSet As Integer
Dim strRemote As String
Dim strState As String
'
' Obtain the length of the TCP Table
'
lngReturn = GetTcpTable(lngSize, lngSize, 0)
If lngReturn = ERROR_INSUFFICIENT_BUFFER Then
    ReDim bytBuffer(lngSize - 1)
    '
    ' Get the TCP Table
    ' and populate the MIB_TCPROWs
    '
    lngReturn = GetTcpTable(bytBuffer(0), lngSize, 0)
    If lngReturn = 0 Then
        CopyMemory lngEntries, bytBuffer(0), 4
        ReDim udtTCP(lngEntries - 1)
        For intI = 0 To lngEntries - 1
            strRemote = Space(16)
            intOffSet = (intI * Len(udtTCP(intI))) + 4
            CopyMemory udtTCP(intI), bytBuffer(intOffSet), Len(udtTCP(intI))
            '
            ' Remote Addresses of zero are of no interest
            ' otherwise convert the address to dotted form
            ' and add it to the ListBox
            '
            If udtTCP(intI).dwRemoteAddr <> 0 Then
                lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
                lstRemote.AddItem Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
            End If
        Next intI
    Else
        MsgBox "Unable to Access TCP Table Entries"
    End If
Else
    MsgBox "Unable to Access TCP Table"
End If
End Function

Private Sub CheckIP()
Dim intI As Integer
Dim intJ As Integer
Dim lngReturn As Long
Dim strRemote As String
For intI = LBound(udtTCP) To UBound(udtTCP)
    strRemote = Space(15)
    lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
    strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
    For intJ = 0 To lstBlacklist.ListCount - 1
        If strRemote = Trim(lstBlacklist.List(intJ)) Then
            udtTCP(intI).dwState = 12
            lngReturn = SetTcpEntry(udtTCP(intI))
            txtAction.Text = txtAction.Text & lstBlacklist.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
        End If
    Next intJ
Next intI
End Sub

Private Sub LoadBlacklist()
Dim intFile As Integer
Dim strLine As String
intFile = FreeFile
Open "C:\Blacklist.txt" For Input As intFile
Do Until EOF(intFile)
    Line Input #intFile, strLine
    lstBlacklist.AddItem strLine
Loop
Close intFile
End Sub

Private Sub Form_Load()
lstBlacklist.Clear
Call LoadBlacklist
Call GetIPInfo
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
lstRemote.Clear
Call GetIPInfo
Call CheckIP
End Sub

---

That might get you sarted.

Loading the IP's that should be disconnected in a listview or listbox only works when you have a handful of IP's or else it takes up too much resources.

The example I created loads all IP ranges into memory, which is much faster than continuously reading the IP's from the listbox/listview and comparing them with the IP's of the established connections.

Quote:

---

Originally Posted by Doogle

Well, using Chris's code as a sort of template, I knocked up this. It will read a series of IP Addresses from a text file (c:\Blacklist.txt - One IP Address per line) and populate a ListBox (lstBlacklist). It then grabs the TCP Table and extracts all the Remote Host IP Addresses, which are refreshed every second, and puts them into lstRemote. The two lists are compared, and if anything in lstBlacklist connects, or is connected, it is disconnected and a line is written to txtAction (a multiline TextBox)

Code:

---

Option Explicit

Private Declare Function GetTcpTable Lib "iphlpapi.dll" _
                (ByRef pTcpTable As Any, _
                ByRef pdwSize As Long, _
                ByVal bOrder As Long) As Long
               
Private Declare Function SetTcpEntry Lib "iphlpapi.dll" _
                (pTcpTableEx As MIB_TCPROW) As Long
               
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                (ByRef pDest As Any, _
                ByRef pSource As Any, _
                ByVal Length As Long)

Private Declare Function RtlIpv4AddressToString Lib "ntdll.dll" Alias "RtlIpv4AddressToStringA" _
                (ByRef lngAddr As Long, ByVal strAddr As String) As Long
               
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_INSUFFICIENT_BUFFER = 122

Private Type MIB_TCPROW
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
End Type

Private udtTCP() As MIB_TCPROW

Private Function GetIPInfo() As Boolean
Dim bytBuffer() As Byte
Dim lngSize As Long
Dim lngEntries As Long
Dim lngReturn As Long
Dim lngState As Long
Dim intI As Integer
Dim intOffSet As Integer
Dim strRemote As String
Dim strState As String
'
' Obtain the length of the TCP Table
'
lngReturn = GetTcpTable(lngSize, lngSize, 0)
If lngReturn = ERROR_INSUFFICIENT_BUFFER Then
    ReDim bytBuffer(lngSize - 1)
    '
    ' Get the TCP Table
    ' and populate the MIB_TCPROWs
    '
    lngReturn = GetTcpTable(bytBuffer(0), lngSize, 0)
    If lngReturn = 0 Then
        CopyMemory lngEntries, bytBuffer(0), 4
        ReDim udtTCP(lngEntries - 1)
        For intI = 0 To lngEntries - 1
            strRemote = Space(16)
            intOffSet = (intI * Len(udtTCP(intI))) + 4
            CopyMemory udtTCP(intI), bytBuffer(intOffSet), Len(udtTCP(intI))
            '
            ' Remote Addresses of zero are of no interest
            ' otherwise convert the address to dotted form
            ' and add it to the ListBox
            '
            If udtTCP(intI).dwRemoteAddr <> 0 Then
                lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
                lstRemote.AddItem Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
            End If
        Next intI
    Else
        MsgBox "Unable to Access TCP Table Entries"
    End If
Else
    MsgBox "Unable to Access TCP Table"
End If
End Function

Private Sub CheckIP()
Dim intI As Integer
Dim intJ As Integer
Dim lngReturn As Long
Dim strRemote As String
For intI = LBound(udtTCP) To UBound(udtTCP)
    strRemote = Space(15)
    lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
    strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
    For intJ = 0 To lstBlacklist.ListCount - 1
        If strRemote = Trim(lstBlacklist.List(intJ)) Then
            udtTCP(intI).dwState = 12
            lngReturn = SetTcpEntry(udtTCP(intI))
            txtAction.Text = txtAction.Text & lstBlacklist.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
        End If
    Next intJ
Next intI
End Sub

Private Sub LoadBlacklist()
Dim intFile As Integer
Dim strLine As String
intFile = FreeFile
Open "C:\Blacklist.txt" For Input As intFile
Do Until EOF(intFile)
    Line Input #intFile, strLine
    lstBlacklist.AddItem strLine
Loop
Close intFile
End Sub

Private Sub Form_Load()
lstBlacklist.Clear
Call LoadBlacklist
Call GetIPInfo
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
lstRemote.Clear
Call GetIPInfo
Call CheckIP
End Sub

---

That might get you sarted.

---

Ok so I have the text box, and the list boxes made but when I run the program I get the error invalid procedure call or argument and it highlights this line of code strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))

I had exactly that problem but thought I'd fixed it ! (It works ok for me!) I edited the post about 2 hours after I posted the original to correct the errors.

Is there a chance that you have the un-updated version?

The problem was that when the Long Address is converted to a string, the API terminates it with a Hex 00 (Chr(0)) so where I set strRemote as 15 characters it should have been 16. This was causing InStr to return 0 and caused the exception. Hence I changed strRemote = Space(15) to strRemote = Space(16) which is the maximum length of a dotted IP address + 1. I'd also got the brackets in a muddle and corrected that.

Could you run it again, please and when it breaks, hover the mouse over strRemote and see what the contents are.

EDIT: Thre's also a slight performance improvement that can be made to CheckIP. Ignore remoteIP addresses of 0

Code:

---

Private Sub CheckIP()
Dim intI As Integer
Dim intJ As Integer
Dim lngReturn As Long
Dim strRemote As String * 16
For intI = LBound(udtTCP) To UBound(udtTCP)
    If udtTCP(intI).dwRemoteAddr <> 0 Then
        strRemote = Space(16)
        lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
        strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
        For intJ = 0 To lstBlacklist.ListCount - 1
            If strRemote = Trim(lstBlacklist.List(intJ)) Then
                udtTCP(intI).dwState = 12
                lngReturn = SetTcpEntry(udtTCP(intI))
                txtAction.Text = txtAction.Text & lstBlacklist.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
            End If
        Next intJ
    End If
Next intI
End Sub

---

I just added the new code, and I no longer get any error cheers!

However I was wondering, the lstRemote text box, it contains IPs trying to connect to me? Or the ones connected to me?

The lstRemote ListBox displays the remotes actually connected. t's updated every second so you should see the contents changng as and when others connect or disconnect.

Excellent, thanks for your help. I was wondering though how do I know which IPs could be bad ?lol

Personally, I haven't a clue :D

However a google search with "known bad Ip addresses" came up with, for example, this http://www.unixhub.com/block.html

Perhaps Chris will pop by and tell you how he created his list.

Well, what do you consider a "bad IP"?
If you want to block "a certain IP address" from accessing your computer, like you said in your first post, then you should already know who/what you want to block.

My list are all known IP ranges used in the US. Many websites are hosted in the US, so that list can easily be used for testing purposes.

Here's an updated list with the IP ranges used in most countries in the world. It's a CSV file, so it needs to be converted first to a format your app can read.

http://ip-to-country.webhosting.info/node/view/6

Well originally I would like to block a certain anti p2p ip, but I would like to block p2p in general, gov websites, etc.

Then you can for example download the eMule list here: http://www.bluetack.co.uk/forums/ind...ewcat&cat_id=4

But those are more than 200.000 IP ranges (almost a billion IP addresses) and you will never be able to load them all into a Listbox and compare each established connection with the IP's ranges in the Listbox.

You mean one single list would have that many?

Besides the downloads are in gz format, how would VB be able to read that?

Yes, one list would have that many.

GZ is a compression format. Extract the contents from the GZ file with Winrar.

The extracted .dat file contains dotted IP ranges like this:

Code:

---

000.000.000.001 - 003.255.255.255 , 000 , Bogon,
004.000.025.146 - 004.000.025.148 , 000 , s0-0.c
004.000.026.014 - 004.000.029.024 , 000 , p1-0.c
004.001.075.131 - 004.001.075.156 , 000 , s0.med

---

Then make your app read the .dat file or convert the dotted IP's to some other format, which is easier to read.

Ok so 000.000.000.001 - 003.255.255.255 for ex cover a whole net range or just two ips? whats with the names like Bogon?

It's a whole range.

Bogon and the other ones are the names the IP ranges belong to. In this case "Bogon" (Bogus) are IP's not allocated to any Internet Service Provider.

Could I put it into an acess database file?

PS: Since this program currently blocks one single IP how would It block a netrange?

If i put a listview one where lstBlacklist is, how would I load a database to the corresponding columns if it had a net range column and a name for that range?

I'm sure you can put the ranges in a database, but that still requires continuous reading from a file.

I posted a sample project above that shows you how to disconnect a range (reply #14).

Well if the database of black lists was loaded to a listview, wouldn't it just read through the listview over and over?

Yes, but comparing an IP address with 200.000 IP ranges over and over in a Listview is very SLOW.

If you want to handle so many ranges, you'll have to load the entire list in memory and do a quicksort based on the start IP range. Then do a binary search to see if there's a match.

Well what about just 10 ip ranges?

Also what is in a ip range? How many IPs could be in a single range?

10 is fine.

From 000.000.000.000 to 255.255.255.255. You do the math.

But it doesn't matter how many IP's there are in the range... it's the amount of ranges itself.

Quote:

---

Originally Posted by Doogle

Well, using Chris's code as a sort of template, I knocked up this. It will read a series of IP Addresses from a text file (c:\Blacklist.txt - One IP Address per line) and populate a ListBox (lstBlacklist). It then grabs the TCP Table and extracts all the Remote Host IP Addresses, which are refreshed every second, and puts them into lstRemote. The two lists are compared, and if anything in lstBlacklist connects, or is connected, it is disconnected and a line is written to txtAction (a multiline TextBox)

Code:

---

Option Explicit

Private Declare Function GetTcpTable Lib "iphlpapi.dll" _
                (ByRef pTcpTable As Any, _
                ByRef pdwSize As Long, _
                ByVal bOrder As Long) As Long
               
Private Declare Function SetTcpEntry Lib "iphlpapi.dll" _
                (pTcpTableEx As MIB_TCPROW) As Long
               
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                (ByRef pDest As Any, _
                ByRef pSource As Any, _
                ByVal Length As Long)

Private Declare Function RtlIpv4AddressToString Lib "ntdll.dll" Alias "RtlIpv4AddressToStringA" _
                (ByRef lngAddr As Long, ByVal strAddr As String) As Long
               
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_INSUFFICIENT_BUFFER = 122

Private Type MIB_TCPROW
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
End Type

Private udtTCP() As MIB_TCPROW

Private Function GetIPInfo() As Boolean
Dim bytBuffer() As Byte
Dim lngSize As Long
Dim lngEntries As Long
Dim lngReturn As Long
Dim lngState As Long
Dim intI As Integer
Dim intOffSet As Integer
Dim strRemote As String
Dim strState As String
'
' Obtain the length of the TCP Table
'
lngReturn = GetTcpTable(lngSize, lngSize, 0)
If lngReturn = ERROR_INSUFFICIENT_BUFFER Then
    ReDim bytBuffer(lngSize - 1)
    '
    ' Get the TCP Table
    ' and populate the MIB_TCPROWs
    '
    lngReturn = GetTcpTable(bytBuffer(0), lngSize, 0)
    If lngReturn = 0 Then
        CopyMemory lngEntries, bytBuffer(0), 4
        ReDim udtTCP(lngEntries - 1)
        For intI = 0 To lngEntries - 1
            strRemote = Space(16)
            intOffSet = (intI * Len(udtTCP(intI))) + 4
            CopyMemory udtTCP(intI), bytBuffer(intOffSet), Len(udtTCP(intI))
            '
            ' Remote Addresses of zero are of no interest
            ' otherwise convert the address to dotted form
            ' and add it to the ListBox
            '
            If udtTCP(intI).dwRemoteAddr <> 0 Then
                lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
                lstRemote.AddItem Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
            End If
        Next intI
    Else
        MsgBox "Unable to Access TCP Table Entries"
    End If
Else
    MsgBox "Unable to Access TCP Table"
End If
End Function

Private Sub CheckIP()
Dim intI As Integer
Dim intJ As Integer
Dim lngReturn As Long
Dim strRemote As String
For intI = LBound(udtTCP) To UBound(udtTCP)
    strRemote = Space(15)
    lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
    strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
    For intJ = 0 To lstBlacklist.ListCount - 1
        If strRemote = Trim(lstBlacklist.List(intJ)) Then
            udtTCP(intI).dwState = 12
            lngReturn = SetTcpEntry(udtTCP(intI))
            txtAction.Text = txtAction.Text & lstBlacklist.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
        End If
    Next intJ
Next intI
End Sub

Private Sub LoadBlacklist()
Dim intFile As Integer
Dim strLine As String
intFile = FreeFile
Open "C:\Blacklist.txt" For Input As intFile
Do Until EOF(intFile)
    Line Input #intFile, strLine
    lstBlacklist.AddItem strLine
Loop
Close intFile
End Sub

Private Sub Form_Load()
lstBlacklist.Clear
Call LoadBlacklist
Call GetIPInfo
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
lstRemote.Clear
Call GetIPInfo
Call CheckIP
End Sub

---

That might get you sarted.

---

Ok so this code has a black list of single IP's but how would it be able to block a range if it was for ex: 000.000.000 to 255.255.255.255 and lstblacklist said 000.000.000 to 255.255.255.255

Also I have this code that opens the database to load it to lslblack list

VB Code:

Private Sub Form_Load()
 
 
txtAction.Text = txtAction.Text & vbNewLine & "++----STATUS BOX----++"
'''''Main Search Result+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 
lstBlacklist.Clear
Dim con As ADODB.Connection
Dim strSQL As String
Dim strCol As String
Set con = New ADODB.Connection
con.CursorLocation = adUseClient
con.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.path & "\DatabaseIPBlacklist.mdb;" _
    & "Jet OLEDB:Database Password=omegacron;"
strSQL = "SELECT * FROM table1"
strCol = "Field1"
Call FillCombo(lstBlacklist, con, strSQL, strCol)
con.Close
Set con = Nothing
 
 
lstBlacklist.Clear
'Call LoadBlacklist
Call GetIPInfo
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

But the prob is when the prog runs there is nothing in the lstblacklist

EDIT: I got the ranges so they go in the lstblacklist, so for ex they are like 4.42.190.0-4.42.190.7. The problem is the code looks for single IPS, how can I get it to use a net range like 4.42.190.0-4.42.190.7?

LOL I just got it to block 1000 IPs by loading them into the listbox, but I am afriad it now usess alot of CPU power all the time. Since it is suggested the blacklist file should be loaded into memory instead of a listbox, what changes would I have to make to doogles code?

Thanks!

Umm I just realized this, but when I run the program, it does not disconnect the blacklisted Ip addresses??


They remain connected, but the blacklisted Ips are loaded to lstBlacklist

Did I make a mistake?

Well, if you're using the example code I posted, this is the part which disconnects:

Code:

---

For intI = LBound(udtTCP) To UBound(udtTCP)
    strRemote = Space(15)
    lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
    strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
    For intJ = 0 To lstBlacklist.ListCount - 1
        If strRemote = Trim(lstBlacklist.List(intJ)) Then
            udtTCP(intI).dwState = 12
            lngReturn = SetTcpEntry(udtTCP(intI))
            txtAction.Text = txtAction.Text & lstBlacklist.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
        End If
    Next intJ
Next intI

---

Well to test it out, I look at the IPs already connected to my Pc and put them in the black list, but none gets disconnected, as it doesn't say anything in txtaction.

VB Code:

Option Explicit
 
Private Declare Function GetTcpTable Lib "iphlpapi.dll" _
                (ByRef pTcpTable As Any, _
                 ByRef pdwSize As Long, _
                 ByVal bOrder As Long) As Long
                 
Private Declare Function SetTcpEntry Lib "iphlpapi.dll" _
                (pTcpTableEx As MIB_TCPROW) As Long
                 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                (ByRef pDest As Any, _
                 ByRef pSource As Any, _
                 ByVal Length As Long)
 
Private Declare Function RtlIpv4AddressToString Lib "ntdll.dll" Alias "RtlIpv4AddressToStringA" _
                (ByRef lngAddr As Long, ByVal strAddr As String) As Long
                
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_INSUFFICIENT_BUFFER = 122
 
Private Type MIB_TCPROW
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
End Type
 
Private udtTCP() As MIB_TCPROW
 
Private Function GetIPInfo() As Boolean
Dim bytBuffer() As Byte
Dim lngSize As Long
Dim lngEntries As Long
Dim lngReturn As Long
Dim lngState As Long
Dim intI As Integer
Dim intOffSet As Integer
Dim strRemote As String
Dim strState As String
'
' Obtain the length of the TCP Table
'
lngReturn = GetTcpTable(lngSize, lngSize, 0)
If lngReturn = ERROR_INSUFFICIENT_BUFFER Then
    ReDim bytBuffer(lngSize - 1)
    '
    ' Get the TCP Table
    ' and populate the MIB_TCPROWs
    '
    lngReturn = GetTcpTable(bytBuffer(0), lngSize, 0)
    If lngReturn = 0 Then
        CopyMemory lngEntries, bytBuffer(0), 4
        ReDim udtTCP(lngEntries - 1)
        For intI = 0 To lngEntries - 1
            strRemote = Space(16)
            intOffSet = (intI * Len(udtTCP(intI))) + 4
            CopyMemory udtTCP(intI), bytBuffer(intOffSet), Len(udtTCP(intI))
            '
            ' Remote Addresses of zero are of no interest
            ' otherwise convert the address to dotted form
            ' and add it to the ListBox
            '
            If udtTCP(intI).dwRemoteAddr <> 0 Then
                lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
                lstRemote.AddItem Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
                Txtconnect.Text = Txtconnect.Text & vbNewLine & Time & " - " & lstRemote.List(lstRemote.NewIndex) & "  -------- TCP Protocol" & TextName.Text
            End If
        Next intI
    Else
        MsgBox "Unable to Access TCP Table Entries"
    End If
Else
    MsgBox "Unable to Access TCP Table"
End If
End Function
 
Private Sub CheckIP()
Dim intI As Integer
Dim intJ As Integer
Dim lngReturn As Long
Dim strRemote As String * 16
For intI = LBound(udtTCP) To UBound(udtTCP)
    If udtTCP(intI).dwRemoteAddr <> 0 Then
        strRemote = Space(16)
        lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
        strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
        For intJ = 0 To lstBlacklist.ListCount - 1
            If strRemote = Trim(lstBlacklist.List(intJ)) Then
                udtTCP(intI).dwState = 12
                lngReturn = SetTcpEntry(udtTCP(intI))
                txtAction.Text = txtAction.Text & lstBlacklist.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
            End If
        Next intJ
    End If
Next intI
End Sub
 
Private Sub LoadBlacklist()
Dim intFile As Integer
Dim strLine As String
intFile = FreeFile
Open App.path & "\Blacklist.txt" For Input As intFile
 
Do Until EOF(intFile)
    Line Input #intFile, strLine
    lstBlacklist.AddItem strLine
Loop
Close intFile
End Sub
 
 
 
Private Sub Form_Load()
 
Text1.Text = (Environ("SystemDrive")) & "\"
txtAction.Text = "++----STATUS BOX----++"
txtAction.Text = txtAction.Text & vbNewLine & "-- Blacklisted IP Database Loaded..."
lstBlacklist.Clear
Call LoadBlacklist
Call GetIPInfo
Timer1.Interval = 5000
Timer1.Enabled = True
Label7.Caption = "Number of IP Addresses Blocked: " & lstBlacklist.ListCount
End Sub
 
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload IPBlock
End Sub
 
Private Sub mnuAbout_Click()
About.Show
End Sub
 
Private Sub mnuclose_Click()
Unload IPBlock
End Sub
 
Private Sub mnuUpdate_Click()
BlacklistUpdate.Show
End Sub
 
Private Sub Timer1_Timer()
 
lstRemote.Clear
Txtconnect.Text = ""
Call GetIPInfo
Call CheckIP
 
Label4.Caption = lstRemote.ListCount
End Sub
 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
    Case 1
        'code to run for button 1
        Dim FileNum As Integer
 
      Dim FileDate As String
   
      FileNum = FreeFile
   
     FileDate = Format(Date, "yyyy-mm-dd")
   
      'Open App.path & "\" & FileDate & "log.txt" For Output As #FileNum
      
    Open Text1.Text & "Documents and Settings\All Users\Desktop\" & FileDate & "log.txt" For Output As #FileNum
      Print #FileNum, txtAction.Text
   
      Close #FileNum
txtAction.Text = txtAction.Text & vbNewLine & "-- Status log saved to Documents and Settings\All Users\Desktop\" & FileDate & "IPDisconnectlog.txt"
 
    'Case 2
        ''code to run for button 2
        'IPBlockSettings.Show
Case 2
 
Unload IPBlock
End Select
End Sub

That my code.

Sorry to bump but this is a weird problem.

I got this code to check for ips connected against my black list, ( now there are 3 of them as shown here.

VB Code:

Private Sub CheckIP()
Dim intI As Integer
Dim intJ As Integer
Dim lngReturn As Long
Dim strRemote As String * 16
For intI = LBound(udtTCP) To UBound(udtTCP)
    If udtTCP(intI).dwRemoteAddr <> 0 Then
        strRemote = Space(16)
        lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
        strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
        For intJ = 0 To lstBlacklist2.ListCount - 1
            If strRemote = Trim(lstBlacklist2.List(intJ)) Then
                udtTCP(intI).dwState = 12
                lngReturn = SetTcpEntry(udtTCP(intI))
                txtAction.Text = txtAction.Text & lstBlacklist2.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
            End If
        Next intJ
    End If
Next intI
 
 
'Next
For intI = LBound(udtTCP) To UBound(udtTCP)
    If udtTCP(intI).dwRemoteAddr <> 0 Then
        strRemote = Space(16)
        lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
        strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
        For intJ = 0 To lstBlacklist1.ListCount - 1
            If strRemote = Trim(lstBlacklist1.List(intJ)) Then
                udtTCP(intI).dwState = 12
                lngReturn = SetTcpEntry(udtTCP(intI))
                txtAction.Text = txtAction.Text & lstBlacklist1.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
            End If
        Next intJ
    End If
Next intI
 
 
 
'NEXT
 
For intI = LBound(udtTCP) To UBound(udtTCP)
    If udtTCP(intI).dwRemoteAddr <> 0 Then
        strRemote = Space(16)
        lngReturn = RtlIpv4AddressToString(udtTCP(intI).dwRemoteAddr, strRemote)
        strRemote = Trim$(Left$(strRemote, InStr(strRemote, Chr(0)) - 1))
        For intJ = 0 To lstBlacklist3.ListCount - 1
            If strRemote = Trim(lstBlacklist3.List(intJ)) Then
                udtTCP(intI).dwState = 12
                lngReturn = SetTcpEntry(udtTCP(intI))
                txtAction.Text = txtAction.Text & lstBlacklist3.List(intJ) & _
                    " has been Disconnected at " & Format(Now, "dd/mm/yyyy hh:mm:ss") & vbCrLf
            End If
        Next intJ
    End If
Next intI
End Sub

but the problem is the program will not disconnect them.

instead of blocking why shouldnt use giving access to certain ip address only, perhaps known list should be smaller than unknown

How would you do that?