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.
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.
Last edited by Chris001; Jan 10th, 2008 at 10:57 AM.
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.
Last edited by Doogle; Feb 10th, 2008 at 06:21 AM.
Reason: Corrected a couple of errors
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.
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
Last edited by Doogle; Feb 11th, 2008 at 12:42 AM.
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.
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.
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.
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?
Last edited by Justin M; Feb 11th, 2008 at 10:54 PM.
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.
[RESOLVED] Block IP
Reply With Quote
Originally Posted by Doogle
