Public Function BiosInfo() As String
On Error GoTo ErrBiosInfo '错误时返回固定的机器码,Win98不支持WMI
Dim MyOBJ As Object, oBios As Object, cZfc As String, i As Long, cTmpZfc As String
Set MyOBJ = GetObject("WinMgmts:").InstancesOf("Win32_Bios")
cZfc = ""
i = 0
For Each oBios In MyOBJ
i = i + 1 '可能有多个Bios
If IsNull(oBios.Description) Then 'Caption or Name
cTmpZfc = ""
Else
cTmpZfc = Trim(CStr(oBios.Description))
End If
cZfc = cZfc + cTmpZfc
If IsNull(oBios.Manufacturer) Then
cTmpZfc = ""
Else
cTmpZfc = Trim(CStr(oBios.Manufacturer))
End If
cZfc = cZfc + cTmpZfc
If IsNull(oBios.SerialNumber) Then
cTmpZfc = ""
Else
cTmpZfc = Trim(CStr(oBios.SerialNumber))
End If
cZfc = cZfc + cTmpZfc
If IsNull(oBios.ReleaseDate) Then
cTmpZfc = ""
Else
cTmpZfc = Trim(CStr(oBios.ReleaseDate))
End If
cZfc = cZfc + cTmpZfc
Next
BiosInfo = cZfc + CStr(i)
Exit Function
ErrBiosInfo:
BiosInfo = "210660612"
End Function
Public Function GenMachSN() As String
On Error GoTo ErrGenMachSN
Dim cBios As String
cBios = BiosInfo()
Dim cString As String, nLen As Long, ii As Long, nSN As Long
cString = cBios
nLen = Len(cString)
nSN = 0
For ii = 1 To nLen
nSN = nSN + Asc(Mid(cString, ii, 1)) * 356421
Next
'cString = MD5(CStr(nSN)) '这里可以加上你的字符串变换方式
nLen = Len(cString)
Dim cZfc As String
cZfc = ""
For ii = 1 To nLen
cZfc = cZfc + Right(CStr(Asc(Mid(cString, ii, 1))), 1)
Next
If Len(cZfc) < 9 Then '固定9位机器码
GenMachSN = cZfc + Left("267415893", 9 - Len(cZfc))
Else
GenMachSN = Left(cZfc, 9)
End If
Exit Function
ErrGenMachSN:
GenMachSN = "168660612"
End Function
Sub TestFunction()
MsgBox BiosInfo()
MsgBox GenMachSN()
End Sub