乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 76|回复: 4

在XP下用VB6怎样得到网卡的Mac地址

[复制链接]

10

主题

32

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
72
发表于 2008-10-31 19:43:00 | 显示全部楼层 |阅读模式
在XP下用VB6怎样得到网卡的Mac地址?现有一段代码,在Win98下好用,但在XP下不好用,不知是什么原因。希望高手指教:
Option Explicit
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32
Private Type NCB
  ncb_command As Byte 'Integer
  ncb_retcode As Byte 'Integer
  ncb_lsn As Byte 'Integer
  ncb_num As Byte ' Integer
  ncb_buffer As Long 'String
  ncb_length As Integer
  ncb_callname As String * NCBNAMSZ
  ncb_name As String * NCBNAMSZ
  ncb_rto As Byte 'Integer
  ncb_sto As Byte ' Integer
  ncb_post As Long
  ncb_lana_num As Byte 'Integer
  ncb_cmd_cplt As Byte 'Integer
  ncb_reserve(9) As Byte ' Reserved, must be 0
  ncb_event As Long
End Type
Private Type ADAPTER_STATUS
  adapter_address(5) As Byte 'As String * 6
  rev_major As Byte 'Integer
  reserved0 As Byte 'Integer
  adapter_type As Byte 'Integer
  rev_minor As Byte 'Integer
  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
把下面的代码放入Command1_Click的事件中:
Private Sub Command1_Click()
  Dim myNcb As NCB
  Dim bRet As Byte
  myNcb.ncb_command = NCBRESET
  bRet = Netbios(myNcb)
  myNcb.ncb_command = NCBASTAT
  myNcb.ncb_lana_num = 0
  myNcb.ncb_callname = "*       "
  Dim myASTAT As ASTAT, tempASTAT As ASTAT
  Dim pASTAT As Long
  myNcb.ncb_length = Len(myASTAT)
  Debug.Print Err.LastDllError
  pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _
    Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
  If pASTAT = 0 Then
    Debug.Print "memory allcoation failed!"
    Exit Sub
  End If
  myNcb.ncb_buffer = pASTAT
  bRet = Netbios(myNcb)
  Debug.Print Err.LastDllError
  CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
  MsgBox Hex(myASTAT.adapt.adapter_address(0)) & " " & _
    Hex(myASTAT.adapt.adapter_address(1)) _
    & " " & Hex(myASTAT.adapt.adapter_address(2)) & " " _
    & Hex(myASTAT.adapt.adapter_address(3)) _
    & " " & Hex(myASTAT.adapt.adapter_address(4)) & " " _
    & Hex(myASTAT.adapt.adapter_address(5))
  HeapFree GetProcessHeap(), 0, pASTAT
End Sub
回复

使用道具 举报

10

主题

32

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
72
发表于 2008-11-13 20:57:00 | 显示全部楼层
自己顶一下。
领导让我将作好的程序加密后再使用,以控制软件的使用范围。我查了一下资料,觉得用计算机硬件的一些特征码比较好一点,比如MAC地址或CPU序列号,但不知在XP下用VB6怎样实现,望在这方面有研究的前辈指教。
回复

使用道具 举报

3

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
19
发表于 2008-11-16 20:54:00 | 显示全部楼层
方法有好几种,不管哪种方法都要注意多网卡的情况。
1.用VB调用系统的ipconfig.exe /all > c:\ip.txt,得到的信息都在ip.txt文件中了,提取所有Physical Address 字段的最后xx-xx-xx-xx-xx-xx就可以了.
2.代码如下
Option Explicit
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
Private Type NetCard
    Name As String
    IPAdress As String
    IpSubNets As String
    IpGateWay As String
    DnsString0 As String
    DnsString1 As String
    MacAdress As String
End Type
Dim MtNetCard() As NetCard
Private Sub Command1_Click()
    Dim i As Long
    For i = LBound(MtNetCard) To UBound(MtNetCard) - 1
        Text1 = Text1 & "网卡:    " & MtNetCard(i).Name & vbNewLine
        Text1 = Text1 & "MAC:     " & MtNetCard(i).MacAdress & vbNewLine
    Next
    Erase MtNetCard
End Sub
Private Sub Form_Load()
    ReDim MtNetCard(0) As NetCard
    Set objSWbemServices = GetObject("winmgmts:")
    Set objSWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
    For Each objSWbemObject In objSWbemObjectSet
        On Error Resume Next
        MtNetCard(UBound(MtNetCard)).Name = objSWbemObject.Description   '添加本机上已经安装了TCP/IP协议的网卡
        MtNetCard(UBound(MtNetCard)).MacAdress = objSWbemObject.MacAddress(0)
        ReDim Preserve MtNetCard(UBound(MtNetCard) + 1) As NetCard
    Next
End Sub
应该看得懂吧,要一个窗口,一个文本框和一个按钮就可调试了。
回复

使用道具 举报

20

主题

105

帖子

6

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
185
发表于 2008-11-16 22:56:00 | 显示全部楼层
直接搞硬盘序列号,省事省力,API就可以,方便多了
回复

使用道具 举报

10

主题

32

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
72
发表于 2008-11-17 20:27:00 | 显示全部楼层
多谢各位的大力相助
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-3 17:35 , Processed in 1.512690 second(s), 62 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表