Private myIPAddress As String
Public Function ExternalIP() As String
Static isActive As Boolean
Dim strHTML As String
Dim curUrl As Integer
Dim myUrl(1 To 4) As String
Dim N As Integer
Do While isActive
DoEvents
Loop
If myIPAddress <> "" Then
ExternalIP = myIPAddress
Exit Function
End If
isActive = True
myUrl(1) = "http://www.mediacollege.com/internet/utilities/show-ip.shtml"
myUrl(2) = "http://www.lawrencegoetz.com/programs/ipinfo/"
myUrl(3) = "http://ip-adress.com/"
myUrl(4) = "http://showip.net/"
For curUrl = 1 To 4
If frmMain.netMain.StillExecuting Then frmMain.netMain.Cancel 'Cancel inet if it's still doing something.
strHTML = frmMain.netMain.OpenURL(myUrl(curUrl)) 'Get the HTML source code to the webpage.
If Len(strHTML) > 0 Then 'Check if the server returned any data.
myIPAddress = GetIP(strHTML)
If Len(myIPAddress) > 0 Then
ExternalIP = myIPAddress
isActive = False
Exit Function
End If
End If
Next curUrl
myIPAddress = frmMain.sckCon(0).LocalIP
ExternalIP = myIPAddress
isActive = False
End Function
Private Function GetIP(HTML As String) As String
Dim lastPos As Integer
Dim curPos As Integer
Dim curStr As String
Dim offset As Integer
curPos = InStr(2000, HTML, ".")
Do While curPos > 0
curStr = Mid$(HTML, curPos, 1)
offset = -1
Do While IsIPChar(Mid$(HTML, curPos + offset, 1))
curStr = Mid$(HTML, curPos + offset, 1) & curStr
offset = offset - 1
Loop
offset = 1
Do While IsIPChar(Mid$(HTML, curPos + offset, 1))
curStr = curStr & Mid$(HTML, curPos + offset, 1)
offset = offset + 1
Loop
If ChkIP(curStr) Then
GetIP = curStr
Exit Function
End If
lastPos = curPos
curPos = InStr(lastPos + 1, HTML, ".")
Loop
End Function
Private Function ChkIP(IP As String) As Boolean
Dim LastPer As Integer
Dim N As Integer
If Len(IP) > 15 Or Len(IP) < 7 Or CountPeriods(IP) <> 3 Then
ChkIP = False
Exit Function
End If
For N = 1 To Len(IP)
If Mid$(IP, N, 1) = "." Then
LastPer = N
ElseIf N - LastPer > 3 Or Not IsNum(Mid$(IP, N, 1)) Then
ChkIP = Fals
Exit Function
End If
Next N
ChkIP = True
End Function
Private Function CountPeriods(chkStr As String) As Integer
Dim Total As Integer
Dim N As Integer
For N = 1 To Len(chkStr)
If Mid$(chkStr, N, 1) = "." Then Total = Total + 1
Next N
CountPeriods = Total
End Function
Private Function IsIPChar(curChar As String) As Boolean
IsIPChar = IIf(IsNum(curChar) Or curChar = ".", True, False)
End Function
Private Function IsNum(Char As String) As Boolean
Select Case Char
Case "0": IsNum = True
Case "1": IsNum = True
Case "2": IsNum = True
Case "3": IsNum = True
Case "4": IsNum = True
Case "5": IsNum = True
Case "6": IsNum = True
Case "7": IsNum = True
Case "8": IsNum = True
Case "9": IsNum = True
Case Else: IsNum = False
End Select
End Function