LIONDAS CONTINUACAO DESCOBRINDO IPS
LIONDAS,
Desculpe o engano, tem uma situação que não consigo resolver, e nem explicar rs.
Acontece que se eu estiver utilizando a net pela rede, os IPs tem a seguinte sequência: 1 - 0.0.0.0, 2- 127.0.0.1, 3-192.170.1.16,
E se eu conectar-me por modem, a mesma rotina fica com a sequência: 1- 127.0.0.1, 2-192.170.1.16, 3-200.234.36.36
Tentei localizar o indice que possa fazer a alternação das posições, mas não fui bem sucedido.
Agradeço dese já.
Para relembrar o tópico anterior...
Boa tarde, preciso de rotinas que retornem:
- IP do computador (local)
- IP da conexão com a internet
- IP do Gateway
- Se possÃvel o tipo de conexão (LAN, Discada, etc)
- Se possÃvel o IP do servidor da rede, considerando que seja apenas 1.
Consegui uma rotina que exibe os IPs do intens 1 á 3, porém sua exibição é por um Msgbox através de um Ãndice, e não consigo adapitar o código para que eu extraia estas informações independentemente.
[c]
Private Const ERROR_SUCCESS As Long = 0
Private Type MIB_IPADDRROW
dwAddr As Long 'IP address
dwIndex As Long 'index of interface associated with this IP
dwMask As Long 'subnet mask for the IP address
dwBCastAddr As Long 'broadcast address (typically the IP
'with host portion set to either all
'zeros or all ones)
dwReasmSize As Long 'reassembly size for received datagrams
unused1 As Integer 'not currently used (but shown anyway)
unused2 As Integer 'not currently used (but shown anyway)
End Type
Private Declare Function GetIpAddrTable Lib "iphlpapi.dll" _
(ByRef ipAddrTable As Byte, _
ByRef dwSize As Long, _
ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" _
(dst As Any, src As Any, ByVal bcount As Long)
Private Declare Function inet_ntoa Lib "wsock32" _
(ByVal addr As Long) As Long
Private Declare Function lstrcpyA Lib "KERNEL32" _
(ByVal RetVal As String, _
ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "KERNEL32" _
(ByVal Ptr As Any) As Long
Public Function GetInetStrFromPtr(ByVal Address As Long) As String
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
End Function
Public Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Private Sub Command1_Click()
Dim IPAddrRow As MIB_IPADDRROW
Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim nRows As Long
Dim cnt As Long
Call GetIpAddrTable(ByVal 0&, cbRequired, 1)
If cbRequired 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetIpAddrTable(buff(0), cbRequired, 1) = ERROR_SUCCESS Then
'saves using LenB in the CopyMemory calls below
nStructSize = LenB(IPAddrRow)
'first 4 bytes is a long indicating the
'number of entries in the table
CopyMemory nRows, buff(0), 4
For cnt = 1 To nRows
'moving past the four bytes obtained
'above, get one chunk of data and cast
'into an IPAddrRow type
CopyMemory IPAddrRow, buff(4 + (cnt - 1) * nStructSize), nStructSize
'pass the results to the listview
MsgBox ("INDEX: " & GetInetStrFromPtr(IPAddrRow.dwIndex) & vbCrLf & _
" IP ADDRESS: " & GetInetStrFromPtr(IPAddrRow.dwAddr))
Next cnt
End If
End If
End Sub
Desculpe o engano, tem uma situação que não consigo resolver, e nem explicar rs.
Acontece que se eu estiver utilizando a net pela rede, os IPs tem a seguinte sequência: 1 - 0.0.0.0, 2- 127.0.0.1, 3-192.170.1.16,
E se eu conectar-me por modem, a mesma rotina fica com a sequência: 1- 127.0.0.1, 2-192.170.1.16, 3-200.234.36.36
Tentei localizar o indice que possa fazer a alternação das posições, mas não fui bem sucedido.
Agradeço dese já.
Para relembrar o tópico anterior...
Boa tarde, preciso de rotinas que retornem:
- IP do computador (local)
- IP da conexão com a internet
- IP do Gateway
- Se possÃvel o tipo de conexão (LAN, Discada, etc)
- Se possÃvel o IP do servidor da rede, considerando que seja apenas 1.
Consegui uma rotina que exibe os IPs do intens 1 á 3, porém sua exibição é por um Msgbox através de um Ãndice, e não consigo adapitar o código para que eu extraia estas informações independentemente.
[c]
Private Const ERROR_SUCCESS As Long = 0
Private Type MIB_IPADDRROW
dwAddr As Long 'IP address
dwIndex As Long 'index of interface associated with this IP
dwMask As Long 'subnet mask for the IP address
dwBCastAddr As Long 'broadcast address (typically the IP
'with host portion set to either all
'zeros or all ones)
dwReasmSize As Long 'reassembly size for received datagrams
unused1 As Integer 'not currently used (but shown anyway)
unused2 As Integer 'not currently used (but shown anyway)
End Type
Private Declare Function GetIpAddrTable Lib "iphlpapi.dll" _
(ByRef ipAddrTable As Byte, _
ByRef dwSize As Long, _
ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" _
(dst As Any, src As Any, ByVal bcount As Long)
Private Declare Function inet_ntoa Lib "wsock32" _
(ByVal addr As Long) As Long
Private Declare Function lstrcpyA Lib "KERNEL32" _
(ByVal RetVal As String, _
ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "KERNEL32" _
(ByVal Ptr As Any) As Long
Public Function GetInetStrFromPtr(ByVal Address As Long) As String
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
End Function
Public Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Private Sub Command1_Click()
Dim IPAddrRow As MIB_IPADDRROW
Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim nRows As Long
Dim cnt As Long
Call GetIpAddrTable(ByVal 0&, cbRequired, 1)
If cbRequired 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetIpAddrTable(buff(0), cbRequired, 1) = ERROR_SUCCESS Then
'saves using LenB in the CopyMemory calls below
nStructSize = LenB(IPAddrRow)
'first 4 bytes is a long indicating the
'number of entries in the table
CopyMemory nRows, buff(0), 4
For cnt = 1 To nRows
'moving past the four bytes obtained
'above, get one chunk of data and cast
'into an IPAddrRow type
CopyMemory IPAddrRow, buff(4 + (cnt - 1) * nStructSize), nStructSize
'pass the results to the listview
MsgBox ("INDEX: " & GetInetStrFromPtr(IPAddrRow.dwIndex) & vbCrLf & _
" IP ADDRESS: " & GetInetStrFromPtr(IPAddrRow.dwAddr))
Next cnt
End If
End If
End Sub
MARCO AURELIO,
A sua rotina mostra os seguinte IPs :
127.0.0.1 = Ip de loopback da placa de rede.
192.170.1.16 = Ip da conexao tcp-ip da rede Ethernet. (seu ip de rede)
200.234.36.36 = Ip da conexao dial-up (conexao para Internet, variavel a cada conexao)
Eu tenho uma rotina que pega o Ip da rede, mas sua rotina é melhor porque pega todos os ips, no outro post vc nao entendeu como pegar somente o ip desejado ?
No seu exemplo, pegar o ip da rede ficaria assim :
CopyMemory IPAddrRow, buff(4 + (2 - 1) * nStructSize), nStructSize
MsgBox "O endereco ip é : " & GetInetStrFromPtr(IPAddrRow.dwAddr)
A sua rotina mostra os seguinte IPs :
127.0.0.1 = Ip de loopback da placa de rede.
192.170.1.16 = Ip da conexao tcp-ip da rede Ethernet. (seu ip de rede)
200.234.36.36 = Ip da conexao dial-up (conexao para Internet, variavel a cada conexao)
Eu tenho uma rotina que pega o Ip da rede, mas sua rotina é melhor porque pega todos os ips, no outro post vc nao entendeu como pegar somente o ip desejado ?
No seu exemplo, pegar o ip da rede ficaria assim :
CopyMemory IPAddrRow, buff(4 + (2 - 1) * nStructSize), nStructSize
MsgBox "O endereco ip é : " & GetInetStrFromPtr(IPAddrRow.dwAddr)
Tente este código :
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function WSAGetLastError Lib "wsock32" () As Long
Private Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32" () As Long
Private Declare Function gethostname Lib "wsock32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyname Lib "wsock32" (ByVal szHost As String) As Long
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const ERROR_SUCCESS As Long = 0
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type
Private 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
'Retorna o endereço IP
Private 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 Exit Function
'Ocorre um erro de Socket : " & Str$(WSAGetLastError()) & " , não é possivel obter nome do Host."
If gethostname(sHostName, 256) = SOCKET_ERROR Then
SocketsCleanup
Exit Function
End If
sHostName = Trim$(sHostName)
lpHost = gethostbyname(sHostName)
'MsgBox "Windows Sockets não esta respondendo. " & "não é possivel obter nome do Host"
If lpHost = 0 Then
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
Private Function HiByte(ByVal wParam As Integer) As Byte
HiByte = (wParam And &HFF00&) \ (&H100)
End Function
Private Function LoByte(ByVal wParam As Integer) As Byte
LoByte = wParam And &HFF&
End Function
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
SocketsInitialize = False
'32-bit Windows Socket não esta respondendo.
If WSAStartup(WS_VERSION_REQD, WSAD) ERROR_SUCCESS Then Exit Function
'Esta aplicação requer um minimo de " & CStr(MIN_SOCKETS_REQD) & " sockets suportados.
If WSAD.wMaxSockets MIN_SOCKETS_REQD Then Exit Function
'A versao Sockets " & CStr(LoByte(WSAD.wVersion)) & "." & CStr(HiByte(WSAD.wVersion)) & " não é suportada por 32-bit Windows Sockets.
If LoByte(WSAD.wVersion) WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) WS_VERSION_MINOR) Then Exit Function
SocketsInitialize = True
End Function
Private Sub SocketsCleanup()
'If WSACleanup() ERROR_SUCCESS Then MsgBox " Erro de Socket."
WSACleanup
End Sub
Para pegar o ip faça o seguinte :
msgbox "O ip é :" & GetIPAddress
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function WSAGetLastError Lib "wsock32" () As Long
Private Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32" () As Long
Private Declare Function gethostname Lib "wsock32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyname Lib "wsock32" (ByVal szHost As String) As Long
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const ERROR_SUCCESS As Long = 0
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type
Private 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
'Retorna o endereço IP
Private 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 Exit Function
'Ocorre um erro de Socket : " & Str$(WSAGetLastError()) & " , não é possivel obter nome do Host."
If gethostname(sHostName, 256) = SOCKET_ERROR Then
SocketsCleanup
Exit Function
End If
sHostName = Trim$(sHostName)
lpHost = gethostbyname(sHostName)
'MsgBox "Windows Sockets não esta respondendo. " & "não é possivel obter nome do Host"
If lpHost = 0 Then
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
Private Function HiByte(ByVal wParam As Integer) As Byte
HiByte = (wParam And &HFF00&) \ (&H100)
End Function
Private Function LoByte(ByVal wParam As Integer) As Byte
LoByte = wParam And &HFF&
End Function
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
SocketsInitialize = False
'32-bit Windows Socket não esta respondendo.
If WSAStartup(WS_VERSION_REQD, WSAD) ERROR_SUCCESS Then Exit Function
'Esta aplicação requer um minimo de " & CStr(MIN_SOCKETS_REQD) & " sockets suportados.
If WSAD.wMaxSockets MIN_SOCKETS_REQD Then Exit Function
'A versao Sockets " & CStr(LoByte(WSAD.wVersion)) & "." & CStr(HiByte(WSAD.wVersion)) & " não é suportada por 32-bit Windows Sockets.
If LoByte(WSAD.wVersion) WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) WS_VERSION_MINOR) Then Exit Function
SocketsInitialize = True
End Function
Private Sub SocketsCleanup()
'If WSACleanup() ERROR_SUCCESS Then MsgBox " Erro de Socket."
WSACleanup
End Sub
Para pegar o ip faça o seguinte :
msgbox "O ip é :" & GetIPAddress
Tópico encerrado , respostas não são mais permitidas