It has been mentioned that a ghosted machine or a machine linked
by cable modem and USB may result in my reading a MAC address
other than one burned onto a NIC in the machine. That being the
case, I would have a problem.
I am using the following code. Blindly, I grabbed it from an old post
in this forum. It worked for me on one machine. I didn't give much
thought to situations in which I might be reading unreliable data.
If you know something about this sort of thing, please glance at the
code I'm using and tell me your thoughts. The following class module
resides in and is launched from within a form in A97...
Private Sub RetrieveMACaddresses()
'This sub demonstrates the use of fGetSecurityCode
Dim theAddress() As String
Dim i As Integer
Dim retVal
retVal = fGetSecurityCode(theAddress)
If retVal = MACOk Then
For i = 0 To UBound(theAddress)
Debug.Print theAddress(i)
Next i
Else
Select Case retVal
Case errMAC16bit
MsgBox "This is a 16 bit Netbios implementation,
function is meant for 32 bit!", vbOKOnly + vbInformation
Case errMACNoNetBios
MsgBox "No network card or NetBios not installed!",
vbOKOnly + vbInformation
Case errMACUnknown
MsgBox "Unknow error in Netbios call!", vbOKOnly +
vbInformation
Case errMACnoMACerror
'The function has already reported a VBA or Jet error,
no MsgBox needed
Case Else
'stumped!?
End Select
End If
End Sub
Then, of course, there's the supporting code in a standard module
that looks like this...
Option Compare Database
Option Explicit
Option Base 0
Public Const errMACNoNetBios As Integer = 1
Public Const errMAC16bit As Integer = 2
Public Const errMACUnknown As Integer = 3
Public Const errMACnoMACerror = 4
Public Const MACOk As Integer = 0
Public Const NCBASTAT As Long = &H33
Public Const NCBNAMSZ As Long = 16
Public Const NCBRESET As Long = &H32
Public Const NCBENUM = &H37 ' NCB ENUMERATE LANA NUMBERS
Public Const MAX_LANA = 254
Public Type LANA_ENUM
Length As Byte
lana(MAX_LANA) As Byte
End Type
'- Hide quoted text -
'- Show quoted text -
Public 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(9) As Byte ' Reserved, must be 0
ncb_event As Long
End Type
Public Type ADAPTER_STATUS
adapter_address(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
Public Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End Type
Public Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End Type
Public Declare Function Netbios Lib "netapi32.dll" _
(pncb As NET_CONTROL_BLOCK) As Byte
Function fGetSecurityCode(MACaddress() As String) As Integer
Dim structAST As ASTAT
Dim structLana As LANA_ENUM
Dim structNCB As NET_CONTROL_BLOCK
Dim retVal As Byte
Dim strHex As String
Dim strErr As String
Dim i As Integer, j As Integer
On Error GoTo Err_Handler
structNCB.ncb_command = NCBENUM
structNCB.ncb_buffer = VarPtr(structLana)
structNCB.ncb_length = Len(structLana)
retVal = Netbios(structNCB)
If retVal <> 0 Then
'NCBENUM is not available in the 16 bit dll
'should only occur if you change "netapi32.dll" in the API
declaration
fGetSecurityCode = errMAC16bit
GoTo Done_function
End If
If structLana.Length = 0 Then
'No network card or NetBios not installed
fGetSecurityCode = errMACNoNetBios
GoTo Done_function
Else
ReDim MACaddress(structLana.Length - 1)
For i = 0 To structLana.Length - 1
structNCB.ncb_lana_num = structLana.lana(i)
structNCB.ncb_command = NCBRESET
retVal = Netbios(structNCB)
'All should be Ok if we've come this far, but we'll check
anyway
If retVal <> 0 Then
fGetSecurityCode = errMACUnknown
GoTo Done_function
End If
structNCB.ncb_command = NCBASTAT
structNCB.ncb_buffer = VarPtr(structAST)
structNCB.ncb_lana_num = structLana.lana(i)
structNCB.ncb_length = Len(structAST)
structNCB.ncb_callname = "*"
retVal = Netbios(structNCB)
If retVal = 0 Then
'All's well
fGetSecurityCode = MACOk
For j = 0 To 5
strHex = Hex$(structAST.adapt.adapter_address(j))
If Len(Trim$(strHex)) = 1 Then strHex = "0" +
Trim$(strHex)
MACaddress(i) = MACaddress(i) & strHex
Next j
Else
fGetSecurityCode = errMACUnknown
GoTo Done_function
End If
Next i
End If
Done_function:
Exit Function
Err_Handler:
'This error is not caused by any illegal NetBios calls
fGetSecurityCode = errMACnoMACerror
strErr = Str(Err.Number) & ":" & Err.Description
MsgBox Err.Number
Resume Done_function
End Function
Function ReadHardwareSecurityCode()
'************************************************* ******************
' Read hardware security code.
'************************************************* ******************
On Error GoTo Err_ReadHardwareSecurityCode_Click
Dim ThisFN As String, MyMsg As String
ThisFN = "ReadHardwareSecurityCode"
100 Dim theCode() As String
110 Dim i As Integer
120 Dim retVal
130 retVal = fGetSecurityCode(theCode)
140 If retVal = MACOk Then
150 For i = 0 To UBound(theCode) 'UBound returns a Long
containing the largest available subscript for the indicated dimension
of an array.
160 SecureID = CStr(theCode(i))
170 Next i
180 Else
190 Select Case retVal
Case errMAC16bit
MyMsg = "This is a 16 bit Netbios implementation,
function is meant for 32 bit!"
MsgBox MyMsg & MyApp$ & ", rev. " & MY_VERSION$
Case errMACNoNetBios
MyMsg = "No network card or NetBios not
installed!"
MsgBox MyMsg & MyApp$ & ", rev. " & MY_VERSION$
Case errMACUnknown
MyMsg = "Unknow error in Netbios call!"
MsgBox MyMsg & MyApp$ & ", rev. " & MY_VERSION$
Case errMACnoMACerror
'The function has already reported a VBA or Jet error,
no MsgBox needed
Case Else
'stumped!?
200 End Select
210 End If
220 ReadHardwareSecurityCode = retVal
Exit_ReadHardwareSecurityCode_Click:
Exit Function
Err_ReadHardwareSecurityCode_Click:
Dim r As String, k As String, Message3 As String
r = "The following unexpected error occurred in line #" & Erl & "
in FN ReadHardwareSecurityCode, in " & ThisFN & " standard module."
k = CRLF & CRLF & Str$(Err) & ": " & Quote & Error$ & Quote
Message3 = r & k
MsgBox Message3, 48, "Unexpected Error - " & MyApp$ & ", rev. " &
MY_VERSION$
Resume Exit_ReadHardwareSecurityCode_Click
End Function