LIONDAS CONTINUACAO DESCOBRINDO IPS

 Tópico anterior Próximo tópico Novo tópico

LIONDAS CONTINUACAO DESCOBRINDO IPS

VB / VBA

 Compartilhe  Compartilhe  Compartilhe
#407 - 09/12/2003 17:46:10

USUARIO.EXCLUIDOS

Cadast. em:


LIONDAS,
   Desculpe o engano, tem uma situao que no consigo resolver, e nem explicar rs.
   Acontece que se eu estiver utilizando a net pela rede, os IPs tem a seguinte sequncia: 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 sequncia: 1- 127.0.0.1, 2-192.170.1.16, 3-200.234.36.36
   Tentei localizar o indice que possa fazer a alternao das posies, mas no fui bem sucedido.

Agradeo dese j.

Para relembrar o tpico anterior...

Boa tarde, preciso de rotinas que retornem:
- IP do computador (local)
- IP da conexo com a internet
- IP do Gateway
- Se possvel o tipo de conexo (LAN, Discada, etc)
- Se possvel o IP do servidor da rede, considerando que seja apenas 1.

Consegui uma rotina que exibe os IPs do intens 1 3, porm sua exibio por um Msgbox atravs de um ndice, e no consigo adapitar o cdigo para que eu extraia estas informaes independentemente.


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




Resposta escolhida #482 - 10/12/2003 10:05:03

LIONDAS
OSASCO
Cadast. em:Dezembro/2003


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)




Liondas

#552 - 10/12/2003 14:30:33

LIONDAS
OSASCO
Cadast. em:Dezembro/2003


Tente este cdigo :

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 endereo 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()) & " , no 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 no esta respondendo. " & "no 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 no esta respondendo.
   If WSAStartup(WS_VERSION_REQD, WSAD)  ERROR_SUCCESS Then Exit Function
   'Esta aplicao 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)) & " no 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 faa o seguinte :

msgbox "O ip :" & GetIPAddress

Liondas

 Tópico anterior Próximo tópico Novo tópico


Tópico encerrado, respostas não sao permitidas
Encerrado por WEBMASTER em 18/08/2009 10:03:45