VB获取网卡MAC地址源代码
让客户满意是我们工作的目标，不断超越客户的期望值来自于我们对这个行业的热爱。我们立志把好的技术通过有效、简单的方式提供给客户，将通过不懈努力成为客户在信息化领域值得信任、有价值的长期合作伙伴，公司提供的服务项目有：域名注册、虚拟主机、营销软件、网站建设、托克逊网站维护、网站推广。
具体代码：（其中GetMACAddress() 函数为楼主所需函数）
Option Explicit
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 get_disp_info()
Dim i As Integer
Dim info(50) As String
Dim name(50) As String
Dim j As Integer
name(0) = "Name"
name(1) = "Caption"
name(2) = "ColorPlanes"
name(3) = "Description"
name(4) = "RefreshRate"
name(5) = "SettingID"
name(6) = "VideoMode"
name(7) = "VerticalResolution"
name(8) = "SystemPaletteEntries"
name(9) = "ReservedSystemPaletteEntries"
name(10) = "BitsPerPixel"
name(11) = "DeviceEntriesInAColorTable"
name(12) = "DeviceSpecificPens"
name(13) = "HorizontalResolution"
Dim opt As New System.Management.ManagementObjectSearcher("Select * from Win32_DisplayControllerConfiguration")
For Each obj2 As System.Management.ManagementObject In opt.Get
For j = 0 To 13
Try
info(j) = obj2(name(j))
Catch ex As Exception
info(j) = ""
End Try
Next
For i = 0 To 14
Dim newitem1 As New ListViewItem(name(i))
newitem1.SubItems.Add(info(i))
List_disp.Items.Add(newitem1)
Next
Next
End Sub
主板驱动信息：
Private Sub get_bois_info()
Dim i As Integer
Dim info(50) As String
Dim name(50) As String
Dim j As Integer
name(0) = "Name"
name(1) = "Caption"
name(2) = "SerialNumber"
name(3) = "Manufacturer"
name(4) = "Description"
name(5) = "PrimaryBIOS"
name(6) = "Version"
name(7) = "Status"
name(8) = "BuildNumber"
name(9) = "CodeSet"
name(10) = "CurrentLanguage"
name(11) = "IdentificationCode"
name(12) = "InstallableLanguages"
name(13) = "InstallDate"
name(14) = "LanguageEdition"
name(15) = "OtherTargetOS"
name(16) = "ReleaseDate"
name(17) = "SMBIOSBIOSVersion"
name(18) = "SMBIOSMajorVersion"
name(19) = "SMBIOSMinorVersion"
name(20) = "SMBIOSPresent"
name(21) = "SoftwareElementID"
name(22) = "SoftwareElementState"
name(23) = "TargetOperatingSystem"
name(24) = "ListOfLanguages"
name(25) = "BIOSVersion"
name(26) = "BiosCharacteristics"
Dim k As Integer
Dim opt As New System.Management.ManagementObjectSearcher("Select * from Win32_BIOS")
For Each obj2 As System.Management.ManagementObject In opt.Get
For j = 0 To 23
Try
info(j) = obj2(name(j))
Catch ex As Exception
info(j) = ""
End Try
Next
Try
info(24) = ""
For k = 0 To obj2(name(24)).length - 1
info(24) += obj2(name(24))(k)
Next
Catch ex As Exception
info(24) = ""
End Try
Try
info(25) = ""
For k = 0 To obj2(name(25)).length - 1
info(25) += obj2(name(25))(k)
Next
Catch ex As Exception
info(25) = ""
End Try
Try
info(26) = ""
For k = 0 To obj2(name(26)).length - 1
info(26) += obj2(name(26))(k)
Next
Catch ex As Exception
info(26) = ""
End Try
For i = 0 To 27
Dim newitem1 As New ListViewItem(name(i))
newitem1.SubItems.Add(info(i))
List_bois.Items.Add(newitem1)
Next
Next
End Sub
Private Sub GetMyIP()
Dim strComputer As String
Dim objWMI As Object
Dim colIP As Object
Dim IP As Object
Dim I As Integer
strComputer = "."
objWMI = GetObject("winmgmts://" strComputer "/root/cimv2")
colIP = objWMI.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each IP In colIP
If Not IsNothing(IP.IPAddress) Then
For I = LBound(IP.IPAddress) To UBound(IP.IPAddress)
MsgBox("IP 地址:" IP.IPAddress(I) Chr(10) _
"网卡类型:" IP.Description(I) Chr(10) _
"网卡地址:" IP.Macaddress(I))
Next
End If
Next
End Sub
tmpstr=""
set fso=createObject("scripting.filesystemObject")
Set dc = fso.Drives
for each d in dc
If d.isReady Then
tmpstr=tmpstr "磁盘" d.DriveLetter ":" vbcrlf _
"可用空间：" (d.AvailableSpace/1024/1024/1024) " GB" vbcrlf _
"空余空间：" (d.FreeSpace/1024/1024/1024) " GB" vbcrlf _
"总空间大小：" (d.TotalSize/1024/1024/1024) " GB" vbcrlf _
"文件系统：" d.FileSystem vbcrlf _
"驱动器类型：" d.DriveType vbcrlf _
"是否就绪：" d.IsReady vbcrlf _
"路径：" d.Path vbcrlf _
"根目录：" d.RootFolder vbcrlf _
"序列号：" d.SerialNumber vbcrlf _
"共享名：" d.ShareName vbcrlf _
"卷名：" d.VolumeName vbcrlf vbcrlf
End If
Next
msgbox tmpstr
