Newsgroup: it.comp.appl.access
Titolo: indirizzo IP

Salve a tutti
Vorrei sapere come posso ottenere con access l'indirizzo IP del PC.
Grazie

 Grazie
Ti rispondo a braccio, quindi prendila con le molle :
Dovresti aver registrato il Controllo Microsoft Winsock 6.0 e con il
comando Winsock1.LocalIP ottenere l'IP oppure con Winsock1.LocalHostName
il nome del PC... ( e fai sicuramente prima )
Però puoi provare questo codice, io lo uso e va benissimo :
Option Compare Database
Option Explicit
'Initialisierung der API-Funktionen
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal
wVersionRequired&, lpWSAData As WinSocketDataType) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal HostName$)
As Long
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias
"RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As
Long) As Long
Private Declare Function RasGetConnectStatus Lib "RasApi32.DLL" Alias
"RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
Private Declare Function RasEnumEntries Lib "RasApi32.DLL" Alias
"RasEnumEntriesA" (ByVal Reserved$, ByVal lpszPhonebook$, lprasentryname
As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA"
(ByVal hRasConn As Long) As Long
Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent
As Long, ByVal lpszConiID As String, ByVal dwFlags As Long, ByRef hCon As
Long, ByVal dwReserved As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal
hpvSource&, ByVal cbCopy&)
Dim ConID&
Private Type RASType
dwSize As Long
hRasCon As Long
szEntryName(256) As Byte
szDeviceType(16) As Byte
szDeviceName(32) As Byte
End Type
Private Type RASStatusType
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(16) As Byte
szDeviceName(32) As Byte
End Type
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(256) As Byte
End Type
Dim DFÜName$
Private Type HostDeType
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private Type WinSocketDataType
wversion As Integer
wHighVersion As Integer
szDescription(0 To 256) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type
'Sub zum Beenden der Verbindung
Sub Verbindung_Beenden()
Dim x As Integer
For x = 0 To 1000
RasHangUp (x)
If DFÜStatus = False Then Exit For
Next
End Sub
'Sub zum Aufbauen der Standart Verbindung
Sub Verbindung_Aufbauen()
Dim ConName As String
InternetDial 0, ConName, 2, ConID, 0
End Sub
'Sub zum Bekommen des aktuellen DFÜ Status
Function DFÜStatus() As Boolean
Dim RAS(255) As RASType, RASStatus As RASStatusType
Dim lg&, lpcon&, Result&
RAS(0).dwSize = 412
lg = 256 * RAS(0).dwSize
Result = RasEnumConnections(RAS(0), lg, lpcon)
If lpcon = 0 Then
DFÜStatus = False
Else
RASStatus.dwSize = 160
Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
If RASStatus.RasConnState = &H2000 Then
DFÜStatus = True
Else
DFÜStatus = False
End If
End If
End Function
'Sub zum Bekommen der aktuellen IP
Function GetIP() As String
Dim IP$, DNS$, Host$, x As Integer
Dim GetComputer As String
Dim Result%
Dim LoBy%, HiBy%
Dim SocketData As WinSocketDataType
Result = WSAStartup(&H101, SocketData)
If Result <> 0 Then
MsgBox "Es trat ein Problem mit der winsock.dll auf.", , "Fehler"
End If
x = 2
nt:
IP = HostByName$(GetComputer, x)
If Len(IP) = 0 And x >= 0 Then
x = x - 1
GoTo nt
End If
GetIP = IP
CleanSockets
End Function
'Sub zum Bekommen der IP anhand des Hostnamens
Function HostByName(name$, Optional x% = 0) As String
Dim MemIp() As Byte
Dim y%
Dim HostDeAddress&, HostIp&
Dim IpAddress$
Dim Host As HostDeType
HostDeAddress = gethostbyname(name)
If HostDeAddress = 0 Then
HostByName = ""
Exit Function
End If
Call RtlMoveMemory(Host, HostDeAddress, LenB(Host))
For y = 0 To x
Call RtlMoveMemory(HostIp, Host.hAddrList + 4 * y, 4)
If HostIp = 0 Then
HostByName = ""
Exit Function
End If
Next y
ReDim MemIp(1 To Host.hLength)
Call RtlMoveMemory(MemIp(1), HostIp, Host.hLength)
IpAddress = ""
For y = 1 To Host.hLength
IpAddress = IpAddress & MemIp(y) & "."
Next y
HostByName = Left$(IpAddress, Len(IpAddress) - 1)
End Function
Private Sub CleanSockets()
Dim Result&
Result = WSACleanup()
If Result <> 0 Then
MsgBox "Es trat ein Problem mit der winsock.dll auf.", , "Fehler"
End If
End Sub
Poi su quello che ti pare (anche un MsgBox) ti richiami il GetIP()
Ti va bene?
Ciao
-- 
Pablitomf (Maurizio Facciuti)
“Quando non ti eserciti ricorda che qualcuno in qualche posto si sta
allenando e, quando lo incontrerai, ti batterà”.
Ed Macauley 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 il nome del PC... ( e fai sicuramente prima )
[CUT]
La soluzione di Winsok funziona anche se quanto usato è prolisso
e si può ridurre, ma vi propongo di appoggiarvi alla piattaforma
SDK attraverso le Classi di WMI
Vi allego uno Script modificato per girare in VB/VBA e il
riferimento alla pagina MS nella quale trovate esposte le
proprietà della Classe....!
'
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_networkadapterconfiguration.asp
Public Function getIP()
   Dim strComputer As String
   Dim objWMIService As Object
   Dim objnetcard As Object
   strComputer = "."
   Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
   Set colNetCards = objWMIService.ExecQuery _
    ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled =
True")
   For Each objnetcard In objWMIService.ExecQuery _
              ("Select * From Win32_NetworkAdapterConfiguration Where
IPEnabled = True")
      Debug.Print objnetcard.WINSPrimaryServer
      Debug.Print objnetcard.WINSSecondaryServer
   Next objnetcard
End Function
Saluti
@Alex.
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG