[VB6]网卡物理地址修改器

原理很简单。。。禁用指定网卡。。。。修改注册表。。。。启用网卡。。。OK。。。。

Windows XP/Vista/7测试通过

上图：

上代码：

Option Explicit '**************************************************** '网络适配器 MAC 地址修改器 '日期：2010.08.28 '作者：TZWSOHO '欢迎访问我的博客： 'http://blog.csdn.net/blog '**************************************************** Private Const INVALID_HANDLE_VALUE As Long = -1& Private Const NO_ERROR As Long = 0 Private Const ERROR_SUCCESS As Long = 0& Private Const ERROR_MORE_DATA As Long = 234 Private Const ERROR_FILE_NOT_FOUND As Long = 2& Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122 Private Const ANY_SIZE As Long = 1 Private Const MAX_PATH As Long = 260 Private Const MAX_GUIDLEN As Long = 80 Private Const DIGCF_PRESENT As Long = &H2 Private Const DIGCF_ALLCLASSES As Long = &H4 Private Const DIGCF_DEVICEINTERFACE As Long = &H10 Private Const SPDRP_DEVICEDESC As Long = &H0 Private Const SPDRP_DRIVER As Long = (&H9) Private Const SPDRP_CLASS As Long = (&H7) Private Const LMEM_FIXED As Long = &H0 Private Const LMEM_ZEROINIT As Long = &H40 Private Const LPTR As Long = (LMEM_FIXED + LMEM_ZEROINIT) Private Const DICS_ENABLE As Long = &H1 Private Const DICS_DISABLE As Long = &H2 Private Const DICS_FLAG_CONFIGSPECIFIC As Long = &H2 Private Const DIF_PROPERTYCHANGE As Long = &H12 Private Const HKEY_LOCAL_MACHINE As Long = &H80000002 Private Const REG_SZ As Long = 1 Private Const REG_OPTION_NON_VOLATILE As Long = 0 Private Const KEY_SET_VALUE As Long = &H2 Private Const KEY_CREATE_SUB_KEY As Long = &H4 Private Const REG_CREATED_NEW_KEY As Long = &H1 Private Const MAXLEN_PHYSADDR As Long = 8 Private Const MAXLEN_IFDESCR As Long = 256 Private Const MAX_INTERFACE_NAME_LEN As Long = 256 Private Const MIB_IF_ADMIN_STATUS_UP As Long = 1 Private Const MIB_IF_ADMIN_STATUS_DOWN As Long = 2 Private Type MIB_IFROW wszName(MAX_INTERFACE_NAME_LEN - 1) As Integer dwIndex As Long dwType As Long dwMtu As Long dwSpeed As Long dwPhysAddrLen As Long bPhysAddr(MAXLEN_PHYSADDR - 1) As Byte dwAdminStatus As Long dwOperStatus As Long dwLastChange As Long dwInOctets As Long dwInUcastPkts As Long dwInNUcastPkts As Long dwInDiscards As Long dwInErrors As Long dwInUnknownProtos As Long dwOutOctets As Long dwOutUcastPkts As Long dwOutNUcastPkts As Long dwOutDiscards As Long dwOutErrors As Long dwOutQLen As Long dwDescrLen As Long bDescr(MAXLEN_IFDESCR - 1) As Byte End Type Private Type MIB_IFTABLE dwNumEntries As Long table(ANY_SIZE - 1) As MIB_IFROW End Type Private Type Guid Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type SP_DEVINFO_DATA cbSize As Long ClassDriver As Guid DevInst As Long Reserved As Long End Type Private Type SP_DEVICE_INTERFACE_DATA cbSizeas As Long InterfaceClassDriver As Guid Flags As Long Reserved As Long End Type Private Type SP_CLASSINSTALL_HEADER cbSize As Long InstallFunction As Long End Type Private Type SP_PROPCHANGE_PARAMS ClassInstallHeader As SP_CLASSINSTALL_HEADER StateChange As Long Scope As Long HwProfile As Long End Type Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any,ByRef Source As Any,ByVal Length As Long) Private Declare Function GetVersion Lib "kernel32.dll" () As Long Private Declare Function GetLastError Lib "kernel32.dll" () As Long Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long Private Declare Function StringFromGUID2 Lib "ole32.dll" (ByRef rguid As Guid,ByVal lpsz As String,ByVal cchMax As Long) As Long Private Declare Function SetIfEntry Lib "IPHLPAPI.dll" (ByRef pIfRow As MIB_IFROW) As Long Private Declare Function GetIfTable Lib "IPHLPAPI.dll" (ByRef pIfTable As Any,ByRef pdwSize As Long,ByVal border As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long,ByVal lpSubKey As String,ByRef phkResult As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long,ByVal lpValueName As String,ByVal Reserved As Long,ByVal dwType As Long,ByRef lpData As Any,ByVal cbData As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long,ByVal lpReserved As Long,ByRef lpType As Long,ByRef lpcbData As Long) As Long Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long Private Declare Function SetupDiChangeState Lib "setupapi.dll" (ByVal DeviceInfoSet As Long,ByRef DeviceInfoData As SP_DEVINFO_DATA) As Long Private Declare Function SetupDiEnumDeviceInfo Lib "setupapi.dll" (ByVal DeviceInfoSet As Long,ByVal MemberIndex As Long,ByRef DeviceInfoData As SP_DEVINFO_DATA) As Long Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByRef ClassDriver As Any,ByRef Enumerator As Any,ByVal hwndParent As Long,ByVal Flags As Long) As Long Private Declare Function SetupDiSetClassInstallParams Lib "setupapi.dll" Alias "SetupDiSetClassInstallParamsA" (ByVal DeviceInfoSet As Long,ByRef DeviceInfoData As SP_DEVINFO_DATA,ByRef ClassInstallParams As Any,ByVal ClassInstallParamsSize As Long) As Long Private Declare Function SetupDiGetDeviceInstanceId Lib "setupapi.dll" Alias "SetupDiGetDeviceInstanceIdA" (ByVal DeviceInfoSet As Long,ByVal DeviceInstanceId As String,ByVal DeviceInstanceIdSize As Long,ByRef RequiredSize As Long) As Long Private Declare Function SetupDiGetDeviceRegistryProperty Lib "setupapi.dll" Alias "SetupDiGetDeviceRegistryPropertyA" (ByVal DeviceInfoSet As Long,ByVal Property As Long,ByRef PropertyRegDataType As Long,ByRef PropertyBuffer As Any,ByVal PropertyBufferSize As Long,ByRef RequiredSize As Long) As Long Private bIsVista As Boolean,sPhyAddrLst() As String,sRegPath() As String,sNetCfg() As String Private Sub cmdChange_Click() On Error GoTo er If lstAdapter.ListIndex < 0 Then Exit Sub Dim dwDisposition As Long Dim hkKey As Long,dwRst As Long Dim RegType As Long,RegSize As Long Dim hDevInfo As Long,DeviceInfoData As SP_DEVINFO_DATA Dim sEnumerator As String,sNet As String,sTmp As String '获取要修改的网卡地址 For dwRst = txtMAC.LBound To txtMAC.ubound sNet = sNet & txtMAC(dwRst).Text Next '修改网卡地址注册表项： 'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Class/{4D36E972-E325-11CE-BFC1-08002BE10318}/数字标识 If RegOpenKey(HKEY_LOCAL_MACHINE,sRegPath(lstAdapter.ListIndex),hkKey) = ERROR_SUCCESS Then If (RegSetValueEx(hkKey,"NetworkAddress",REG_SZ,ByVal sNet,Len(sNet)) <> ERROR_SUCCESS) Or _ (RegFlushKey(hkKey) <> ERROR_SUCCESS) Then MsgBox "修改网卡地址失败！",vbCritical,"修改失败" GoTo er End If End If sEnumerator = Split(lstAdapter.Text," ")(1) '获取网卡物理接口类型：PCI/USB hDevInfo = SetupDiGetClassDevs(ByVal 0&,ByVal sEnumerator,DIGCF_PRESENT Or DIGCF_ALLCLASSES) If hDevInfo <> INVALID_HANDLE_VALUE Then DeviceInfoData.cbSize = Len(DeviceInfoData) If SetupDiEnumDeviceInfo(hDevInfo,lstAdapter.ItemData(lstAdapter.ListIndex),DeviceInfoData) Then Dim PCP As SP_PROPCHANGE_PARAMS PCP.ClassInstallHeader.cbSize = Len(PCP.ClassInstallHeader) PCP.ClassInstallHeader.InstallFunction = DIF_PROPERTYCHANGE PCP.Scope = DICS_FLAG_CONFIGSPECIFIC PCP.StateChange = DICS_DISABLE '禁用网卡 PCP.HwProfile = 0 Call SetupDiSetClassInstallParams(hDevInfo,DeviceInfoData,PCP,Len(PCP)) Call SetupDiChangeState(hDevInfo,DeviceInfoData) PCP.StateChange = DICS_ENABLE '重新启用网卡 Call SetupDiSetClassInstallParams(hDevInfo,DeviceInfoData) End If End If MsgBox "网卡地址修改成功！",vbInformation,"修改成功" '刷新列表框内的网卡地址 sTmp = "[" For dwRst = 0 To 5 sTmp = sTmp & Mid$(sNet,dwRst * 2 + 1,2) & ":" Next sTmp = Left$(sTmp,Len(sTmp) - 1) & "] " lstAdapter.List(lstAdapter.ListIndex) = sTmp & Split(lstAdapter.Text," ",2)(1) er: Call SetupDiDestroyDeviceInfoList(hDevInfo) Call RegCloseKey(hkKey) End Sub Private Sub cmdRnd_Click() Dim arrMAC(3) As Byte,i As Long If bIsVista Then 'Windows 7 以上系统的 MAC 地址要求最高字节的低 4 位只能是：2、4、6、A、E '参考：http://aswordok.blog.163.com/blog/static/321636642009428101632513/ arrMAC(0) = &H2: arrMAC(1) = &H6 arrMAC(2) = &HA: arrMAC(3) = &HE Randomize Timer vsMAC(0).Value = -CInt("&H" & Hex$(Rnd * 15) & Hex$(arrMAC(CInt(Rnd * 3)))) Else Randomize Timer: vsMAC(0).Value = -CInt(Rnd * 255) End If For i = 1 To 5 Randomize Timer vsMAC(i).Value = -CInt(Rnd * 255) Next End Sub Private Sub Form_Load() If App.PrevInstance Then End 'Windows 7 版本号为 6.1 '具体参照 MSDN：http://msdn.microsoft.com/en-us/library/ms724832(v=VS.85).aspx bIsVista = ((((GetVersion And &HFFFF&) And &HFF&) > 5) And (((GetVersion And &HFFFF&) And &HFF00&) > 0)) If bIsVista Then vsMAC(0).SmallChange = 4: vsMAC(0).LargeChange = 4 Call EnumPhyAddr '获取网卡物理地址 Call ListAdapters("USB"): Call ListAdapters("PCI") '枚举 PCI/USB 两种物理接口的网卡 If lstAdapter.ListCount Then ReDim sPhyAddr(lstAdapter.ListCount - 1) '窗体置屏幕中央 Move (Screen.Width - Width) / 2,(Screen.Height - Height) / 2 End Sub Private Sub lstAdapter_Click() On Error GoTo er Dim i As Long Dim sTmp As String,sPhy() As String lstAdapter.ToolTipText = lstAdapter.Text '列表框文本格式：网卡物理地址 网卡物理接口类型 网卡名称描述 sTmp = Split(lstAdapter.Text,2)(0) sPhy = Split(Mid$(sTmp,2,Len(sTmp) - 2),":") For i = 0 To 5 vsMAC(i).Value = -CInt("&H" & sPhy(i)) Next er: End Sub Private Sub vsMAC_Change(Index As Integer) If Index = 0 Then If bIsVista Then If vsMAC(0).Value > -2 Then vsMAC(0).Value = -2 If vsMAC(0).Value < -&HFE Then vsMAC(0).Value = -&HFE txtMAC(0).Text = Right$("0" & Hex$(-vsMAC(0).Value),2) Exit Sub End If End If txtMAC(Index).Text = Right$("0" & Hex$(-vsMAC(Index).Value),2) End Sub Private Sub ListAdapters(ByVal sEnumerator As String) Dim hkKey As Long Dim hDevInfo As Long,DataT As Long Dim DeviceInfoData As SP_DEVINFO_DATA Dim i As Long,j As Long,BufferSize As Long,RegCount As Long,RegType As Long Dim sDriver As String,sClass As String,sDevice As String,sInstanceID As String,sNetCfgIID As String hDevInfo = SetupDiGetClassDevs(ByVal 0&,DIGCF_PRESENT Or DIGCF_ALLCLASSES) If hDevInfo <> INVALID_HANDLE_VALUE Then DeviceInfoData.cbSize = Len(DeviceInfoData) While SetupDiEnumDeviceInfo(hDevInfo,i,DeviceInfoData) 'Class 名为 Net 则为网络适配器 BufferSize = 0 Do While SetupDiGetDeviceRegistryProperty(hDevInfo,SPDRP_CLASS,DataT,ByVal sClass,BufferSize,BufferSize) = 0 sClass = String$(BufferSize,vbNullChar) Loop '获取网络适配器的注册表相关信息路径 BufferSize = 128: sDriver = String$(BufferSize,vbNullChar) Do While SetupDiGetDeviceRegistryProperty(hDevInfo,SPDRP_DRIVER,ByVal sDriver,BufferSize) = 0 If GetLastError = ERROR_INSUFFICIENT_BUFFER Then sDriver = String$(BufferSize * 2,vbNullChar) Else Exit Do End If Loop '获取网络适配器名称描述 BufferSize = 0: sDevice = vbNullString Do While SetupDiGetDeviceRegistryProperty(hDevInfo,SPDRP_DEVICEDESC,ByVal sDevice,BufferSize) = 0 sDevice = String$(BufferSize,vbNullChar) Loop '获取网络适配器识别码，用于匹配网卡的物理地址 BufferSize = 128: sInstanceID = String$(BufferSize,vbNullChar) Do While SetupDiGetDeviceInstanceId(hDevInfo,sInstanceID,Len(sInstanceID),BufferSize) = 0 If GetLastError = ERROR_INSUFFICIENT_BUFFER Then sInstanceID = String$(BufferSize * 2,vbNullChar) Else Exit Do End If Loop If InStr(1,sClass,"Net",vbTextCompare) Then '用 NetCfgInstanceId 匹配网卡物理地址索引 ReDim Preserve sRegPath(RegCount): RegCount = RegCount + 1 sRegPath(RegCount - 1) = "SYSTEM/CurrentControlSet/Control/Class/" & Left$(sDriver,InStr(1,sDriver,vbNullChar) - 1) If RegOpenKey(HKEY_LOCAL_MACHINE,sRegPath(RegCount - 1),hkKey) = ERROR_SUCCESS Then sNetCfgIID = String$(80,vbNullChar): BufferSize = 80 If RegQueryValueEx(hkKey,"NetCfgInstanceId",RegType,ByVal sNetCfgIID,BufferSize) = ERROR_SUCCESS Then sNetCfgIID = Left$(sNetCfgIID,sNetCfgIID,vbNullChar) - 1) For j = 0 To UBound(sNetCfg) If InStr(1,sNetCfg(j),vbTextCompare) Then Exit For End If Next End If End If Call RegCloseKey(hkKey) sClass = sClass & vbNullChar: sDriver = sDriver & vbNullChar: sDevice = sDevice & vbNullChar If j < UBound(sNetCfg) + 1 Then lstAdapter.AddItem sPhyAddrLst(j) & " " & sEnumerator & " " & _ Left$(sDevice,sDevice,vbNullChar) - 1) Else lstAdapter.AddItem "[未知] " & sEnumerator & " " & _ Left$(sDevice,vbNullChar) - 1) End If lstAdapter.ItemData(lstAdapter.NewIndex) = i End If i = i + 1 Wend Call SetupDiDestroyDeviceInfoList(hDevInfo) lstAdapter.ToolTipText = "共发现 " & lstAdapter.ListCount & " 个网络适配器！" End If End Sub Private Sub EnumPhyAddr() Dim i As Long,j As Long Dim sDeviceName As String,sPhyAddr As String Dim IfRows() As MIB_IFROW,arrIfTable() As Byte Dim lIfSize As Long,lIfRow As Long,PhyCount As Long,NetCfgCount As Long '获取数据结构大小 ReDim arrIfTable(0): lIfSize = 1 Call GetIfTable(arrIfTable(0),lIfSize,False) ReDim Preserve arrIfTable(lIfSize - 1) If GetIfTable(arrIfTable(0),False) = NO_ERROR Then CopyMemory lIfRow,arrIfTable(0),4 If lIfRow Then ReDim IfRows(lIfRow - 1) For i = 0 To lIfRow - 1 CopyMemory IfRows(i),arrIfTable(4 + i * Len(IfRows(0))),Len(IfRows(0)) '获取 NetCfgInstanceId，用于匹配网卡物理地址 sDeviceName = String$(MAX_INTERFACE_NAME_LEN * 2,vbNullChar) CopyMemory ByVal sDeviceName,IfRows(i).wszName(0),Len(sDeviceName) sDeviceName = StrConv(sDeviceName,vbFromUnicode) If IfRows(i).dwPhysAddrLen Then sPhyAddr = "" For j = 0 To IfRows(i).dwPhysAddrLen - 1 sPhyAddr = sPhyAddr & Right$("0" & Hex$(IfRows(i).bPhysAddr(j)),2) & ":" Next sPhyAddr = "[" & Left$(sPhyAddr,Len(sPhyAddr) - 1) & "]" Else sPhyAddr = "[未知]" End If ReDim Preserve sPhyAddrLst(PhyCount): sPhyAddrLst(PhyCount) = sPhyAddr: PhyCount = PhyCount + 1 ReDim Preserve sNetCfg(NetCfgCount): NetCfgCount = NetCfgCount + 1 sNetCfg(NetCfgCount - 1) = Left$(sDeviceName,sDeviceName,vbNullChar) - 1) Next End If End If End Sub

打包下载(下载后后缀名改为rar)：

http://hi.csdn.net/attachment/201009/12/0_12842507671K7l.gif

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!