Newsgroup: it.comp.lang.visual-basic
Titolo: [!] Ottenere gli indirizzi IP locali

Dato che mi serviva, ho buttato giu' una funzione per reperire
tutti gli indirizzi IP locali relativi alle schede di rete presenti sulla
macchina.
Mi sono basato sulla documentazione msdn, sul codice pubblicato
da Jimi tempo fa e su un esempio di Randy Mirch.
La funzione che pubblico e' un po' modificata, ma penso possa
essere un utile spunto per tutti quelli che ultimamente hanno chiesto
qualcosa del genere.
Una precisazione importante: la funzione e' stata testata solo
con windows 2000 perche' mi serviva li'.
La verifica su altre piattaforme e' lasciata ai miei venticinque lettori ;-)
Il codice e' sotto la firma.
hth, hal
---------------------------------------------------------------
Option Explicit
Private Const MAX_ADAPTER_NAME_LENGTH         As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH  As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH      As Long = 8
Private Const ERROR_SUCCESS  As Long = 0
Private Type IP_ADDRESS_STRING
    IpAddr(0 To 15)  As Byte
End Type
Private Type IP_MASK_STRING
    IpMask(0 To 15)  As Byte
End Type
Private Type IP_ADDR_STRING
    dwNext     As Long
    IpAddress  As IP_ADDRESS_STRING
    IpMask     As IP_MASK_STRING
    dwContext  As Long
End Type
Private Type IP_ADAPTER_INFO
  dwNext                As Long
  ComboIndex            As Long  'reserved
  sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3))        As Byte
  sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
  dwAddressLength       As Long
  sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1))       As Byte
  dwIndex               As Long
  uType                 As Long
  uDhcpEnabled          As Long
  CurrentIpAddress      As Long
  IpAddressList         As IP_ADDR_STRING
  GatewayList           As IP_ADDR_STRING
  DhcpServer            As IP_ADDR_STRING
  bHaveWins             As Long
  PrimaryWinsServer     As IP_ADDR_STRING
  SecondaryWinsServer   As IP_ADDR_STRING
  LeaseObtained         As Long
  LeaseExpires          As Long
End Type
Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" ( _
                                        pAdapterInfo As Any, _
                                        pOutBufLen As Long _
                                        ) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
                                        Destination As Any, _
                                        Source As Any, _
                                        Length As Long)
' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Public Function vbGetLocalIps(Optional ByVal a_AdapterSep As String = vbNewLine, _
                            Optional ByVal a_AddressSep As String = vbTab _
                            ) As String
 
   Dim pOutBufLen       As Long
   Dim bufAdapters()    As Byte
   Dim bufAddresses()   As Byte
   Dim adapter_info     As IP_ADAPTER_INFO
   Dim addr_string      As IP_ADDR_STRING
   Dim ptrAdapter       As Long
   Dim ptrAddress       As Long
   Dim retAddresses     As String
 
   Call GetAdaptersInfo(ByVal 0&, pOutBufLen)
   If (pOutBufLen > 0) Then
 
      ReDim bufAdapters(0 To pOutBufLen - 1) As Byte
 
      If GetAdaptersInfo(bufAdapters(0), pOutBufLen) = ERROR_SUCCESS Then
 
         ptrAdapter = VarPtr(bufAdapters(0))
         While (ptrAdapter)
 
            CopyMemory adapter_info, ByVal ptrAdapter, ByVal LenB(adapter_info)
 
            ptrAddress = VarPtr(adapter_info.IpAddressList)
            While (ptrAddress)
                CopyMemory addr_string, ByVal ptrAddress, ByVal LenB(addr_string)
                retAddresses = retAddresses & _
                        TrimEx(StrConv(addr_string.IpAddress.IpAddr, vbUnicode)) & _
                        a_AddressSep
                ptrAddress = addr_string.dwNext
            Wend
 
            ptrAdapter = adapter_info.dwNext
            retAddresses = retAddresses & a_AdapterSep
 
         Wend  '// ptrAdapter
      End If  '// GetAdaptersInfo
   End If  '// pOutBufLen
   If Len(retAddresses) > 0 Then
      retAddresses = Left$(retAddresses, Len(retAddresses) - _
                            Len(a_AdapterSep) - Len(a_AddressSep))
   End If
   vbGetLocalIps = retAddresses
End Function    '// vbGetLocalIps
Private Function TrimEx(ByRef src As String) As String
    Dim pos As Integer
    pos = InStr(1, src, vbNullChar, vbBinaryCompare)
    If pos Then
          TrimEx = Trim$(Left$(src, pos - 1))
    Else
        TrimEx = Trim$(src)
    End If
End Function    '// TrimEx

 La verifica su altre piattaforme e' lasciata ai miei venticinque lettori
;-)
Sotto Win98 va benone. Mi ha beccato sia la scheda di rete che la
connessione internet. Li ho confrontati con quelli che mi da IpAgent di
www.grc.com
 e coincidono.
Un solo commento: Clap Clap Clap! (o LLTA per i patiti degli acronimi)
Ciao
*Roby*

 macchina.
Sei tutti noi Hal, come sempre...
ciao
ugo

 La verifica su altre piattaforme e' lasciata ai miei venticinque lettori ;-)
Anch'io te la confermo sul 98, nobbuono sul 95 (OSR2.5 straaggiornato)
e su NT 4.0 (ho provato su due macchine un po' anomale, perň).
Se ho tempo ci guardo meglio.
Bye, G.

Se ho tempo ci guardo meglio.
Grazie Pap :-)
Che problemi da' ?
Non trova le librerie, formatta a capocchia, gipieffa ?
ciao, hal

"hal1961" ha scritto nel messaggio

Magari, mi dà una stringa vuota.
debug.print "-" & getlocalips & "-"
risultato:
--
Vero che non ho neanche guardato il codice, ho cuttenpastato,
creato un eseguibile e provato. VB5 SP3, se interessa.
Ho pensato che ci volesse il VB6, ma su 98 funzia....
Bye, G.


Pap: esatto: ci stanno lavorando hal e Moreno in chat...
ciao
ugo

Ho pensato che ci volesse il VB6, ma su 98 funzia....
Gia', ho appena verificato su MSDN:
GetAdaptersInfo
(...)
Requirements 
  Windows NT/2000 or later: Requires Windows 2000 or later.
  Windows 95/98/Me: Requires Windows 98 or later.
  Header: Declared in Iphlpapi.h.
  Library: Use Iphlpapi.lib.
per 95 e NT occorrera' trovare qualcos' altro :-(
ciao, hal

 Pap: esatto: ci stanno lavorando hal e Moreno in chat...
Ci sono :-)
Bye, G.