Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32Private Type 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 TypePrivate 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 TypePrivate Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End TypePrivate Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End TypePrivate Declare Function Netbios Lib "netapi32.dll" _
(pncb As NCB) As BytePrivate 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 LongPrivate Declare Function HeapAlloc Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, _
ByVal dwBytes As Long) As LongPrivate Declare Function HeapFree Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) _
As LongPrivate Function EthernetAddress(LanaNumber As Long) _
As String Dim udtNCB As NCB
Dim bytResponse As Byte
Dim udtASTAT As ASTAT
Dim udtTempASTAT As ASTAT
Dim lngASTAT As Long
Dim strOut As String
Dim x As Integer udtNCB.ncb_command = NCBRESET
bytResponse = Netbios(udtNCB)
udtNCB.ncb_command = NCBASTAT
udtNCB.ncb_lana_num = LanaNumber
udtNCB.ncb_callname = "* "
udtNCB.ncb_length = Len(udtASTAT)
lngASTAT = HeapAlloc(GetProcessHeap(), _
HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length) strOut = ""
If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
With udtASTAT.adapt
For x = 0 To 5
strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
Next x
End With
HeapFree GetProcessHeap(), 0, lngASTAT
End If
EthernetAddress = strOut
End FunctionPrivate Sub Command1_Click()
MsgBox EthernetAddress(0)
End Sub
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32Private Type 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 TypePrivate 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 TypePrivate Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End TypePrivate Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End TypePrivate Declare Function Netbios Lib "netapi32.dll" _
(pncb As NCB) As BytePrivate 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 LongPrivate Declare Function HeapAlloc Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, _
ByVal dwBytes As Long) As LongPrivate Declare Function HeapFree Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) _
As LongPrivate Function EthernetAddress(LanaNumber As Long) _
As String Dim udtNCB As NCB
Dim bytResponse As Byte
Dim udtASTAT As ASTAT
Dim udtTempASTAT As ASTAT
Dim lngASTAT As Long
Dim strOut As String
Dim x As Integer udtNCB.ncb_command = NCBRESET
bytResponse = Netbios(udtNCB)
udtNCB.ncb_command = NCBASTAT
udtNCB.ncb_lana_num = LanaNumber
udtNCB.ncb_callname = "* "
udtNCB.ncb_length = Len(udtASTAT)
lngASTAT = HeapAlloc(GetProcessHeap(), _
HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length) strOut = ""
If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
With udtASTAT.adapt
For x = 0 To 5
strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
Next x
End With
HeapFree GetProcessHeap(), 0, lngASTAT
End If
EthernetAddress = strOut
End FunctionPrivate Sub Command1_Click()
MsgBox EthernetAddress(0)
End Sub
解决方案 »
- 如何修改系统时间形式
- VB调用VC写的DLL退出时出错
- 参数类型不正确,或不在可以接受的范围之内,或与其他参数冲突;
- 呵呵,可用分正好1024!
- 菜鸟请问当数据库采用模糊查询的时候,由于有的查到1个记录,有的查到多个记录,那么怎么设计好,谢谢!
- 如何获取dbgrid中某行某列中的数据?
- 高分求一段程序!!!!有关数据库搜索显示的。
- 关于Microsoft ActiveX Data Objects 2.0 library控件的问题?
- 没有女朋友的元旦怎么过!散分!
- 怎样在程序里面控制传真机
- vb中shell命令的使用方法
- ***我写的软件在没装过VB的机器上安装后运行,出现“不能初始化绑定数据库”为什么?我用的是ADODC来连接ACCESS数据库***
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32Private Type 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 TypePrivate 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 TypePrivate Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End TypePrivate Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End TypePrivate Declare Function Netbios Lib "netapi32.dll" _
(pncb As NCB) As BytePrivate 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 LongPrivate Declare Function HeapAlloc Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, _
ByVal dwBytes As Long) As LongPrivate Declare Function HeapFree Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) _
As LongPrivate Function EthernetAddress(LanaNumber As Long) _
As String Dim udtNCB As NCB
Dim bytResponse As Byte
Dim udtASTAT As ASTAT
Dim udtTempASTAT As ASTAT
Dim lngASTAT As Long
Dim strOut As String
Dim x As Integer udtNCB.ncb_command = NCBRESET
bytResponse = Netbios(udtNCB)
udtNCB.ncb_command = NCBASTAT
udtNCB.ncb_lana_num = LanaNumber
udtNCB.ncb_callname = "* "
udtNCB.ncb_length = Len(udtASTAT)
lngASTAT = HeapAlloc(GetProcessHeap(), _
HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length) strOut = ""
If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
With udtASTAT.adapt
For x = 0 To 5
strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
Next x
End With
HeapFree GetProcessHeap(), 0, lngASTAT
End If
EthernetAddress = strOut
End FunctionPrivate Sub Command1_Click()
MsgBox EthernetAddress(0)
End Sub