get machine id for product key/license (1 Viewer)

[sammers101]

Is it possible to make a database unique to the computer it is on so it cannot be shared? I was thinking I could use the machineid

I tried to follow the directions on the thread below but I'm having problems getting it to work and also once it's activated, users could just copy the file?

I was getting this error "Product key entered is not valid" when I used one of the keys provided 11111-22222-33333-44444-55555

Checking License Key using HTTP

Hi, I want to allocate License keys to users, I want to achieve the concept where I store a license key in a text file on a webserver. Every time the user opens the database, a HTTP response checks the license key to see if it valid. Has anyone created anything like this...or if anyone can...

www.access-programmers.co.uk

 

[arnelgp]

You can use the computer harddisk serial, or mac address then save it to the db as custom property.

 

[sammers101]

not sure how to do that. And even if I did that wouldnt it copy over when making a copy of the database?

 

[arnelgp]

It first check the db for the existence of such property.
If it does it create it on the first run.

You make a copy you also copy the property on the db.

So it will fail on the copied db since each mac address is differen on each machine.

 

[sammers101]

That sounds like it could work then. Any ideas on how to do that or maybe a video/thread?

 

[arnelgp]

I am out right now, so cannot give you a demo.
When i get back ill give you some demo.
On the mean time , i am sure somebody will step in with his idea.

 

[sammers101]

not a problem at all, appreciate the help Will check back tomorrow, heading to bed myself

 

[isladogs]

The code below will return the following values: CPU ID, motherboard ID, hard drive ID, MAC address
Copy into a standard module. No additional references are required

Whilst you could save these values into a table, doing so defeats the object of making your database 'secure'

Instead, for the purpose described, I prefer to create a long string containing sections of each returned value to give a unique ID.
Doing that makes it almost impossible for anyone to 'guess' the final value
This value is checked at startup and if there is a mismatch, the database is closed automatically.

Option Compare Database
Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : GetCpuID
' Date      : 11/10/2017
' Purpose   : Returns the serial number of the CPU
'---------------------------------------------------------------------------------------
Public Function GetCpuID() As String

    Dim WMI, cpu, CPUID 'variants
    Set WMI = GetObject("winmgmts:")

    For Each cpu In WMI.InstancesOf("Win32_Processor")
        CPUID = CPUID + cpu.ProcessorId
    Next
  
  ' Debug.Print CPUID
  
    If Nz(CPUID, "") <> "" Then
        'remove all non-alphanumeric characters
        CPUID = Replace(CPUID, ".", "")
        CPUID = Replace(CPUID, ",", "")
        CPUID = Replace(CPUID, ":", "")
        CPUID = Replace(CPUID, ";", "")
        CPUID = Replace(CPUID, "_", "")
        CPUID = Replace(CPUID, " ", "")
        CPUID = Replace(CPUID, "-", "")
        CPUID = Replace(CPUID, "\", "")
        CPUID = Replace(CPUID, "/", "")
        CPUID = Replace(CPUID, "!", "")
        CPUID = Replace(CPUID, "?", "")
        CPUID = Replace(CPUID, "|", "")
        CPUID = Replace(CPUID, "+", "")
        CPUID = Replace(CPUID, "^", "")
        CPUID = Replace(CPUID, "&", "")
        CPUID = Replace(CPUID, "*", "")
        CPUID = Replace(CPUID, "^", "")
        CPUID = Replace(CPUID, "%", "")
        CPUID = Replace(CPUID, "£", "")
        CPUID = Replace(CPUID, """", "")
    End If

   'trim to remove spaces
    GetCpuID = Nz(Trim(CPUID), "")

End Function

'---------------------------------------------------------------------------------------
' Procedure : GetMBID
' Date      : 11/10/2017
' Purpose   : Returns the serial number of the motherboard
'---------------------------------------------------------------------------------------
'
Public Function GetMBID() As String

    Dim WMI, MB, MBID  'variants

    Set WMI = GetObject("winmgmts:")

    For Each MB In WMI.InstancesOf("Win32_BaseBoard")
        MBID = MBID + MB.SerialNumber
    Next
      
   ' Debug.Print MBID
  
    If Nz(MBID, "") <> "" Then
        'remove all non-alphanumeric characters
        MBID = Replace(MBID, ".", "")
        MBID = Replace(MBID, ",", "")
        MBID = Replace(MBID, ":", "")
        MBID = Replace(MBID, ";", "")
        MBID = Replace(MBID, "_", "")
        MBID = Replace(MBID, " ", "")
        MBID = Replace(MBID, "-", "")
        MBID = Replace(MBID, "\", "")
        MBID = Replace(MBID, "/", "")
        MBID = Replace(MBID, "!", "")
        MBID = Replace(MBID, "?", "")
        MBID = Replace(MBID, "|", "")
        MBID = Replace(MBID, "+", "")
        MBID = Replace(MBID, "^", "")
        MBID = Replace(MBID, "&", "")
        MBID = Replace(MBID, "*", "")
        MBID = Replace(MBID, "^", "")
        MBID = Replace(MBID, "%", "")
        MBID = Replace(MBID, "£", "")
        MBID = Replace(MBID, """", "")
      
        'trim to remove spaces
        GetMBID = Nz(Trim(MBID), "")
    End If

End Function

'---------------------------------------------------------------------------------------
' Procedure : GetHdNum
' Date      : 12/10/2017
' Purpose   :Returns the serial number of the HDD
'---------------------------------------------------------------------------------------
'
Function GetHdNum() As String

    Dim fsObj   As Object
    Dim drv     As Object

    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set drv = fsObj.Drives("C")

   'add default value in case code fails to return a value
    'Use Hex to convert to string
    'Trim to remove spaces
    GetHdNum = Trim(Hex(Nz(drv.SerialNumber, 1749267980)))
  
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetMac
' Date      : 13/10/2017
' Purpose   : Returns the MAC address
'---------------------------------------------------------------------------------------
Public Function GetMac() As String
Dim objWMIService As Object, objItem As Object, colItems As Variant
    GetMac = ""
    Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapter")

    For Each objItem In colItems
        'Debug.Print Nz(objItem.Name, "") & " / " & Nz(objItem.MACAddress, "")
        If InStr(objItem.Name, "etwork") <> 0 Then
           If Not IsNull(objItem.MACAddress) Then
             GetMac = objItem.MACAddress
          '   Debug.Print GetMac
             Exit For
           End If
        End If
    Next
End Function

Hope that helps

NOTE: Do bear in mind that if an authorised user later changes any of the above components, he/she will be locked out of the database.
You will need to implement a procedure to handle such situations

 

[arnelgp]

here is a demo using mac address.
run it on any computer. make sure you enable the db.
after successfully shown the welcome form, you can close the db.

copy the db and run on another pc.

 

[sammers101]

that seems to work perfectly. I will try that out thanks