• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 180
  • Last Modified:

Getting correct IP Address

When I attempt to get my current IP Address, every method I try always returns the address of my network card not my internet IP address. WINIPCFG can find out this information why can't I?????????

How can I get this?
0
DPPro
Asked:
DPPro
  • 3
  • 3
  • 2
  • +2
1 Solution
 
RuchiCommented:
'Module

Option Explicit

'Get Machine IP Address

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Insert the following code to the module :

Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Const ERROR_SUCCESS As Long = 0
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = _
WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1

Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type

Public Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Public Declare Function WSAStartup Lib "WSOCK32.DLL" _
(ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Public Declare Function gethostname Lib "WSOCK32.DLL" _
(ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal szHost As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Public Function GetIPAddress() As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
If Not SocketsInitialize() Then
GetIPAddress = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetIPAddress = ""
MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _
" has occurred. Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
sHostName = Trim$(sHostName)
lpHost = gethostbyname(sHostName)
If lpHost = 0 Then
GetIPAddress = ""
MsgBox "Windows Sockets are not responding. " & _
"Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
CopyMemory HOST, lpHost, Len(HOST)
CopyMemory dwIPAddr, HOST.hAddrList, 4
ReDim tmpIPAddr(1 To HOST.hLen)
CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
For i = 1 To HOST.hLen
sIPAddr = sIPAddr & tmpIPAddr(i) & "."
Next
GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
SocketsCleanup
End Function

Public Function GetIPHostName() As String
Dim sHostName As String * 256
If Not SocketsInitialize() Then
GetIPHostName = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetIPHostName = ""
MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _
" has occurred. Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
SocketsCleanup
End Function


Public Function HiByte(ByVal wParam As Integer)
HiByte = wParam \ &H100 And &HFF&
End Function

Public Function LoByte(ByVal wParam As Integer)
LoByte = wParam And &HFF&
End Function

Public Sub SocketsCleanup()
If WSACleanup() <> ERROR_SUCCESS Then
MsgBox "Socket error occurred in Cleanup."
End If
End Sub

Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim sLoByte As String
Dim sHiByte As String
If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
MsgBox "The 32-bit Windows Socket is not responding."
SocketsInitialize = False
Exit Function
End If
If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
MsgBox "This application requires a minimum of " & _
CStr(MIN_SOCKETS_REQD) & " supported sockets."
SocketsInitialize = False
Exit Function
End If
If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
(LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
sHiByte = CStr(HiByte(WSAD.wVersion))
sLoByte = CStr(LoByte(WSAD.wVersion))
MsgBox "Sockets version " & sLoByte & "." & sHiByte & _
" is not supported by 32-bit Windows Sockets."
SocketsInitialize = False
Exit Function
End If
SocketsInitialize = True
End Function


'Form

'Insert this code to your form:

Private Sub Form_Load()
MsgBox "IP Host Name: " & GetIPHostName()
MsgBox "IP Address: " & GetIPAddress()
End Sub
0
 
Erick37Commented:
Unrelated, but HiByte should not round up:

Function HiByte(ByVal w As Integer) As Byte
    If w And &H8000 Then
        HiByte = &H80 Or ((w And &H7FFF) \ &HFF)
    Else
        HiByte = w \ 256
    End If
End Function
0
 
ramananCommented:
Private Declare Function GetComputerName Lib _
    "kernel32" Alias "GetComputerNameA" (ByVal _
    lpBuffer$, nSize As Long) As Long


Public Function CurComputerName() As String
    Dim sTmp1$
    Dim t As Long
    sTmp1 = Space$(512)
    GetComputerName sTmp1, Len(sTmp1)
    sTmp1 = Trim$(sTmp1)
    t = Len(sTmp1)
    'remove the trailing zero
    CurComputerName = Left(sTmp1, t - 1)
End Function


Public Function GetIp() As String
    Dim FileNum As Byte
    Dim FileLen As Long
    Dim Buffer As String
    Dim LocationA As Long
    Dim LocationB As Long
    Dim tmpStrA As String
    'send output of TRACERT to a temporary t
    '     ext file
    tmpStrA = "command.com /c tracert.exe " & _
    CurComputerName() & " > c:\temp4343.txt"
    Shell tmpStrA, vbHide
    FileNum = FreeFile
    Open "c:\temp4343.txt" For Binary Access Read As FileNum
    FileLen = LOF(FileNum)
    Buffer = String(FileLen, " ")
    Get FileNum, , Buffer
    Close FileNum
    If Buffer = "" Then Exit Function
    'search temporary file for local IP addr
    '     ess,
    'which is located between the braces [ip
    '     address]
    LocationA = InStr(1, Buffer, "[") + 1
    LocationB = InStr(LocationA, Buffer, "]")
    GetIp = Mid(Buffer, LocationA, LocationB - LocationA)
End Function


Private Sub Form_Unload(Cancel As Integer)
    'delete the temporary file
    Kill "c:\temp4343.txt"
End Sub


Private Sub Timer1_Timer()
    'update the text box
    txtIpAddress.Text = GetIp
End Sub
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
DPProAuthor Commented:
Thank You, but you all get the buzzer...

All these routines return me the ip address for my network adapter, not my PPP adapter.

I keep getting 10.1.1.16 instead of for example 127.132.151.28
0
 
jva2Commented:
Am I missing something?
Why can't you just add a
"Microsoft Winsock Control 6" component to your project, then add it to your form??
From there, Winsock1.LocalIP returns your IP Address.

0
 
RuchiCommented:
Try this:

Put a text box and a command button on the form.

Option Explicit

Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32

Private Type NCB
  ncb_command As Byte
  ncb_retcode As Byte
  ncb_lsn As Byte
  ncb_num As Byte
  ncb_buffer As Long
  ncb_length As Integer
  ncb_callname As String * NCBNAMSZ
  ncb_name As String * NCBNAMSZ
  ncb_rto As Byte
  ncb_sto As Byte
  ncb_post As Long
  ncb_lana_num As Byte
  ncb_cmd_cplt As Byte
  ncb_reserve(9) As Byte ' Reserved, must be 0
  ncb_event As Long
End Type

Private Type ADAPTER_STATUS
  adapter_address(5) As Byte
  rev_major As Byte
  reserved0 As Byte
  adapter_type As Byte
  rev_minor As Byte
  duration As Integer
  frmr_recv As Integer
  frmr_xmit As Integer
  iframe_recv_err As Integer
  xmit_aborts As Integer
  xmit_success As Long
  recv_success As Long
  iframe_xmit_err As Integer
  recv_buff_unavail As Integer
  t1_timeouts As Integer
  ti_timeouts As Integer
  Reserved1 As Long
  free_ncbs As Integer
  max_cfg_ncbs As Integer
  max_ncbs As Integer
  xmit_buf_unavail As Integer
  max_dgram_size As Integer
  pending_sess As Integer
  max_cfg_sess As Integer
  max_sess As Integer
  max_sess_pkt_size As Integer
  name_count As Integer
End Type

Private Type NAME_BUFFER
  name As String * NCBNAMSZ
  name_num As Integer
  name_flags As Integer
End Type

Private Type ASTAT
  adapt As ADAPTER_STATUS
  NameBuff(30) As NAME_BUFFER
End Type

Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

Private Function EthernetAddress(LanaNumber As Long) As String
  Dim udtNCB       As NCB
  Dim bytResponse  As Byte
  Dim udtASTAT     As ASTAT
  Dim udtTempASTAT As ASTAT
  Dim lngASTAT     As Long
  Dim strOut       As String
  Dim x            As Integer

  udtNCB.ncb_command = NCBRESET
  bytResponse = Netbios(udtNCB)
  udtNCB.ncb_command = NCBASTAT
  udtNCB.ncb_lana_num = LanaNumber
  udtNCB.ncb_callname = "* "
  udtNCB.ncb_length = Len(udtASTAT)
  lngASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)
  strOut = ""
  If lngASTAT Then
    udtNCB.ncb_buffer = lngASTAT
    bytResponse = Netbios(udtNCB)
    CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
     With udtASTAT.adapt
      For x = 0 To 5
        strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
      Next x
    End With
    HeapFree GetProcessHeap(), 0, lngASTAT
  End If
  EthernetAddress = strOut
End Function


Private Sub CmdClose_Click()
  End
End Sub

Private Sub Form_Load()

  Text1 = "This machine is Ethernet Address: " & EthernetAddress(0)

End Sub
0
 
RuchiCommented:
oops. wrong question...
0
 
DPProAuthor Commented:
Winsock returns the network card everytime. If you have a server assigned ip address on your lan and connect to the internet, then run netstat from DOS it will display each connection several times. Of course the one I need is at the bottom. All functions, API's , and controls always return me the first one.
0
 
Erick37Commented:
Take a look at this article and the resolve_name function:

http://www.vbonline.com/vb-mag/9603/bob/default.htm
0
 
DPProAuthor Commented:
How did you ever find that article? Thanks alot...I was able to take this and work with it. I know you only posted a comment, but the points are your anyway.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
  • 3
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now