于振海网——于振海的个人博客搜索

vb获取mac地址模块

发布时间:2011年11月20日  更新时间:2024年6月9日
作者:未知  文章ID:506  浏览:

Public CheckCode As Long

Private Const NCBASTAT                       As Long = &H33
Private Const NCBNAMSZ                       As Integer = 16
Private Const HEAP_ZERO_MEMORY               As Long = &H8
Private Const HEAP_GENERATE_EXCEPTIONS       As Long = &H4
Private Const NCBRESET                       As Long = &H32
Private 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
    ncb_event                                  As Long
End Type
Private 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
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(30)                               As NAME_BUFFER
End Type
Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) 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

Public Function GetMAC() As Integer

 
  Dim bRet    As Byte
  Dim myNcb   As NCB
  Dim myASTAT As ASTAT
  Dim pASTAT  As Long
  Dim intMAC As Integer
 
    myNcb.ncb_command = NCBRESET
    bRet = Netbios(myNcb)
    With myNcb
        .ncb_command = NCBASTAT
        .ncb_lana_num = 0
        .ncb_callname = "* "
        .ncb_length = Len(myASTAT)
        pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, .ncb_length)
    End With
    If pASTAT = 0 Then
        Exit Function
    End If
    myNcb.ncb_buffer = pASTAT
    bRet = Netbios(myNcb)
    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
    intMAC = myASTAT.adapt.adapter_address(0)
    intMAC = intMAC + myASTAT.adapt.adapter_address(1)
    intMAC = intMAC + myASTAT.adapt.adapter_address(2)
    intMAC = intMAC + myASTAT.adapt.adapter_address(3)
    intMAC = intMAC + myASTAT.adapt.adapter_address(4)
    intMAC = intMAC + myASTAT.adapt.adapter_address(5)
    GetMAC = intMAC
    Call HeapFree(GetProcessHeap(), 0, pASTAT)

End Function

Public Function GetMACAddress() As String

 
  Dim bRet    As Byte
  Dim myNcb   As NCB
  Dim myASTAT As ASTAT
  Dim pASTAT  As Long
    myNcb.ncb_command = NCBRESET
    bRet = Netbios(myNcb)
    With myNcb
        .ncb_command = NCBASTAT
        .ncb_lana_num = 0
        .ncb_callname = "* "
        .ncb_length = Len(myASTAT)
        pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, .ncb_length)
    End With
    If pASTAT = 0 Then
        Exit Function
    End If
    myNcb.ncb_buffer = pASTAT
    bRet = Netbios(myNcb)
    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
    GetMACAddress = HexEx(myASTAT.adapt.adapter_address(0)) & "-" & HexEx(myASTAT.adapt.adapter_address(1)) & "-" & HexEx(myASTAT.adapt.adapter_address(2)) & "-" & HexEx(myASTAT.adapt.adapter_address(3)) & "-" & HexEx(myASTAT.adapt.adapter_address(4)) & "-" & HexEx(myASTAT.adapt.adapter_address(5))
    Call HeapFree(GetProcessHeap(), 0, pASTAT)

End Function

Private Function HexEx(ByVal B As Long) As String
 
  Dim aa As String

    aa = Hex$(B)
    If Len(aa) < 2 Then
        aa = "0" & aa
    End If
    HexEx = aa

End Function

Private Sub Command1_Click()
MsgBox GetMACAddress
End Sub

发表评论  挑错  文章投稿  联系我
  • 上一篇:通过CuteFTP查看远程ftp服务器的隐藏文件(如.htaccess)
  • 下一篇:DedeCms附件目录统一修改为年月方法
  • 【推荐文章】

  • 我们为什么活着

    2008年华尔街金融风暴袭来,美国一家电器制造公司倒闭,公司总裁卡来尔来到多伦斯湖准...

  • Windows XP查看本机IP地址、MAC地址、网关、D

    点击【开始】,然后点击【运行】,在输入栏输入cmd三个字母,在打开的窗口中输入ipcon...

  • 机遇只偏爱有准备的头脑

    山重水复疑无路,柳暗花明又一村。 众里寻他千百度,蓦然回首,那人却在,灯火阑珊处...

  • 用万用表测定接地电阻

    接地装置安装好之后,严格讲,经过测试,接地电阻小于4欧,方可使用。投入使用后,应...

  • 中国近代科学为什么落后了?

    中国古代有着灿烂的文明,是世界四大文明古国之一,在16世纪以前长达1千多年的时期内...

  • 贾平凹《月迹》赏析、原文

    【赏析】 《月迹》一文按照盼月亮寻月亮议月亮的顺序展开,阅读时不可忽略文题月迹这...

  • 【最新文章】

  • vb获取mac地址模块
  • 重拾阅读精神
  • "烫手"的电子废弃物
  • 假如你想做一株腊梅
  • 关闭adobe flash player的自动上传功能
  • 草是风的一面旗帜
  • 当语言消亡时
  • 筏子
  • 槐抱柳
  • 石头里有一只会飞的鹰
  • 谨忆周树人君
  • 写日记方法指导
  • 读后感
  • 另一种珍爱
  • 文盲母亲