Newsgroup: it.comp.appl.access
Titolo: Come rilevare indirizzo IP del computer ?

Vorrei sapere come potrei, tramite Access, rilevare l'indirizzo IP del
computer e poi visualizzarlo.
Grazie Max



  Grazie Max
http://www.mvps.org/access/api/api0067.htm
--
rgrds
SC
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it


copiati tutta questa pappardella in un modulo e poi utilizza la funzione 
GETIP()
Non è certo farina del mio sacco ...
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

  Grazie Max
Ho un esempio on line. (A.97)
http://www.geviservices.it/files/ip.zip
-- 
Ciao
Pablitomf (Maurizio Facciuti)
Access : Ver.97 - 2K
----------------------------------
http://www.accessgroup.it/
http://www.sitocomune.com/
----------------------------------
Non mi fido molto delle statistiche, perchč un uomo con la testa nel forno
acceso e i piedi nel congelatore statisticamente ha una temperatura media.


 ha scritto nel messaggio
news:d2tufi$rgt$1...@news.newsland.it...

Grazie a tutti per l'aiuto.
Max