Newsgroup: it.comp.lang.visual-basic
Titolo: hw-lan-address

Ciao a tutti,
sto cercando una funzione che ritorni o consenta di accedere al
hw-lan-address di una scheda di rete (per intenderci quello che su Nt4 si
vede
usando winmsd.exe, tab rete, button trasporti,  output della colonna
indirizzo.......)
Qualcuno sa qualcosa ?
Grazie
--
Fabio
mailto:
fle...@tin.it


Newsgroups: it.comp.lang.visual-basic
Subject: Re: [?] MAC Address (molto lungo)
Date: Thu, 19 Oct 2000 01:22:37 +0200
la parte importante del codice qui sotto (un solo frm) deriva direttamente
da scott+michelle, se ricordo. mi sembra funzioni anche con 2 schede di rete
sulla stessa macchina, tipo proxy. da' pure -- se ne ha voglia, chi ne
capisce potrebbe dire esattamente cos'e' -- il numerino del ppp, se hai
anche un ras configurato. l'avevo testato su 95 e nt. l'ho appena provato su
win2000.
unica cosa: qui mi ripete il ppp 3 volte e il mac 2.
non so se e' possibile fargli dare i numeri una volta sola.
ciao, a.
Option Explicit
Private Const NCBNAMSZ = 16
Private Const MAX_LANA = 254
Private Const NCBENUM = &H37
Private Const NCBRESET = &H32
Private Const NCBASTAT = &H33
Private Type ADAPTER_STATUS
adapter_address(0 To 5) As Byte
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_(0 To NCBNAMSZ - 1) As Byte
name_num As Byte
name_flags As Byte
End Type
Private Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(0 To 29) As NAME_BUFFER
End Type
Private Type NCB
ncb_command As Byte
ncb_retcode As Byte
ncb_lsn As Byte
ncb_num As Byte
p_ncb_buffer As Long
ncb_length As Integer
ncb_callname(0 To NCBNAMSZ - 1) As Byte
ncb_name(0 To NCBNAMSZ - 1) As Byte
ncb_rto As Byte
ncb_sto As Byte
p_ncb_post As Long
ncb_lana_num As Byte
ncb_cmd_cplt As Byte
ncb_reserve(0 To 10 - 1) As Byte
ncb_event As Long
End Type
Private Type LANA_ENUM
length As Byte
lana(0 To MAX_LANA - 1) As Byte
End Type
Private Declare Function Netbios Lib "netapi32.dll" _
(pncb As NCB) As Byte
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, src As Any, ByVal length As Long) As Long
Public Sub GetMacAddress(colMacAddress As Collection)
Dim Adapter As ASTAT
Dim SNcb As NCB
Dim uRetCode As Byte
Dim NetName(0 To 49) As Byte
Dim Blank(Len(SNcb)) As Byte
Dim Blank2(Len(Adapter)) As Byte
Dim lenum As LANA_ENUM
Dim i As Long
Dim j As Long
Dim sMac As String
CopyMemory SNcb, Blank(0), Len(SNcb)
With SNcb
.ncb_command = NCBENUM
.p_ncb_buffer = VarPtr(lenum)
.ncb_length = Len(lenum)
End With
uRetCode = Netbios(SNcb)
For i = 0 To lenum.length - 1
CopyMemory SNcb, Blank(0), Len(SNcb)
With SNcb
.ncb_command = NCBRESET
.ncb_lana_num = lenum.lana(i)
End With
uRetCode = Netbios(SNcb)
CopyMemory SNcb, Blank(0), Len(SNcb)
CopyMemory Adapter, Blank2(0), Len(Adapter)
With SNcb
.ncb_command = NCBASTAT
.ncb_lana_num = lenum.lana(i)
.p_ncb_buffer = VarPtr(Adapter)
.ncb_length = Len(Adapter)
.ncb_callname(0) = Asc("*")
For j = 1 To 15
.ncb_callname(j) = Asc(" ")
Next
End With
uRetCode = Netbios(SNcb)
If uRetCode = 0 Then
With Adapter.adapt
sMac = Right("00" & Hex(.adapter_address(0)), 2) & _
Right("00" & Hex(.adapter_address(1)), 2) & _
Right("00" & Hex(.adapter_address(2)), 2) & _
Right("00" & Hex(.adapter_address(3)), 2) & _
Right("00" & Hex(.adapter_address(4)), 2) & _
Right("00" & Hex(.adapter_address(5)), 2)
End With
colMacAddress.Add sMac
End If
Next
End Sub
Private Sub Command1_Click()
On Error GoTo errman
Dim col As Collection
Dim vItem As Variant
Set col = New Collection
GetMacAddress col
Text1 = ""
For Each vItem In col
Text1 = Text1 & vbCrLf & vItem
Next
Exit Sub
errman: MsgBox Error
End Sub
Private Sub Command2_Click()
On Error GoTo errman
If Text1 = "" Then
MsgBox "You should get it before..."
Exit Sub
End If
Clipboard.Clear
Clipboard.SetText Text1
Exit Sub
errman: MsgBox Error
End Sub
Private Sub Command3_Click()
On Error GoTo errman
Unload Me
Exit Sub
errman: MsgBox Error
End Sub
Private Sub Command4_Click()
On Error GoTo errman
If Text1.SelText = "" Then
MsgBox "You should select something..."
Exit Sub
End If
Clipboard.Clear
Clipboard.SetText Text1.SelText
Exit Sub
errman: MsgBox Error
End Sub
Private Sub Command5_Click()
On Error GoTo errman
Dim r As Long
r = Shell("clipbrd.exe", vbNormalFocus)
Exit Sub
errman: MsgBox Error
End Sub

 se non stai leggendo: faq++ (forse attira la tua attenzione :)
Sto leggendo, ed ho aggiunto pure questo.
Il codice che riporti non è che mi piaccia più di tanto,
comunque questa è sicuramente una FAQ.