189 8069 5689
'要使得引用System.Management有效，先通过菜单
公司主营业务：网站建设、成都网站建设、移动网站开发等业务。帮助企业客户真正实现互联网宣传，提高企业的竞争能力。成都创新互联是一支青春激扬、勤奋敬业、活力青春激扬、勤奋敬业、活力澎湃、和谐高效的团队。公司秉承以“开放、自由、严谨、自律”为核心的企业文化，感谢他们对我们的高要求，感谢他们从不同领域给我们带来的挑战，让我们激情的团队有机会用头脑与智慧不断的给客户带来惊喜。成都创新互联推出深泽免费做网站回馈大家。
'[项目]--[添加引用]，在“.Net”选项卡里，选择“System.Management”，单击[确定]
Imports System.Management
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim MySearcher As New ManagementObjectSearcher("SELECT * FROM Win32_NetworkAdapterConfiguration")
For Each MySearcherObj As ManagementObject In MySearcher.Get
If CBool(MySearcherObj("IPEnabled")) Then
MsgBox(MySearcherObj("IPAddress")(0))
End If
Next
End Sub
End Class
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 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
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub GetName()
Dim sJM As String
Dim sMC As String
Dim sIP As String
Dim s As String
s = String(128, Chr(0))
GetComputerName s, Len(s)
s = UCase(Left(s, InStr(1, s, Chr(0)) - 1))
sJM = s'计算机名称
s = String(128, Chr(0))
GetUserName s, Len(s)
s = UCase(Left(s, InStr(1, s, Chr(0)) - 1))
sMC = s‘当前用户名称
End Sub
'用这种方法在远程获得再发回本机就可以吧
'取计算机型号暂时不会