每一台电脑是不是有一个机器码？如何得到？

Question

每一台电脑是不是有一个机器码？如何得到？

Answer 1

每个软件不一样，可以取硬盘、CPU、主板的物理序列号。

Answer 2

用 FSO 可以得到 逻辑序列号

Answer 3

获得CPU信息'引用Microsoft WMI Scripting 1.1 Library
'在窗体上建一个Text，命名为Text1，并且
'Text1.MultiLine = True
Private Sub GetProcessorID()
  Dim a As SWbemServices
  Dim b As SWbemObjectSet
  Dim c As SWbemObject
  Dim d As SWbemPropertySet
  Dim e As SWbemProperty
   
  Set a = GetObject("winmgmts:")
  Set b = a.InstancesOf("Win32_Processor")
  For Each c In b
     With c
       If .Properties_.Count > 0 Then
         Set d = .Properties_
         
         For Each e In d
            Text1 = Text1 & e.Name & ":  " & e.Value & vbCrLf
         Next
       End If
     End With
  Next
End SubPrivate Sub Command1_Click()
Call GetProcessorID
End Sub------------------------------------------------------
获得硬盘信息,搜索disk32.dll，下载相应例子

Answer 4

取CPU 的方案不大好，因为只有在奔腾级别的CPU上才会读取到唯一的ID，但不能保护每个客户的电脑是奔腾级别的，所以还是取硬盘厂商固定的序列号，而不是硬盘的逻辑序列号比较好。’------------------------源代码开始--------------------------------
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Type IDERegs
      bFeaturesReg     As Byte
      bSectorCountReg  As Byte
      bSectorNumberReg As Byte
      bCylLowReg       As Byte
      bCylHighReg      As Byte
      bDriveHeadReg    As Byte
      bCommandReg      As Byte
      bReserved        As Byte
End TypeType InParams
      cBufferSize  As Long
      irDriveRegs  As IDERegs
      bDriveNumber As Byte
      bReserved(0 To 19)   As Byte
End Type
Dim inbuff As InParams
Dim outbuff(0 To 528) As ByteDim SerialNumber As String
Function ChangeByteOrder(s As Variant, nLen As Long)
Dim i As Long
Dim pi As Long
pi = 0
For i = 0 To nLen / 2 - 1
    c = s(pi)
    s(pi) = s(pi + 1)
    s(pi + 1) = c
    pi = pi + 2
NextEnd FunctionDim SerialNumber As StringSub Main()
Dim nBytes As Long
Dim nRet As Long
Dim hVxD As LongDim BSerialNumber(0 To 19) As Byteinbuff.cBufferSize = 512
inbuff.bDriveNumber = 0
inbuff.irDriveRegs.bSectorCountReg = 1
inbuff.irDriveRegs.bSectorNumberReg = 1
inbuff.irDriveRegs.bCylHighReg = 0
inbuff.irDriveRegs.bCylLowReg = 0
inbuff.irDriveRegs.bDriveHeadReg = &HA0
inbuff.irDriveRegs.bCommandReg = &HEC
hVxD = CreateFile("\\.\smartvsd", 0, 0, 0, 1, 0, 0)
nRet = DeviceIoControl(hVxD, &H7C088, inbuff, Len(inbuff) - 1, outbuff(0), 528, nBytes, 0)
If nRet > 0 Then
    CopyMemory BSerialNumber(0), outbuff(36), 20
    SerialNumber = StrConv(BSerialNumber, vbUnicode)
    SerialNumber = Trim(SerialNumber)
End If
Call CloseHandle(hVxD)MsgBox SerialNumber
End Sub'----------代码结束---------------------------------

Answer 5

小新:
    显示的是空的,代码如下:
_____________________
Option ExplicitPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Type IDERegs
      bFeaturesReg     As Byte
      bSectorCountReg  As Byte
      bSectorNumberReg As Byte
      bCylLowReg       As Byte
      bCylHighReg      As Byte
      bDriveHeadReg    As Byte
      bCommandReg      As Byte
      bReserved        As Byte
End TypePrivate Type InParams
      cBufferSize  As Long
      irDriveRegs  As IDERegs
      bDriveNumber As Byte
      bReserved(0 To 19)   As Byte
End TypeDim inbuff As InParams
Dim outbuff(0 To 528) As Byte
Dim SerialNumber As StringPrivate Function ChangeByteOrder(s As Variant, nLen As Long)
    Dim i As Long
    Dim pi As Long
    pi = 0
    For i = 0 To nLen / 2 - 1
        c = s(pi)
        s(pi) = s(pi + 1)
        s(pi + 1) = c
        pi = pi + 2
    Next
End FunctionPrivate Sub Main()
    Dim nBytes As Long
    Dim nRet As Long
    Dim hVxD As Long
    
    Dim BSerialNumber(0 To 19) As Byte
    
    inbuff.cBufferSize = 512
    inbuff.bDriveNumber = 0
    inbuff.irDriveRegs.bSectorCountReg = 1
    inbuff.irDriveRegs.bSectorNumberReg = 1
    inbuff.irDriveRegs.bCylHighReg = 0
    inbuff.irDriveRegs.bCylLowReg = 0
    inbuff.irDriveRegs.bDriveHeadReg = &HA0
    inbuff.irDriveRegs.bCommandReg = &HEC
    hVxD = CreateFile("\\.\smartvsd", 0, 0, 0, 1, 0, 0)
    nRet = DeviceIoControl(hVxD, &H7C088, inbuff, Len(inbuff) - 1, outbuff(0), 528, nBytes, 0)
    If nRet > 0 Then
        CopyMemory BSerialNumber(0), outbuff(36), 20
        SerialNumber = StrConv(BSerialNumber, vbUnicode)
        SerialNumber = Trim(SerialNumber)
    End If
    Call CloseHandle(hVxD)
    
    Debug.Print SerialNumber
End SubPrivate Sub Command1_Click()
    Call Main
End Sub

Answer 6

Chengs_bbs(盛实) ：
显示的也是空的，为什么？

Answer 7

转：
去Mac地址；
试试这个：Option ExplicitPrivate Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32Private Type NCB
    ncb_command As Byte                                    'Integer
    ncb_retcode As Byte                                    'Integer
    ncb_lsn As Byte                                        'Integer
    ncb_num As Byte                                        ' Integer
    ncb_buffer As Long                                     'String
    ncb_length As Integer
    ncb_callname As String * NCBNAMSZ
    ncb_name As String * NCBNAMSZ
    ncb_rto As Byte                                        'Integer
    ncb_sto As Byte                                        ' Integer
    ncb_post As Long
    ncb_lana_num As Byte                                   'Integer
    ncb_cmd_cplt As Byte                                   'Integer
    ncb_reserve(9) As Byte                                 ' Reserved, must be 0
    ncb_event As Long
End TypePrivate Type ADAPTER_STATUS
    adapter_address(5) As Byte                             'As String * 6
    rev_major As Byte                                      'Integer
    reserved0 As Byte                                      'Integer
    adapter_type As Byte                                   'Integer
    rev_minor As Byte                                      'Integer
    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 TypePrivate Type NAME_BUFFER
    name  As String * NCBNAMSZ
    name_num As Integer
    name_flags As Integer
End TypePrivate Type ASTAT
    adapt As ADAPTER_STATUS
    NameBuff(30) As NAME_BUFFER
End TypePrivate 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 LongFunction GetMACAddress(sIP As String) As String
    Dim sRtn As String
    Dim myNcb As NCB
    Dim bRet As Byte
    Dim aIP() As String
    Dim X As Long
    Dim nIP As String
    Dim ProcessHeap As Long    ProcessHeap = GetProcessHeap
    If InStr(sIP, ".") = 0 Then
        GetMACAddress = ""
        Exit Function
    End If    aIP = Split(sIP, ".", -1, vbTextCompare)
    If UBound(aIP()) <> 3 Then
        GetMACAddress = ""
        Exit Function
    End If    For X = 0 To UBound(aIP())
        If Len(aIP(X)) > 3 Then
            GetMACAddress = ""
            Exit Function
        End If        If IsNumeric(aIP(X)) = False Then
            GetMACAddress = ""
            Exit Function
        End If        If InStr(aIP(X), ",") <> 0 Then
            GetMACAddress = ""
            Exit Function
        End If        If CLng(aIP(X)) > 255 Then
            GetMACAddress = ""
            Exit Function
        End If        If nIP = "" Then
            nIP = String(3 - Len(aIP(X)), "0") & aIP(X)
        Else
            nIP = nIP & "." & String(3 - Len(aIP(X)), "0") & aIP(X)
        End If
    Next    sRtn = ""
    myNcb.ncb_command = NCBRESET
    bRet = Netbios(myNcb)
    myNcb.ncb_command = NCBASTAT
    myNcb.ncb_lana_num = 0
    myNcb.ncb_callname = nIP & Chr(0)    Dim myASTAT As ASTAT, tempASTAT As ASTAT
    Dim pASTAT As Long    myNcb.ncb_length = Len(myASTAT)
    pASTAT = HeapAlloc(ProcessHeap, HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
    If pASTAT = 0 Then
        GetMACAddress = ""                                 'memory allcoation failed!
        Exit Function
    End If
    
    myNcb.ncb_buffer = pASTAT
    bRet = Netbios(myNcb)
    If bRet <> 0 Then
        GetMACAddress = ""                                 '"Can not get the MAC Address from IP Address: " & sIP
        Exit Function
    End If
    
    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)    Dim sTemp As String
    Dim i As Long    For i = 0 To 5
        sTemp = Hex(myASTAT.adapt.adapter_address(i))
        If i = 0 Then
            sRtn = IIf(Len(sTemp) < 2, "0" & sTemp, sTemp)
        Else
            sRtn = sRtn & Space(1) & IIf(Len(sTemp) < 2, "0" & sTemp, sTemp)
        End If
    Next
    HeapFree ProcessHeap, 0, pASTAT
    GetMACAddress = sRtn
End Function

Answer 8

http://blog.csdn.net/hot1kang1/archive/2006/03/27/639713.aspx
http://blog.csdn.net/hot1kang1/archive/2006/03/27/639735.aspx