Question Building Security system for Access Database (1 Viewer)

'arnelgp
Public Function GetSetHardDiskSerial()
    Dim prop As DAO.Property
    Dim dbs As DAO.Database
    On Error GoTo err_handler
    Dim strHarddisk As String
    Set dbs = CurrentDb
    'Set the property's value
    'If it doesn't exist, an error 3270 "Property not found" will occur
    strHarddisk = dbs.Containers("Databases")("UserDefined").Properties("HardDisk").Value
    If Err.Number = 0 Then
        If strHarddisk <> GetPhysicalSerial()(1) & "" Then
            MsgBox "You may have been a victim of counterfeit!" & vbCrLf & vbCrLf & _
            "This database is already used in another computer.", vbOKOnly + vbExclamation
            Application.Quit
        End If
    End If
    Set prop = Nothing
    Set dbs = Nothing
    Exit Function
    
err_handler:
    If Err = 3270 Then
        'If the property doesn't exist, create it
        Set prop = dbs.CreateProperty("HardDisk", dbText, GetPhysicalSerial()(1) & "")
        'Append it to the collection
        dbs.Containers("Databases")("UserDefined").Properties.Append prop
    End If
    Resume
End Function

'arnelgp
Function GetPhysicalSerial() As Variant

    Dim obj As Object
    Dim WMI As Object
    Dim SNList() As String, i As Long, count As Long
    
    Set WMI = GetObject("WinMgmts:")
    
    For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
        If obj.SerialNumber <> "" Then count = count + 1
    Next
    
    'ReDim SNList(1 To Count, 1 To 1)
    ReDim SNList(1 To count)
    
    i = 1
    For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")
        'SNList(i, 1) = obj.SerialNumber
        SNList(i) = Trim(obj.SerialNumber & "")
        Debug.Print Trim(obj.SerialNumber & "")
        i = i + 1
        If i > count Then Exit For
    Next
    
    GetPhysicalSerial = SNList
End Function

'arnelgp
Public Function GetSetCPU_ID()
    Dim prop As DAO.Property
    Dim dbs As DAO.Database
    On Error GoTo err_handler
    Dim strCPU_ID As String
    Set dbs = CurrentDb
    'Set the property's value
    'If it doesn't exist, an error 3270 "Property not found" will occur
    strCPU_ID = dbs.Containers("Databases")("UserDefined").Properties("CPU_ID").value
    If Err.Number = 0 Then
        If strCPU_ID <> CpuId() & SystemSerialNumber() & "" Then
            MsgBox "You may have been a victim of counterfeit!" & vbCrLf & vbCrLf & _
            "This database is already used in another computer.", vbOKOnly + vbExclamation
            Application.Quit
        End If
    End If
    Set prop = Nothing
    Set dbs = Nothing
    Exit Function
    
err_handler:
    If Err = 3270 Then
        'If the property doesn't exist, create it
        Set prop = dbs.CreateProperty("CPU_ID", dbText, CpuId() & SystemSerialNumber() & "")
        'Append it to the collection
        dbs.Containers("Databases")("UserDefined").Properties.Append prop
    End If
    Resume
End Function

'http://vb-helper.com/howto_get_cpu_serial_number_id.html
Public Function SystemSerialNumber() As String
Dim mother_boards As Variant
Dim board As Variant
Dim wmi As Variant
Dim serial_numbers As String

    ' Get the Windows Management Instrumentation object.
    Set wmi = GetObject("WinMgmts:")

    ' Get the "base boards" (mother boards).
    Set mother_boards = wmi.InstancesOf("Win32_BaseBoard")
    For Each board In mother_boards
        serial_numbers = serial_numbers & ", " & board.SerialNumber
    Next board
    If Len(serial_numbers) > 0 Then serial_numbers = Mid$(serial_numbers, 3)

    SystemSerialNumber = serial_numbers
End Function
'http://vb-helper.com/howto_get_cpu_serial_number_id.html
Public Function CpuId() As String
Dim computer As String
Dim wmi As Variant
Dim processors As Variant
Dim cpu As Variant
Dim cpu_ids As String

    computer = "."
    Set wmi = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & _
        computer & "\root\cimv2")
    Set processors = wmi.ExecQuery("Select * from Win32_Processor")

    For Each cpu In processors
        cpu_ids = cpu_ids & ", " & cpu.ProcessorId
    Next cpu
    If Len(cpu_ids) > 0 Then cpu_ids = Mid$(cpu_ids, 3)

    CpuId = cpu_ids
End Function

? SystemSerialNumber
Base Board Serial Number

? board.SerialNumber
Base Board Serial Number
? Mid$(serial_numbers, 3)
Base Board Serial Number