DPPro
asked on
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?
How can I get this?
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
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
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
"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
ASKER
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
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
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.
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.
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
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
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()
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)),
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
oops. wrong question...
ASKER
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
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
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