http://excelbbx.cn/BOOK.SWF
Sub 主板序列號()
Dim objs As Object, Obj As Object, WMI As Object, 主板序列號
Set WMI = GetObject('WinMgmts:')
Set objs = WMI.InstancesOf('Win32_BaseBoard')
For Each Obj In objs
MsgBox '您的主板序列號是：' + Obj.SerialNumber
Next
End Sub
Sub 顯卡信息()
On Error Resume Next
Dim tmp1, tmp2
Set tmp2 = GetObject('winmgmts:{impersonationLevel=impersonate}').InstancesOf('Win32_VideoController')
For Each tmp1 In tmp2
MsgBox '型 號: ' & tmp1.VideoProcessor & vbCrLf & '廠(chǎng) 商: ' & tmp1.AdapterCompatibility & vbCrLf & '名 稱(chēng): ' & tmp1.Name & vbCrLf & '狀 態(tài): ' & tmp1.Status & vbCrLf & '顯 存: ' & (tmp1.AdapterRAM \ 1024000) & 'MB' & vbCrLf & '驅 動(dòng)(dll): ' & tmp1.InstalledDisplayDrivers & vbCrLf & '驅 動(dòng)(inf): ' & tmp1.infFilename & vbCrLf & '版 本: ' & tmp1.DriverVersion
Next
End Sub
Sub 網(wǎng)卡MAC()
Dim 網(wǎng)卡
Set 網(wǎng)卡 = GetObject('Winmgmts:').InstancesOf('Win32_NetworkAdapterConfiguration')
For Each 地址 In 網(wǎng)卡
If 地址.IPEnabled = True Then
MsgBox '網(wǎng)卡MAC地址: ' & 地址.MacAddress
Exit For
End If
Next
End Sub
Sub 硬盤(pán)型號()
Dim 硬盤(pán)
Set 硬盤(pán) = GetObject('Winmgmts:').InstancesOf('Win32_DiskDrive')
For Each mo In 硬盤(pán)
MsgBox '硬盤(pán)型號為:' & mo.Model
Next
End Sub
Sub CPU序列號() '特別提示：這個(gè)不是唯一的，即有可能多個(gè)CPU同一一序列號
For Each 序列 In GetObject('Winmgmts:').InstancesOf('Win32_Processor')
MsgBox 'CPU 序列號: ' & CStr(序列.ProcessorId)
Next
End Sub
Sub 所有進(jìn)程()
Set objs = GetObject('WinMgmts:').InstancesOf('Win32_Process')
For Each obj In objs
tmp = tmp & WorksheetFunction.Text(a + 1, '[DBNum2][$-804]0: ') + vbTab + obj.Description + Chr(13)
a = a + 1
Next
MsgBox tmp, 65, '提示你哦'
End Sub
Sub IP地址()
ComputerName = 'localhost'
Set OpSysSet = GetObject('winmgmts:{impersonationLevel=impersonate}//' & ComputerName).ExecQuery('SELECT index, IPAddress FROM Win32_NetworkAdapterConfiguration')
For Each OpSys In OpSysSet
If TypeName(OpSys.IPAddress) <> 'Null' Then
For Each IP In OpSys.IPAddress
MsgBox IP, 64, 'IP地址'
Next
End If
Next
End Sub
獲取用戶(hù)名
MsgBox 'Excel用戶(hù)名：' + Application.UserName + Chr(10) + 'WINDOWS用戶(hù)名：' + Environ('username')
為了取得卷標寫(xiě)309行代碼，確非常人能有的耐心
不過(guò)可能對API有先入為主的思想，沒(méi)想過(guò)DOS代碼可以一句完成309句的功能。
1.你這個(gè)方法僅僅用查看盤(pán)符的卷標。而卷標是可以修改的，用它做為軟件的序列號認證依據是不可靠的
2.這段超長(cháng)的代碼，其實(shí)可以用一句代碼完成的。效率差了點(diǎn)。
MsgBox CreateObject('WScript.Shell').Exec('cmd.exe /c ' & '''VOL c:''').StdOut.ReadAll, , 'C盤(pán)卷標'
軟件的也放在這吧，自己收集一下
取得文件屬性
Sub FileInfo()
Dim fso, f1
Dim strTmp As String
Set fso = CreateObject('Scripting.FileSystemObject')
Set f1 = fso.GetFile('C:\CIMG1689.jpg')
strTmp = strTmp & f1.Name & '的詳細資料：' & vbCrLf
strTmp = strTmp & vbTab & '路徑:' & f1.Path & vbCrLf
strTmp = strTmp & vbTab & '類(lèi)型:' & f1.Type & vbCrLf
strTmp = strTmp & vbTab & '屬性:' & GetFileAttr(f1) & vbCrLf
strTmp = strTmp & vbTab & '創(chuàng )建時(shí)間:' & f1.DateCreated & vbCrLf
strTmp = strTmp & vbTab & '最后訪(fǎng)問(wèn)時(shí)間:' & f1.DateLastAccessed & vbCrLf
strTmp = strTmp & vbTab & '最后修改時(shí)間:' & f1.DateLastModified & vbCrLf
strTmp = strTmp & vbTab & '文件大小(Bytes):' & f1.Size & vbCrLf
MsgBox strTmp
End Sub
GetAttr 函數
返回一個(gè) Integer，此為一個(gè)文件、目錄、或文件夾的屬性。
語(yǔ)法
GetAttr(pathname)
必要的 pathname 參數是用來(lái)指定一個(gè)文件名的字符串表達式。pathname 可以包含目錄或文件夾、以及驅動(dòng)器。
返回值
由 GetAttr 返回的值，是下面這些屬性值的總和：
常數 值 描述
vbNormal 0 常規
vbReadOnly 1 只讀
vbHidden 2 隱藏
vbSystem 4 系統文件 在 Macintosh 中不可用。
vbDirectory 16 目錄或文件夾
vbArchive 32 上次備份以后 在 Macintosh 中不可用.，文件已經(jīng)改變
vbalias 64 指定的文件名是別名。 只在 Macintosh中可用。
注意 這些常數是由 VBA 指定的，在程序代碼中的任何位置，可以使用這些常數來(lái)替換真正的值。
說(shuō)明
若要判斷是否設置了某個(gè)屬性，在 GetAttr 函數與想要得知的屬性值之間使用 And 運算符與逐位比較。如果所得的結果不為零，則表示設置了這個(gè)屬性值。例如，在下面的 And 表達式中，如果檔案 (Archive) 屬性沒(méi)有設置，則返回值為零：
Result = GetAttr(FName) And vbArchive
如果文件的檔案屬性已設置，則返回非零的數值。
運行系統提示GetFileAttr 子程序或函數 未定義
改為GetAttr就可以了
Sub 硬盤(pán)型號()
Dim 硬盤(pán)
Set 硬盤(pán) = GetObject('Winmgmts:').InstancesOf('Win32_DiskDrive')
For Each mo In 硬盤(pán)
MsgBox '硬盤(pán)型號為:' & mo.Model
Next
End Sub
這段代碼是整個(gè)硬盤(pán)的編號，與C盤(pán)無(wú)關(guān)
Sub 硬盤(pán)型號()
Dim 硬盤(pán)
Dim STR As String
Set 硬盤(pán) = GetObject('Winmgmts:').InstancesOf('Win32_DiskDrive')
For Each mo In 硬盤(pán)
If Len('硬盤(pán)型號為:' & mo.Model) > 1 Then
STR = mo.Model
Exit For
End If
Next
If STR = '這里寫(xiě)你指定的硬盤(pán)型號' Then
'這里寫(xiě)你的代碼
Else
ThisWorkbook.Close 0
Application.Quit
End If
End Sub
