Protect my work

[Mihail]

Hi all !
Please, can you point me in the right direction ?

I have a database with two parts: One part is for tables and the other one is for forms, queries, reports and so on.
I design this database for one customer but I realized that I can sell it more than one time to different clients.
To avoid unauthorized copies I wish to "install" the database (the "front" part) on a certain computer. Or to "read" the computer (processor, mother board and so on) and, based on the results, to "compute" a "key".
If someone make a copy and paste in other PC I wish that the database do not work and show a message like this: "Programmer phone number is: NN-NNN-NN.NN.NN. Please contact them !".

Can you help me ? Some advices ? Some code ? Some links ?

Note please that this is not the security for database. I am not looking for access rights.

Hope I can explain OK my problem with my poor English.

Thank you very much !

[NeoPa]

I think this is more complicated than perhaps you appreciate Mihail. Have you considered the legal side of this problem? How would you license such a deal? Do you imagine a user would be happy if their PC blew up and they found they were unable to install it again without calling you?

There are many issues to consider, and I'm not telling you any answers, just giving you questions I think you need to consider.

[Mihail]

Hi, NeoPa.
Thank you for reply.

Yes, I think about the license.
But... what about Torrent site ? No. It is not a choice. Not in Romania :) . It is also very expensive for me. And, of course, my database has not a price like... Solid Works (as example).

So...
I have an idea how complicated is.
Also I have some code in VB6 which deal a part of the job.
I ask you (all) because there are some very good coders here. Maybe someone do the entire job before and wish to help me to avoid reinvent the warm water.

Thank you again for reply.
And if you wish (and could) help me I'll thank you again.

[NeoPa]

I have nothing for you I'm afraid. I have steered away from that area in the past, but if I think of anything I'll try to remember you're looking.

[Frinavale]

I have no idea how to do this in Access but have you considered developing a "client" application that connects to the Access database?

That client application could check computer characteristics etc to determine if it is permitted to access the database.

I have a good idea of how to do it in a .net application...but I've learned that Access is completely different.

[Mihail]

Thank you, Frinavale.

As far as I know this information (about computer characteristics) can be "read" by calling one or more libraries.
Can you explain what librarie(s) I need (I use Windows XP - 32) and the exact syntax to apply? (API syntax). I need only a few essential characteristics of the hardware (which can't be change by users).

Even only the name of the libraries I need is a good point to start for me.

If you have some code in VB.NET I think I can understand it and make necessary changes to use it in Access VBA.

Thank you again.

[NeoPa]

I have a module I use for basic operating with the OS Mihail. It includes routines to read from, and write to, Registry Values. You probably won't want to write anything to any of them, but if you do be very careful, as the usual warnings apply : Back up your registry before playing. Actually that applies also to reading from it as they can get corrupted if not opened and closed properly. As they stand, these routines handle that for you, but if you make any changes be aware that you will be putting your Registry at risk if you get them wrong. Always ensure that any Values opened in your code are closed again before it completes.

I've included the whole module here, as other procedures may also prove interesting, but only RegRead() and RegWrite() pertain to the Registry directly. I've named this module modOS in my projects :

Option Compare Database
Option Explicit
 
'Windows API Variable Prefixes
'cb = Count of Bytes (32-bit)
'w  = Word (16-bit)
'dw = Double Word (32-bit)
'lp = Long Pointer (32-bit)
'b  = Boolean (32-bit)
'h  = Handle (32-bit)
'ul = Unsigned Long (32-bit)
 
Public Const conHKCR = &H80000000
Public Const conHKCU = &H80000001
Public Const conHKLM = &H80000002
Public Const conHKU = &H80000003
Public Const REG_NONE As Long = 0               'None
Public Const REG_SZ As Long = 1                 'Null terminated string
Public Const REG_EXPAND_SZ As Long = 2          'As above but contains
                                                '  unexpanded Env Vars
Public Const REG_BINARY As Long = 3             'binary data
Public Const REG_DWORD As Long = 4              'Double Word (Long)
Public Const REG_DWORD_BIG_ENDIAN As Long = 5   'As above but reversed
Public Const REG_LINK As Long = 6               'Unicode symbolic link
Public Const REG_MULTI_SZ As Long = 7           'Array of SZs (dbl null ends)
Public Const REG_RESOURCE_LIST As Long = 8
Public Const REG_FULL_RESOURCE_DESCRIPTOR As Long = 9
Public Const REG_RESOURCE_REQUIREMENTS_LIST As Long = 10
Public Const REG_QWORD As Long = 11             ' Quad Word
Public Const conStandardRightsAll = &H1F0000
Public Const conReadControl = &H20000
Public Const conStandardRightsRead = (conReadControl)
Public Const conRegSz = 1
Public Const conOK = 0&
Public Const conKeyQueryValue = &H1
Public Const conKeySetValue = &H2
Public Const conKeyCreateSubKey = &H4
Public Const conKeyEnumerateSubKeys = &H8
Public Const conKeyNotify = &H10
Public Const conKeyCreateLink = &H20
Public Const conSynchronise = &H100000
Public Const conRegOptionNonVolatile = 0
Public Const conKeyAllAccess = ((conStandardRightsAll _
                              Or conKeyQueryValue _
                              Or conKeySetValue _
                              Or conKeyCreateSubKey _
                              Or conKeyEnumerateSubKeys _
                              Or conKeyNotify _
                              Or conKeyCreateLink) _
                            And (Not conSynchronise))
Public Const conKeyRead = ((conReadControl _
                         Or conKeyQueryValue _
                         Or conKeyEnumerateSubKeys _
                         Or conKeyNotify) _
                       And (Not conSynchronise))
 
Private Const conUseShowWindow = &H1&
Private Const conNormalPriority = &H20&
Private Const conInfinite = -1&
Private Const conWinVis = &H10000000
Private Const conGWLStyle = -16
 
Private Type typStartupInfo
    cbLen As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCount As Long
    dwYCount As Long
    dwFillAtt As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdIn As Long
    hStdOut As Long
    hStdErr As Long
End Type
 
Private Type typProcInfo
    hProc As Long
    hThread As Long
    dwProcID As Long
    dwThreadID As Long
End Type
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
    Alias "RegOpenKeyExA" (ByVal hKey As Long, _
                           ByVal lpSubKey As String, _
                           ByVal ulOptions As Long, _
                           ByVal samDesired As Long, _
                           phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _
                             As Long
Private Declare Function RegQueryValueExStr Lib "advapi32.dll" _
    Alias "RegQueryValueExA" (ByVal hKey As Long, _
                              ByVal lpValueName As String, _
                              ByVal lpReserved As Long, _
                              ByRef lpType As Long, _
                              ByVal lpData As String, _
                              ByRef lpcbData As Long) As Long
 
Private Declare Function RegSetValueExStr Lib "advapi32.dll" _
    Alias "RegSetValueExA" (ByVal hKey As Long, _
                            ByVal lpValueName As String, _
                            ByVal lpReserved As Long, _
                            ByVal lpType As Long, _
                            ByVal lpData As String, _
                            ByVal lpcbData As Long) As Long
 
Private Declare Function CreateProcessA Lib "kernel32" ( _
    ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As String, _
    ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As typStartupInfo, _
    lpProcessInformation As typProcInfo) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long
 
Private Declare Function FindWindowEx Lib "user32" _
    Alias "FindWindowExA" (ByVal hwndParent As Long, _
                           ByVal hwndChildAfter As Long, _
                           ByVal lpszClass As String, _
                           ByVal lpszWindow As String) As Long
Private Declare Function GetWindowLong Lib "user32" _
    Alias "GetWindowLongA" (ByVal hwndID As Long, _
                            ByVal nIndex As Long) As Long
 
Public Function RegRead(ByVal lngHive As Long, _
                        ByVal strKey As String, _
                        ByVal strValue As String) As Variant
    Dim intX As Integer
    Dim strBuf As String
    Dim lngRet As Long, lngHKey As Long, lngType As Long, lngBufLen As Long
 
    RegRead = Null
    strKey = strKey & vbNullChar
    lngRet = RegOpenKeyEx(hKey:=lngHive, _
                          lpSubKey:=strKey, _
                          ulOptions:=0, _
                          samDesired:=conKeyRead, _
                          phkResult:=lngHKey)
    If lngRet = conOK Then
        'Set up buffer to store value
        lngBufLen = 255
        strBuf = String(lngBufLen, 0)
        strValue = strValue & vbNullChar
        lngRet = RegQueryValueExStr(hKey:=lngHKey, _
                                    lpValueName:=strValue, _
                                    lpReserved:=0&, _
                                    lpType:=lngType, _
                                    lpData:=strBuf, _
                                    lpcbData:=lngBufLen)
        'Close key
        Call RegCloseKey(lngHKey)
        Select Case lngType
        Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ, REG_BINARY
            If lngBufLen = 255 Then
                RegRead = Null
            Else
                If lngType <> REG_BINARY Then lngBufLen = lngBufLen - 1
                RegRead = Left(strBuf, lngBufLen)
                If lngType = REG_MULTI_SZ Then _
                    RegRead = Split(RegRead, vbNullChar)
            End If
        Case REG_DWORD
            For intX = 4 To 1 Step -1
                lngRet = Asc(Mid(strBuf, intX))
                If intX = 4 Then
                    If (lngRet And &H80) > 0 Then
                        RegRead = &H80000000
                        lngRet = (lngRet And &H7F)
                    Else
                        RegRead = 0
                    End If
                End If
                RegRead = RegRead Or (lngRet * 256 ^ (intX - 1))
            Next intX
        End Select
    End If
End Function
 
Public Function RegWrite(ByVal lngHive As Long, _
                         ByVal strKey As String, _
                         ByVal strValue As String, _
                         ByVal varValue As Variant) As Boolean
    Dim intX As Integer
    Dim strBuf As String
    Dim lngRet As Long, lngHKey As Long, lngBufLen As Long, lngType As Long
    Dim lngNeg As Long
 
    RegWrite = False
    strKey = strKey & vbNullChar
    strValue = strValue & vbNullChar
    lngRet = RegOpenKeyEx(hKey:=lngHive, _
                          lpSubKey:=strKey, _
                          ulOptions:=0, _
                          samDesired:=conKeyAllAccess, _
                          phkResult:=lngHKey)
    If lngRet = conOK Then
        'Set up buffer to store value
        lngBufLen = 255
        strBuf = String(lngBufLen, 0)
        lngRet = RegQueryValueExStr(hKey:=lngHKey, _
                                    lpValueName:=strValue, _
                                    lpReserved:=0&, _
                                    lpType:=lngType, _
                                    lpData:=strBuf, _
                                    lpcbData:=lngBufLen)
        Select Case lngType
        Case REG_SZ, REG_EXPAND_SZ, REG_BINARY
            If VarType(varValue) = vbString Then _
                strBuf = varValue & IIf(lngType = REG_BINARY, "", vbNullChar)
        Case REG_MULTI_SZ
            If VarType(varValue) = (vbArray Or vbString) Then _
                strBuf = Join(varValue, vbNullChar) & vbNullChar
        Case REG_DWORD
            strBuf = Space(4)
            lngNeg = (varValue \ &H1000000) And &H80
            For intX = 1 To 4
                lngRet = (((varValue And &H7FFFFFFF) \ 256 ^ (intX - 1)) And &HFF)
                If intX = 4 Then lngRet = lngRet Or lngNeg
                Mid(strBuf, intX, 1) = Chr(lngRet)
            Next intX
        End Select
        lngBufLen = Len(strBuf)
        lngRet = RegSetValueExStr(hKey:=lngHKey, _
                                  lpValueName:=strValue, _
                                  lpReserved:=0&, _
                                  lpType:=lngType, _
                                  lpData:=strBuf, _
                                  lpcbData:=lngBufLen)
        RegWrite = (lngRet = conOK)
        'Close key
        Call RegCloseKey(lngHKey)
    End If
End Function
 
'ShellWait() executes a command synchronously (Shell() works asynchronously).
Public Sub ShellWait(strCommand As String, _
                     Optional intWinStyle As Integer = vbNormalFocus)
    Dim objProcInfo As typProcInfo
    Dim objStart As typStartupInfo
    Dim lngRet As Long
 
    'Initialize the typStartupInfo structure:
    With objStart
        .cbLen = Len(objStart)
        .dwFlags = conUseShowWindow
        .wShowWindow = intWinStyle
    End With
    'Start the shelled application:
    Call CreateProcessA(lpApplicationName:=0&, _
                        lpCommandLine:=strCommand, _
                        lpProcessAttributes:=0&, _
                        lpThreadAttributes:=0&, _
                        bInheritHandles:=1&, _
                        dwCreationFlags:=conNormalPriority, _
                        lpEnvironment:=0&, _
                        lpCurrentDirectory:=0&, _
                        lpStartupInfo:=objStart, _
                        lpProcessInformation:=objProcInfo)
    'Wait for the shelled application to finish
    Call WaitForSingleObject(hHandle:=objProcInfo.hProc, _
                             dwMilliseconds:=conInfinite)
    Call CloseHandle(hObject:=objProcInfo.hProc)
End Sub
 
Public Function DBWindowVisible() As Boolean
    Dim hWnd As Long, lngStyle As Long
 
    'Get handle of MDIClient window of current application
    hWnd = FindWindowEx(hWndAccessApp, 0, "MDIClient", vbNullString)
    'Within that, find child window matching class Odb (database window)
    hWnd = FindWindowEx(hWnd, 0, "Odb", vbNullString)
    'Default result to False in case handle wasn't found
    DBWindowVisible = False
    If (hWnd) Then
        'Having found window, check the visibility flag of its style value
        lngStyle = GetWindowLong(hWnd, conGWLStyle)
        DBWindowVisible = ((lngStyle And conWinVis) = conWinVis)
    End If
End Function

[Mihail]

Thank you, NeoPa.
I need some times to read and understand your code.
From now I wish to thank you very much.
By the way: I am also interested in a SHELL command which open a file SYNCHRONOUSLY and I see that subroutine in your code. It is great for me. Thank you again.

[NeoPa]

You're welcome of course Mihail. OS stuff (the API) is designed to work in a way that suits C and languages that pass parameters in the same way. VB & VBA don't do that so interface routines are necessary to enable these facilities for most VB/VBA programmers I find. I use these as rarely as I can as I believe in using the inbuilt object model (Access for Access; Excel for Excel; etc) wherever possible.

[Mihail]

NeoPa !
I know that you are a better coder than me, so I am very care to your opinions. But I think that the API interface is a very very VERY useful and powerful tool but, unfortunately, hard to learn. And hard to use from VB.

[NeoPa]

It's definitely useful Mihail. No argument there (and I do use it when necessary). I simply use the interface designed within Access where I can, rather than using OS API calls when I don't need to. That's all I'm saying. They're great for the things that Access can't manage.

[AR Ratheesh]

I have experienced the same issue. but my team solved this method in simple vba coding.I don't know whether this method is suitable for you or not!!!

Create a start up form(hidden) to check license of you!
if you have a license file located in a secret folder.you just check the file and import the file content and check is it true.if wrong file or location show the message and quit.

you must protect your vba for this method. otherwise access developers or others can unlock this method.

and must disable the shift bye pass key using vba.(remember to make a mechanism or method to enable this bye pass key).

[Mihail]

Thank you, AR Ratheesh.

Is a good idea and I use it before to protect some programs.
But, if the computer crash and need a disk format the files with "license" will be lost, so the user need me for a new installation.
I like to avoid that. The hardware is somewhat "fixed" so, if I can generate an "serial" based on it, a backup copy of database will work also after a computer crash.

Thank you again for your interest.

[AR Ratheesh]

Ya , Disk format is a issue. but this will be a rare case. not happens in every day.so you advise to take back ups for safety.

And try to send the license file via e-mail to you while the first installation. and if they committed to disk format.They can use the backups.But they must
contact you(They cant use DB from the formatting).

U just send a tiny Access program to reset license. Note that u should kill the that access activating file after the first use via vba.(Otherwise clients can misuse or redistribute it.)

The license file must be only for that PC(setup something unique for that pc -> PC-name or IP adress or something like that).

AR Ratheesh

[Mihail]

Yes, AR Ratheesh. It is what I am looking for: to catch, via VBA, something unique and unalterable for a certain PC.