|
| |
Visual-Basic Einsteiger| Re: TCP/IP Adresse | |  | | Autor: Ralf | | Datum: 27.11.01 10:41 |
| Mit folgenden Code ermittelst du anhand des Computernamens die IP, das Betriebssystem die Domain, das Root-Verzeichnis (nur Win9x), die Winsock Version und die Anzahl der eingeloggten User.
' Die nötigen Konstanten Typ- und
' Funktionsdeklarationen für die API-Aufrufe
Private Const MIN_SOCKETS_REQD As Long = 1
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 ERROR_SUCCESS = 0&
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const PLATFORM_ID_DOS = 300
Private Const PLATFORM_ID_OS2 = 400
Private Const PLATFORM_ID_NT = 500
Private Const PLATFORM_ID_OSF = 600
Private Const PLATFORM_ID_VMS = 700
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
Private Type WKSTA_INFO_102
wki100_platform_id As Long
pwki100_computername As Long
pwki100_langroup As Long
wki100_ver_major As Long
wki100_ver_minor As Long
pwki102_lanroot As Long
wki102_logged_on_users As Long
End Type
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type
Declare Function WSAStartup Lib "WSOCK32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSAData) As Long
Declare Function WSACleanup Lib "WSOCK32" () As Long
Declare Function NetWkstaGetInfo Lib "netapi32" _
(ByVal servername As String, ByVal level As Long, _
lpBuf As Any) As Long
Private Declare Function NetApiBufferFree Lib _
"netapi32" (ByVal Buffer As Long) As Long
Declare Function gethostbyname Lib "WSOCK32" _
(ByVal szHost As String) As Long
Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (hpvDest As Any, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Dim WSAD As WSAData
' Zu übergeben ist der Computername inkl. vorangestellten
' "\", also z.B. "\PCTest"
' Zurückgelifert wird ein String, in dem die Werte per
' vbCrLf getrennt sind
Public Function GetComputerInfo(ByVal strComputername As _
String) As String
Dim lpHost As Long
Dim m_Host As HOSTENT
Dim lIP As Long
Dim tmpIP() As Byte
Dim i As Integer
Dim strIP As String
Dim strErgebnis As String
Dim strTemp As String
'Winsock initialisieren
If Not SocketsInitialize() Then Exit Function
' ====================================================
' IP-ADRESSE DES COMPUTERS ERMITTELN
'
' Anschliessend die Daten holen und für VB zugänglich
' machen
' Zuerst kümmern wir uns um die IP-Adresse
lpHost = gethostbyname(ByVal Replace(strComputername, _
"\", ""))
If lpHost = 0 Then Exit Function
CopyMemory m_Host, ByVal lpHost, ByVal Len(m_Host)
' erst die Adresse in eine Longvariable kopieren
CopyMemory lIP, ByVal m_Host.hAddrList, ByVal 4
' und dann Stück für Stück in ein Bytefeld
ReDim tmpIP(1 To m_Host.hLen)
CopyMemory tmpIP(1), ByVal lIP, ByVal m_Host.hLen
' Das Bytefeld in einen String umwandeln
For i = 1 To m_Host.hLen
strIP = strIP & tmpIP(i) & "."
Next
' aber den letzten Punkt weglassen
strErgebnis = "IP-Adresse: " & Mid$(strIP, 1, _
Len(strIP) - 1) & vbCrLf
'
' ====================================================
' Wir wollen auch die Winsock Daten haben
' (weil Sie da sind
With WSAD
' Winsock-Version
For i = LBound(.szDescription) To UBound(.szDescription)
If .szDescription(i) <> 0 Then
strTemp = strTemp & Chr$(.szDescription(i))
Else
Exit For
End If
Next i
strErgebnis = strErgebnis & "Winsock Version: " & _
strTemp & vbCrLf
strTemp = ""
' Winsock-Status
For i = LBound(.szSystemStatus) To UBound(.szSystemStatus)
If .szSystemStatus(i) <> 0 Then
strTemp = strTemp & Chr$(WSAD.szSystemStatus(i))
Else
Exit For
End If
Next i
strErgebnis = strErgebnis & "Winsock Status: " & _
strTemp & vbCrLf
End With
' Ab hier sind wir mit Winsock fertig und räumen auf
SocketsCleanup
' Nun geht es an die Netzwerkdaten eines Computer
Dim pWrkInfo As Long
Dim WrkInfo(0) As WKSTA_INFO_102
Dim lResult As Long
lResult = NetWkstaGetInfo(StrConv(strComputername, _
vbUnicode), 102, pWrkInfo)
If lResult = 0 Then
Dim cname As String
cname = String$(255, 0)
CopyMemory WrkInfo(0), ByVal pWrkInfo, _
ByVal Len(WrkInfo(0))
CopyMemory ByVal cname, _
ByVal WrkInfo(0).pwki100_langroup, ByVal 255
strErgebnis = strErgebnis & "Domain: " & _
StripTerminator(StrConv(cname, vbFromUnicode)) & _
vbCrLf
strErgebnis = strErgebnis & "Betriebssystem: "
Select Case WrkInfo(0).wki100_platform_id
Case PLATFORM_ID_DOS
strErgebnis = strErgebnis & "DOS"
Case PLATFORM_ID_OS2
If WrkInfo(0).wki100_ver_major = "4" Then
strErgebnis = strErgebnis & "Win9x"
Else
strErgebnis = strErgebnis & "OS2"
End If
Case PLATFORM_ID_NT
If WrkInfo(0).wki100_ver_major = "5" Then
strErgebnis = strErgebnis & "Win 2000"
Else
strErgebnis = strErgebnis & "NT"
End If
Case PLATFORM_ID_OSF
strErgebnis = strErgebnis & "OSF"
Case PLATFORM_ID_VMS
strErgebnis = strErgebnis & "VMS"
End Select
strErgebnis = strErgebnis & " Version " & _
WrkInfo(0).wki100_ver_major & "." & _
WrkInfo(0).wki100_ver_minor
cname = String$(255, 0)
CopyMemory ByVal cname, _
ByVal WrkInfo(0).pwki102_lanroot, ByVal 255
strErgebnis = strErgebnis & "Lan Root: " & _
StripTerminator(StrConv(cname, vbFromUnicode))
strErgebnis = strErgebnis & "Eingeloggte Benutzer: " & _
Str$(WrkInfo(0).wki102_logged_on_users)
' Nach einem erfolgreichen NetWkstaGetInfo den
' benutzten API-Buffer wieder freigeben
NetApiBufferFree ByVal pWrkInfo
End If
GetComputerInfo = strErgebnis
End Function
' Dieser Teil stammt aus dem Programm API-Guide
' KPD-Team 1999
' URL: http://www.allapi.net/
' E-Mail: KPDTeam@Allapi.net
Public Function HiByte(ByVal wParam As Integer)
HiByte = wParam &H100 And &HFF&
End Function
Public Function LoByte(ByVal wParam As Integer)
LoByte = wParam And &HFF&
End Function
Public Sub SocketsCleanup()
If WSACleanup() <> ERROR_SUCCESS Then
MsgBox "Socket Fehler in Cleanup"
End If
End Sub
Private Function SocketsInitialize() As Boolean
Dim sLoByte As String
Dim sHiByte As String
' Prüfen, ob Winsock.DLL vorhanden
If WSAStartup(WS_VERSION_REQD, WSAD) <> _
ERROR_SUCCESS Then
MsgBox "Programm konnte keine funktionsfähige " & _
"Winsock.DLL finden"
SocketsInitialize = False
Exit Function
End If
' nicht genügend Sockets
If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
MsgBox "Das Programm muß mindestens " & _
CStr(MIN_SOCKETS_REQD) & _
" Sockets öffnen können."
SocketsInitialize = False
Exit Function
End If
If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
(LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
sHiByte = CStr(HiByte(WSAD.wVersion))
sLoByte = CStr(LoByte(WSAD.wVersion))
MsgBox "Die Socket Version " & sLoByte & "." & _
sHiByte & " wird nicht unterstützt."
SocketsInitialize = False
Exit Function
End If
SocketsInitialize = True
End Function
' Diese Funktion erleichtert einen VB-String um
' Chr$(0) am Ende
Private Function StripTerminator(sInput As String) As _
String
Dim ZeroPos As Integer
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If
End Function
entnommen aus dem Tipps&Tricks Bereich des VBArchivs
Gruss
Ralf | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
Neu! sevCommand 4.0 
Professionelle Schaltflächen im modernen Design!
Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. Weitere InfosTipp des Monats TOP Entwickler-Paket 
TOP-Preis!!
Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1866.50 EUR...
Jetzt nur 979,00 EURWeitere Infos
|
November 2025
Sie sind aktuell nicht angemeldet.
