title image


Smiley Re: Schau mal...
Das Beispiel von dir listet ca. 30-40 Geräte.



Habe mittlerweile eine Funktion gefunden, die die "Anzahl gefundener LAN Adapter" listet.

Das funktioniert so:



Ist mein USB DSL Modem ausgestöpselt:

Anzeige: 0 Lan adapters found



Ist das USB DSL Modem eingestöpselt, und es besteht keine Internetverbindung:

Anzeige: 1 Lan adapters found



Ist das USB DSL Modem eingestöpselt, und es besteht bereits eine Internetverbindung:

Anzeige: 2 Lan adapters found



Zusätzlich wird die Mac adressen-Nummer angezeigt, wenn man mit dem Internet verbunden ist.





Benötigt 1 Timer auf Form1:

*****************************

Option Explicit



Private Const NCBASTAT As Long = &H33

Private Const NCBRESET As Long = &H32

Private Const NCBENUM As Long = &H37

Private Const NRC_GOODRET As Long = &H0

Private Const MAX_LANA As Long = 254

Private Const NCBNAMSZ As Long = 16

Private Const HEAP_ZERO_MEMORY As Long = &H8

Private Const HEAP_GENERATE_EXCEPTIONS As Long = &H4



Private Type LANA_ENUM

length As Byte

adapter_numbers(0 To MAX_LANA) As Byte 'lanas in range 0 to MAX_LANA inclusive

End Type



Private Type NET_CONTROL_BLOCK 'NCB

ncb_command As Byte

ncb_retcode As Byte

ncb_lsn As Byte

ncb_num As Byte

ncb_buffer As Long

ncb_length As Integer

ncb_callname As String * NCBNAMSZ

ncb_name As String * NCBNAMSZ

ncb_rto As Byte

ncb_sto As Byte

ncb_post As Long

ncb_lana_num As Byte

ncb_cmd_cplt As Byte

ncb_reserve(0 To 9) As Byte 'if Win64, make (0 to 17)

ncb_event As Long

End Type



Private Type ADAPTER_STATUS

adapter_address(0 To 5) As Byte '6 elements

rev_major As Byte

reserved0 As Byte

adapter_type As Byte

rev_minor As Byte

duration As Integer

frmr_recv As Integer

frmr_xmit As Integer

iframe_recv_err As Integer

xmit_aborts As Integer

xmit_success As Long

recv_success As Long

iframe_xmit_err As Integer

recv_buff_unavail As Integer

t1_timeouts As Integer

ti_timeouts As Integer

Reserved1 As Long

free_ncbs As Integer

max_cfg_ncbs As Integer

max_ncbs As Integer

xmit_buf_unavail As Integer

max_dgram_size As Integer

pending_sess As Integer

max_cfg_sess As Integer

max_sess As Integer

max_sess_pkt_size As Integer

name_count As Integer

End Type



Private Type NAME_BUFFER

name As String * NCBNAMSZ

name_num As Integer

name_flags As Integer

End Type



Private Type ASTAT

adapt As ADAPTER_STATUS

NameBuff(0 To 30) As NAME_BUFFER

End Type



Private Declare Function Netbios Lib "netapi32.dll" _

(pncb As NET_CONTROL_BLOCK) As Byte



Private Declare Sub CopyMemory Lib "kernel32" _

Alias "RtlMoveMemory" _

(hpvDest As Any, ByVal _

hpvSource As Long, ByVal _

cbCopy As Long)



Private Declare Function GetProcessHeap Lib "kernel32" () As Long



Private Declare Function HeapAlloc Lib "kernel32" _

(ByVal hHeap As Long, _

ByVal dwFlags As Long, _

ByVal dwBytes As Long) As Long



Private Declare Function HeapFree Lib "kernel32" _

(ByVal hHeap As Long, _

ByVal dwFlags As Long, _

lpMem As Any) As Long



Private Sub Form_Load()

Timer1.Interval = 250

AutoRedraw = -1

Move 0, 0, 15 * 300, 15 * 200

Caption = "Enum Lan adapters (Lanas)"

End Sub



Private Function GetNBMacAddresses(sMACAddresses() As String, sDelimiter As String) As Long



Dim cnt As Long

Dim pASTAT As Long

Dim buff As String

Dim lana As LANA_ENUM 'enum values

Dim ncb As NET_CONTROL_BLOCK

Dim ast As ASTAT



With ncb

.ncb_command = NCBENUM

.ncb_length = LenB(lana)

.ncb_buffer = VarPtr(lana)

End With



Call Netbios(ncb)



If ncb.ncb_retcode = NRC_GOODRET Then



ReDim sMACAddresses(0 To lana.length)



For cnt = 1 To lana.length

With ncb

.ncb_command = NCBRESET

.ncb_lana_num = lana.adapter_numbers(cnt)

End With



Call Netbios(ncb)



If ncb.ncb_retcode = NRC_GOODRET Then





With ncb

.ncb_command = NCBASTAT

.ncb_lana_num = lana.adapter_numbers(cnt)

.ncb_length = Len(ast)

.ncb_callname = Space$(16)

Mid$(.ncb_callname, 1, 1) = "*"

End With



'allocate memory for the ASTAT struct

pASTAT = HeapAlloc(GetProcessHeap(), _

HEAP_GENERATE_EXCEPTIONS Or _

HEAP_ZERO_MEMORY, _

ncb.ncb_length)



If pASTAT 0 Then



ncb.ncb_buffer = pASTAT

Call Netbios(ncb)



If ncb.ncb_retcode = NRC_GOODRET Then



CopyMemory ast, ncb.ncb_buffer, Len(ast)



'convert the byte array to a string

sMACAddresses(cnt) = MakeMacAddress(ast.adapt.adapter_address(), sDelimiter)

HeapFree GetProcessHeap(), 0, pASTAT



End If 'ncb.ncb_retcode = NRC_GOODRET (NCBASTAT call)



Else

Debug.Print "HeapAlloc memory allcoation failed!"

End If 'pastat



End If 'ncb.ncb_retcode



Next 'cnt



'return number of adapters enumerated

GetNBMacAddresses = lana.length



End If 'ncb.ncb_retcode



End Function



Private Function MakeMacAddress(b() As Byte, sDelim As String) As String



Dim cnt As Long

Dim buff As String



On Local Error GoTo MakeMac_error



If UBound(b) = 5 Then



For cnt = 0 To 4

buff = buff & Right$("00" & Hex(b(cnt)), 2) & sDelim

Next



'and append the last value

buff = buff & Right$("00" & Hex(b(5)), 2)



End If 'UBound(b)



MakeMacAddress = buff



MakeMac_exit:

Exit Function



MakeMac_error:

MakeMacAddress = "(error building MAC address)"

Resume MakeMac_exit



End Function



Private Sub Timer1_Timer()

Form1.Cls

Print "Random = " & Format(Right(Rnd * 1000000, 2), "00"): Print

Dim cnt As Long, numLanas As Long, sMACAddresses() As String



numLanas = GetNBMacAddresses(sMACAddresses(), " ")





Print "Lan adapters found : " & numLanas



For cnt = 0 To numLanas - 1

If sMACAddresses(cnt) "" Then

Print: Print "MAC Address of Lana " & cnt & " : " & sMACAddresses(cnt)

End If

Next



End Sub


 Die von mir vorgeschlagenen Lösungen wurden unter VB6 getestet (Betriebssystem: Windows 98 SE)
Meine Microsite


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: