Wie finde ich mit VB die Ids im Lan heraus??

Antwort von nach einem Tag 0 hilfreich

Re: Wie finde ich mit VB die Ids im Lan heraus??

www.vbarchiv.de

Geht mithilfe von API:

Achtung, festhalten :-D Langer Code:

' 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: [E-Mail-Adresse entfernt]
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

Viel Glück :-D

lan netz ip VB adresse ID ids

Wie finde ich mit VB die Ids im Lan heraus??

7 Antworten zu dieser Frage

Antwort von nach einer Minute 0 hilfreich

Re: Wie finde ich mit VB die Ids im Lan heraus??

Antwort von nach 15 Stunden 0 hilfreich

Re^2: Wie finde ich mit VB die Ids im Lan heraus??

Antwort von nach 14 Stunden 0 hilfreich

Re: Wie finde ich mit VB die Ids im Lan heraus??

Antwort von nach 18 Stunden 0 hilfreich

Re^2: Wie finde ich mit VB die Ids im Lan heraus??

Antwort von nach 19 Stunden 0 hilfreich

Re^3: Wie finde ich mit VB die Ids im Lan heraus??

Antwort von nach einem Tag 0 hilfreich

Re: Wie finde ich mit VB die Ids im Lan heraus??

Antwort von nach 2 Tagen 0 hilfreich

Re^2: Wie finde ich mit VB die Ids im Lan heraus??