Internet

Vor dem ersten Aufruf muß die Funktion "SocketsInitialize" und nach dem letzten Aufruf die Funtion "SocketsCleanup" aufgerufen werden.

Umwandlung IP -> Name
     SocketsInitialize
     MsgBox HostByAddr$("xxx.xxx.xxx.xxx")
     SocketsCleanup

Umwandlung Name -> IP
     SocketsInitialize
     MsgBox HostByName$("rechner1.domainxyz.de")
     SocketsCleanup

Eigenen Namen ermitteln
     SocketsInitialize
     MsgBox MyHostName$()
     SocketsCleanup

von Provider zugewiesene dynamische IP abfragen
     SocketsInitialize
     ich$ = MyHostName$(): adapter% = 0
     Do
        ip$ = HostByName$(ich$, adapter%): If Len(ip$) = 0 Then Exit Do
        dnsname$ = HostByAddr$(ip$)
        MsgBox "DNS: " + dnsname$ + Chr$(10) + "IP: " + ip$, , "Adapter" + Str$(adapter%)
        adapter% = adapter% + 1
     Loop
     SocketsCleanup
Hinweis: falls in der Schleife mehrere IPs gemeldet werden, müssen IPs aus folgenden Bereichen entfernt werden:
     127.0.0.1 = localhost
     10.*.*.* , 172.16-31.*.* , 192.168.*.* = private IPs (lokales LAN)

Private Const WS_VERSION_REQD = &H101 Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& Private Const MIN_SOCKETS_REQD = 1 Private Const SOCKET_ERROR = -1 Private Const WSADescription_Len = 256 Private Const WSASYS_Status_Len = 128 Private Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLength As Integer hAddrList As Long End Type Private Type WSADATA wversion As Integer wHighVersion As Integer szDescription(0 To WSADescription_Len) As Byte szSystemStatus(0 To WSASYS_Status_Len) As Byte iMaxSockets As Integer iMaxUdpDg As Integer lpszVendorInfo As Long End Type Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen%) As Long Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (ByVal addr$, ByVal laenge%, ByVal typ%) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&) Public Function HostByAddr$(ByVal addr$) Dim host As HOSTENT a$ = Chr$(Val(zeichennext$(addr$, "."))) a$ = a$ + Chr$(Val(zeichennext$(addr$, "."))) a$ = a$ + Chr$(Val(zeichennext$(addr$, "."))) a$ = a$ + Chr$(Val(addr$)) hostent_addr& = gethostbyaddr(a$, Len(a$), 2) If hostent_addr& = 0 Then HostByAddr$ = "": Exit Function RtlMoveMemory host, hostent_addr&, LenB(host) Dim c As String * 5 a$ = "": n% = 0 Do RtlMoveMemory ByVal c, host.hName + n%, 1 If Left$(c, 1) = Chr$(0) Then Exit Do a$ = a$ + Left$(c, 1): n% = n% + 1 Loop HostByAddr$ = a$ End Function Public Function HostByName$(na$, Optional adapter% = 0) Dim host As HOSTENT Dim temp_ip_address() As Byte hostent_addr& = gethostbyname(na$) If hostent_addr& = 0 Then HostByName$ = "": Exit Function RtlMoveMemory host, hostent_addr&, LenB(host) For i% = 0 To adapter% 'Wenn schon eher ein Eintrag 0 ist, dann ist Adapter-Wert zu groß! RtlMoveMemory hostip_addr&, host.hAddrList + 4 * i%, 4 If hostip_addr& = 0 Then HostByName$ = "": Exit Function Next ReDim temp_ip_address(1 To host.hLength) RtlMoveMemory temp_ip_address(1), hostip_addr&, host.hLength ip_address$ = "" For i = 1 To host.hLength ip_address$ = ip_address$ & temp_ip_address(i) & "." Next ip_address$ = Left$(ip_address$, Len(ip_address$) - 1) HostByName$ = ip_address$ End Function Public Function MyHostName$() Dim hostname As String * 256 If gethostname(hostname, 256) = SOCKET_ERROR Then MsgBox "Windows Sockets error " & Str(WSAGetLastError()) Exit Function Else MyHostName$ = zeichennext$(Trim$(hostname), Chr$(0)) End If End Function Public Sub SocketsInitialize() Dim WSAD As WSADATA iReturn% = WSAStartup(WS_VERSION_REQD, WSAD) If iReturn% <> 0 Then MsgBox "Winsock.dll is not responding." End End If If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And _ hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then sHighByte$ = Trim$(Str$(hibyte(WSAD.wversion))) sLowByte$ = Trim$(Str$(lobyte(WSAD.wversion))) sMsg$ = "Windows Sockets version " & sLowByte$ & "." & sHighByte$ sMsg$ = sMsg$ & " is not supported by winsock.dll " MsgBox sMsg$ End End If If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then sMsg$ = "This application requires a minimum of " sMsg$ = sMsg$ & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets." MsgBox sMsg$ End End If End Sub Public Sub SocketsCleanup() lReturn& = WSACleanup() If lReturn& <> 0 Then MsgBox "Socket error " & Trim$(Str$(lReturn&)) & " occurred in Cleanup " End End If End Sub Private Function lobyte(ByVal wParam As Integer) lobyte = wParam And &HFF& End Function Private Function hibyte(ByVal wParam As Integer) hibyte = wParam \ &H100 And &HFF& End Function Private Function zeichennext$(a$, ch$) ai% = InStr(a$, ch$) If ai% = 0 Then zeichennext$ = a$: a$ = "" Else zeichennext$ = Left$(a$, ai% - 1): a$ = Mid$(a$, ai% + Len(ch$)) End If End Function