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

wang_qiang 发表于 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

wang_qiang 发表于 2008-11-13 20:57:00

自己顶一下。领导让我将作好的程序加密后再使用，以控制软件的使用范围。我查了一下资料，觉得用计算机硬件的一些特征码比较好一点，比如MAC地址或CPU序列号，但不知在XP下用VB6怎样实现，望在这方面有研究的前辈指教。

sym123321 发表于 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 SubPrivate 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应该看得懂吧,要一个窗口，一个文本框和一个按钮就可调试了。

xxxtttxxx 发表于 2008-11-16 22:56:00

直接搞硬盘序列号，省事省力，API就可以，方便多了

wang_qiang 发表于 2008-11-17 20:27:00

多谢各位的大力相助

页: [1]

明经CAD社区's Archiver

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