A number of times I have found people trying to find out what their machine's public ip is. Here is a small code which describes how to achieve this. Even though it depends upon an external resource, you might find it helpful.
For details you might like to check MSDN forum as well on this topic.
Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Friend Class Form1
Inherits System.Windows.Forms.Form
Private Const ERROR_SUCCESS As Integer = 0
Private Const MAX_ADAPTER_NAME_LENGTH As Integer = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Integer = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Integer = 8
Private Structure IP_ADDRESS_STRING
Dim IpAddr() As Byte
Public Sub Initialize()
ReDim IpAddr(15)
End Sub
End Structure
Private Structure IP_MASK_STRING
Dim IpMask() As Byte
Public Sub Initialize()
ReDim IpMask(15)
End Sub
End Structure
Private Structure IP_ADDR_STRING
Dim dwNext As Integer
Dim IpAddress As IP_ADDRESS_STRING
Dim IpMask As IP_MASK_STRING
Dim dwContext As Integer
Public Sub Initialize()
IpAddress.Initialize()
IpMask.Initialize()
End Sub
End Structure
Private Structure IP_ADAPTER_INFO
Dim dwNext As Integer
Dim ComboIndex As Integer 'reserved
Dim sAdapterName() As Byte
Dim sDescription() As Byte
Dim dwAddressLength As Integer
Dim sIPAddress() As Byte
Dim dwIndex As Integer
Dim uType As Integer
Dim uDhcpEnabled As Integer
Dim CurrentIpAddress As Integer
Dim IpAddressList As IP_ADDR_STRING
Dim GatewayList As IP_ADDR_STRING
Dim DhcpServer As IP_ADDR_STRING
Dim bHaveWins As Integer
Dim PrimaryWinsServer As IP_ADDR_STRING
Dim SecondaryWinsServer As IP_ADDR_STRING
Dim LeaseObtained As Integer
Dim LeaseExpires As Integer
Public Sub Initialize()
ReDim sAdapterName((MAX_ADAPTER_NAME_LENGTH + 3))
ReDim sDescription((MAX_ADAPTER_DESCRIPTION_LENGTH + 3))
ReDim sIPAddress((MAX_ADAPTER_ADDRESS_LENGTH - 1))
IpAddressList.Initialize()
GatewayList.Initialize()
DhcpServer.Initialize()
PrimaryWinsServer.Initialize()
SecondaryWinsServer.Initialize()
End Sub
End Structure
Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(ByRef pTcpTable As Long, ByRef pdwSize As Integer) As Integer
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(ByRef dst As Long, ByRef src As Long, ByVal bcount As Integer)
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Integer, _
ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Integer, _
ByVal lpfnCB As Integer) As Integer
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Integer
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Integer) As Integer
Private Sub Form1_Load(ByVal eventSender As System.Object, _
ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Command1.Text = "Get Public IP"
Text2.Text = ""
End Sub
Private Sub Command1_Click(ByVal eventSender As System.Object, _
ByVal eventArgs As System.EventArgs) Handles Command1.Click
Text2.Text = GetPublicIP()
End Sub
Private Function GetPublicIP() As Object
Dim sSourceUrl As String
Dim sLocalFile As String
Dim hfile As Integer
Dim buff As String
Dim pos1 As Integer
Dim pos2 As Integer
'site returning IP address
sSourceUrl = _
"http://vbnet.mvps.org/resources/tools/getpublicip.shtml"
sLocalFile = "c:\ip.txt"
'ensure this file does not exist in the cache
Call DeleteUrlCacheEntry(sSourceUrl)
'download the public IP file,
'read into a buffer and delete
If DownloadFile(sSourceUrl, sLocalFile) Then
hfile = FreeFile
FileOpen(hfile, sLocalFile, OpenMode.Input)
buff = InputString(hfile, LOF(hfile))
FileClose(hfile)
'look for the IP line
pos1 = InStr(buff, "var ip =")
'if found,
If pos1 Then
'get position of first and last single
'quotes around address (e.g. '11.22.33.44')
pos1 = InStr(pos1 + 1, buff, "'", CompareMethod.Text) + 1
pos2 = InStr(pos1 + 1, buff, "'", CompareMethod.Text) '- 1
'return the IP address
GetPublicIP = Mid(buff, pos1, pos2 - pos1)
Else
GetPublicIP = "(unable to parse IP)"
End If 'pos1
Kill(sLocalFile)
Else
GetPublicIP = "(unable to access shtml page)"
End If 'DownloadFile
End Function
Private Function DownloadFile(ByVal sURL As String, _
ByVal sLocalFile As String) As Boolean
DownloadFile = URLDownloadToFile(0, sURL, sLocalFile, 0, 0) = _
ERROR_SUCCESS
End Function
End Class
|
