Add Original SDK
This commit is contained in:
@@ -0,0 +1,905 @@
|
||||
Attribute VB_Name = "DPSample"
|
||||
Option Compare Database
|
||||
|
||||
' The sample code contains 12 functions. You will not need to use all these
|
||||
' functions in your code. Just use which ever functions are most appropriate
|
||||
' and customise in your own way. The sample code is just a guide. You should
|
||||
' implement the protection in a stronger way using the techniques described in
|
||||
' the "Increasing your Protection" chapter of the manual.
|
||||
'
|
||||
' The 12 functions are:
|
||||
' ProtCheck a standard protection check
|
||||
' ProtCheckWithAlg a protection check & executing an Algorithm
|
||||
' WriteString a protection check & write data to the dongle
|
||||
' ReadString a protection check & read data from the dongle
|
||||
' WriteBytes a protection check & write data to the dongle
|
||||
' ReadBytes a protection check & read data from the dongle
|
||||
' EncryptUserData a protection check,& encrypting data and then decrypting the data
|
||||
'
|
||||
' these functions are the same as some of the functions listed above but encrypting all parameters passed to our API
|
||||
' ProtCheckEnc a standard protection check
|
||||
' ProtCheckWithAlgEnc a protection check & executing an Algorithm
|
||||
' WriteBytesEnc a protection check & write data to the dongle
|
||||
' ReadBytesEnc a protection check & read data from the dongle
|
||||
' EncryptUserDataEnc a protection check & encrypting data and then decrypting the data
|
||||
|
||||
' If you are using Dinkey Lite then you can only use 4 functions:
|
||||
' ProtCheck, ProtCheckWithAlg, ProtCheckEnc, ProtCheckWithAlgEnc
|
||||
|
||||
' !!!!
|
||||
Public Const MY_SDSN = 10101 ' !!!! change this value to be the value of your SDSN (demo = 10101)
|
||||
Public Const MY_PRODCODE = "DEMO" ' !!!! change this value to match the Product Code in the dongle
|
||||
|
||||
' Used in OnOpen property of Startup form.
|
||||
Function OpenStartup() As Boolean
|
||||
On Error GoTo open_failure
|
||||
|
||||
' call the function(s) of your choice here
|
||||
' here I have chosen a standard protection check
|
||||
If ProtCheck() <> 0 Then
|
||||
Call CloseCurrentDatabase
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Exit Function
|
||||
|
||||
open_failure:
|
||||
'DLL failed to load
|
||||
MsgBox "Cannot find Dinkey Pro Runtime Module (dpwin32.dll / dpwin64.dll). This should be in the Windows System directory", vbOKOnly, "Error"
|
||||
Call CloseCurrentDatabase
|
||||
End Function
|
||||
|
||||
Function ProtCheck() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = PROTECTION_CHECK ' standard protection check
|
||||
mydris.flags = 0 ' no extra flags, but you may want to specify some if you want to start a network user or decrement execs,...
|
||||
|
||||
ret_code = DDProtCheck(mydris, 0)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
ProtCheck = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
ProtCheck = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'NB to access product code you will need to use the TrimCString function
|
||||
If (TrimCString(mydris.prodcode) <> MY_PRODCODE) Then
|
||||
MsgBox "Incorrect Product Code! Please modify your source code so that MY_PRODCODE is set to be the Product Code in the dongle.", vbOKOnly, "Error"
|
||||
ProtCheck = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
ProtCheck = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' NB to access the dongle number you will need to use the ConvertToUnsigned function like this:
|
||||
'ConvertToUnsigned(mydris.dongle_number)
|
||||
|
||||
ProtCheck = 0
|
||||
End Function
|
||||
|
||||
' !!!! You should replace this function with the one generated by the
|
||||
' "generate source code" button in Algorithm tab for DinkeyAdd (if you have specified an algorithm)
|
||||
' or from DinkeyLook if you are using Dinkey Lite dongles.
|
||||
' see readme.txt notes concerning using the algorithm in VB
|
||||
Private Function MyAlgorithm(ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal e As Long, ByVal f As Long, ByVal g As Long, ByVal h As Long) As Long
|
||||
MyAlgorithm = a + b + c + d + e + f + g + h
|
||||
End Function
|
||||
|
||||
' NB for this to work you must program at least "user algorithm" into the dongle
|
||||
' NB We have used a very simple algorithm here (in the MyAlgorithm function). You must patch this with the
|
||||
' sample code generated by DinkeyAdd for the algorithm that you are using.
|
||||
Function ProtCheckWithAlg() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = EXECUTE_ALGORITHM ' standard protection check & execute an algorithm
|
||||
mydris.flags = 0 ' no extra flags, but you may want to specify some if you want to start a network user or decrement execs,...
|
||||
mydris.alg_number = 1 ' execute first algorithm (you do not need to specify this field for Dinkey Lite dongles)
|
||||
' you should remove these entries if you are using Dinkey Lite so that algorithm arguments are random
|
||||
mydris.var_a = 1 ' sample values
|
||||
mydris.var_b = 2
|
||||
mydris.var_c = 3
|
||||
mydris.var_d = 4
|
||||
mydris.var_e = 5
|
||||
mydris.var_f = 6
|
||||
mydris.var_g = 7
|
||||
mydris.var_h = 8
|
||||
|
||||
ret_code = DDProtCheck(mydris, 0)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
ProtCheckWithAlg = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
ProtCheckWithAlg = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
ProtCheckWithAlg = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' if you want you can check the algorithm answer - however if algorithm is from your code then best to just use the answer in your code
|
||||
' !!!! Make sure you have replaced the MyAlgorithm routine with the algorithm you have specified in DinkeyAdd
|
||||
If MyAlgorithm(mydris.var_a, mydris.var_b, mydris.var_c, mydris.var_d, mydris.var_e, mydris.var_f, mydris.var_g, mydris.var_h) <> mydris.alg_answer Then
|
||||
MsgBox "Dinkey Dongle protection error / You have not patched your algorithm in the MyAlgorithm routine", vbOKOnly, "Error"
|
||||
ProtCheckWithAlg = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
ProtCheckWithAlg = 0
|
||||
End Function
|
||||
|
||||
|
||||
' This writes the String "Hello, World" to the dongle data area at offset 7
|
||||
' In order for this function to work you will need to have a data area in your dongle that is at least 21 bytes long.
|
||||
' If you want to write data that isn't a string use the WriteBytes function
|
||||
Function WriteString() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim StringToWrite As String * 13
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = WRITE_DATA_AREA ' standard protection check and write data provided
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.rw_offset = 7
|
||||
mydris.rw_length = 13
|
||||
|
||||
StringToWrite = "Hello, World!"
|
||||
|
||||
ret_code = DDProtCheckString(mydris, StringToWrite)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
WriteString = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
WriteString = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
WriteString = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
WriteString = 0
|
||||
End Function
|
||||
|
||||
|
||||
' This writes the data 0,1,2,...19 to the dongle data area at offset 7
|
||||
' In order for this function to work you will need to have a data area in your dongle that is at least 28 bytes long.
|
||||
' If you want to write strings it is easier to use the WriteString function
|
||||
Function WriteData() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim DataToWrite As FixedByteArray
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = WRITE_DATA_AREA ' standard protection check and write data provided
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.rw_offset = 7
|
||||
mydris.rw_length = 20
|
||||
|
||||
For i = 0 To 19
|
||||
DataToWrite.Data(i) = i
|
||||
Next
|
||||
|
||||
ret_code = DDProtCheckData(mydris, DataToWrite)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
WriteData = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
WriteData = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
WriteData = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
WriteData = 0
|
||||
End Function
|
||||
|
||||
|
||||
' This reads 13 bytes of data from offset 7 in the dongle data area
|
||||
' In order for this function to work you will need to have a data area in your dongle that is at least 20 bytes long.
|
||||
' In order for the data to be displayed properly by this routine it will need to be text data
|
||||
Function ReadString() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim StringToRead As String * 13
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = READ_DATA_AREA ' standard protection check and read data
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.rw_offset = 7
|
||||
mydris.rw_length = 13
|
||||
|
||||
ret_code = DDProtCheckString(mydris, StringToRead)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
ReadString = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
ReadString = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
ReadString = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
MsgBox "Dinkey Data Area at offset 7 contains: " + StringToRead, vbOKOnly
|
||||
|
||||
ReadString = 0
|
||||
End Function
|
||||
|
||||
|
||||
' This reads 20 bytes of data from offset 7 in the dongle data area
|
||||
' In order for this function to work you will need to have a data area in your dongle that is at least 27 bytes long.
|
||||
Function ReadData() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim DataToRead As FixedByteArray
|
||||
Dim ret_code As Long
|
||||
Dim DisplayString As String
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = READ_DATA_AREA ' standard protection check and write data provided
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.rw_offset = 7
|
||||
mydris.rw_length = 20
|
||||
|
||||
ret_code = DDProtCheckData(mydris, DataToRead)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
ReadData = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
ReadData = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
ReadData = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
DisplayString = "Dinkey Data Area at offset 7 contains: "
|
||||
For i = 0 To 19
|
||||
DisplayString = DisplayString + Str(DataToRead.Data(i))
|
||||
Next
|
||||
|
||||
MsgBox DisplayString, vbOKOnly
|
||||
ReadData = 0
|
||||
End Function
|
||||
|
||||
' This function will do a protection check and ask the dongle to encrypt some data using encryption key 1
|
||||
' It will then do another protection check & decrypt the data
|
||||
' The data used in this example is 0,1,2...19. If you wanted to encrypt and/or decrypt Strings
|
||||
' then you could use a technique similar to that employed in WriteString & ReadString
|
||||
Function EncryptUserData() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim MyData As FixedByteArray
|
||||
Dim DisplayString As String
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = ENCRYPT_USER_DATA ' standard protection check & encrypt data
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.data_crypt_key_num = 1
|
||||
mydris.rw_length = 20
|
||||
|
||||
For i = 0 To 19 ' initialise data
|
||||
MyData.Data(i) = i
|
||||
Next
|
||||
|
||||
ret_code = DDProtCheckData(mydris, MyData)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
EncryptUserData = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' ... could add code to check other elements of the DRIS, e.g. ret_code, sdsn as per previous example functions
|
||||
|
||||
' Now decrypt the same data to get the original values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = DECRYPT_USER_DATA ' standard protection check & decrypt data
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.data_crypt_key_num = 1
|
||||
mydris.rw_length = 20
|
||||
|
||||
ret_code = DDProtCheckData(mydris, MyData)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
EncryptUserData = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
EncryptUserData = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
EncryptUserData = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
DisplayString = "Decrypted Data is : "
|
||||
For i = 0 To 19
|
||||
DisplayString = DisplayString + Str(MyData.Data(i))
|
||||
Next
|
||||
|
||||
MsgBox DisplayString, vbOKOnly
|
||||
EncryptUserData = 0
|
||||
End Function
|
||||
|
||||
' !!!!!!!!!!! all the functions listed below encrypt all parameters to our API !!!!!!!!!!!!!!!!!!!!!
|
||||
' In order for them to work properly you need to choose "Encrypt DRIS" and "Encrypt Data passed to API"
|
||||
' in the Extra Security tab of DinkeyAdd. In this example, for Data Encryption I use the r/w algorithm
|
||||
' but the code can be modified easily to use the 3 encryption parameters.
|
||||
|
||||
' !!!! please overwrite this function with the one generated by DinkeyAdd for R/W Algorithm
|
||||
Private Function MyRWAlgorithm(ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal e As Long, ByVal f As Long, ByVal g As Long, ByVal h As Long) As Long
|
||||
MyRWAlgorithm = a Xor b Xor c Xor d Xor e Xor f
|
||||
MyRWAlgorithm = MyRWAlgorithm And &HFFFFFF ' we only use bottom 3 bytes and -ve numbers can cause problems with CryptApiData
|
||||
End Function
|
||||
|
||||
' !!!! please overwrite this function with the one generated by DinkeyAdd
|
||||
Private Sub CryptDRIS(mydris As DRIS)
|
||||
Dim i, j, k, t As Integer
|
||||
Dim bigseed(256) As Byte
|
||||
Dim S(256) As Byte
|
||||
Dim temp As Byte
|
||||
Dim temp_dris(Len(mydris)) As Byte
|
||||
|
||||
Call CopyMemory(temp_dris(0), mydris, Len(mydris))
|
||||
For i = 0 To 255 Step 8
|
||||
Call CopyMemory(bigseed(i), mydris.seed1, 4)
|
||||
Call CopyMemory(bigseed(i + 4), mydris.seed2, 4)
|
||||
Next
|
||||
For i = 0 To 255
|
||||
S(i) = i
|
||||
Next
|
||||
j = 0
|
||||
For i = 0 To 255
|
||||
j = (j + CInt(S(i)) + CInt(bigseed(i)) + 123) Mod 256
|
||||
temp = S(i)
|
||||
S(i) = S(j)
|
||||
S(j) = temp
|
||||
Next
|
||||
i = 0
|
||||
j = 0
|
||||
For k = 16 To Len(mydris) - 1
|
||||
i = (i + 1) Mod 256
|
||||
j = (j + CInt(S(i)) + 212) Mod 256
|
||||
temp = S(i)
|
||||
S(i) = S(j)
|
||||
S(j) = temp
|
||||
t = (CInt(S(i)) + CInt(S(j)) + 97) Mod 256
|
||||
temp_dris(k) = temp_dris(k) Xor S(t)
|
||||
Next
|
||||
|
||||
Call CopyMemory(mydris, temp_dris(0), Len(mydris))
|
||||
End Sub
|
||||
|
||||
' !!!! please overwrite this function with the one generated by DinkeyAdd
|
||||
Private Sub CryptApiData(ByRef Data() As Byte, ByVal length As Long, ByVal seed1 As Long, ByVal seed2 As Long, ByVal AlgAnswer As Long)
|
||||
Dim i, j, k, t As Integer
|
||||
Dim bigseed(256) As Byte
|
||||
Dim S(256) As Byte
|
||||
Dim temp As Byte
|
||||
|
||||
For i = 0 To 255 Step 8
|
||||
Call CopyMemory(bigseed(i), seed1, 4)
|
||||
Call CopyMemory(bigseed(i + 4), seed2, 4)
|
||||
Next
|
||||
For i = 0 To 255
|
||||
S(i) = i
|
||||
Next
|
||||
j = 0
|
||||
For i = 0 To 255
|
||||
j = (j + CInt(S(i)) + CInt(bigseed(i)) + (AlgAnswer And &HFF)) Mod 256
|
||||
temp = S(i)
|
||||
S(i) = S(j)
|
||||
S(j) = temp
|
||||
Next
|
||||
i = 0
|
||||
j = 0
|
||||
For k = 0 To length - 1
|
||||
i = (i + 1) Mod 256
|
||||
j = (j + CInt(S(i)) + ((AlgAnswer \ &H100) And &HFF)) Mod 256
|
||||
temp = S(i)
|
||||
S(i) = S(j)
|
||||
S(j) = temp
|
||||
t = (CInt(S(i)) + CInt(S(j)) + ((AlgAnswer \ &H10000) And &HFF)) Mod 256
|
||||
Data(k) = Data(k) Xor S(t)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
' We encrypt the DRIS passed to the API. Patch the CryptDRIS function in this file from source code generated by DinkeyAdd.
|
||||
Function ProtCheckEnc() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = PROTECTION_CHECK ' standard protection check
|
||||
mydris.flags = 0 ' no extra flags, but you may want to specify some if you want to start a network user or decrement execs,...
|
||||
|
||||
Call CryptDRIS(mydris) ' encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
ret_code = DDProtCheck(mydris, 0)
|
||||
|
||||
Call CryptDRIS(mydris) ' decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
ProtCheckEnc = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
ProtCheckEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
'NB to access product code you will need to use the TrimCString function
|
||||
If (TrimCString(mydris.prodcode) <> MY_PRODCODE) Then
|
||||
MsgBox "Incorrect Product Code! Please modify your source code so that MY_PRODCODE is set to be the Product Code in the dongle.", vbOKOnly, "Error"
|
||||
ProtCheckEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
ProtCheckEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
ProtCheckEnc = 0
|
||||
End Function
|
||||
|
||||
|
||||
' NB for this to work you must program at least "user algorithm" into the dongle
|
||||
' NB We have used a very simple algorithm here (in the MyAlgorithm function). You must patch this with the
|
||||
' sample code generated by DinkeyAdd for the algorithm that you are using. For Dinkey Lite copy source from DinkeyLook.
|
||||
' We encrypt the DRIS passed to the API. Patch the CryptDRIS function in this file from source code generated by DinkeyAdd.
|
||||
Function ProtCheckWithAlgEnc() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = EXECUTE_ALGORITHM ' standard protection check & execute an algorithm
|
||||
mydris.flags = 0 ' no extra flags, but you may want to specify some if you want to start a network user or decrement execs,...
|
||||
mydris.alg_number = 1 ' execute first algorithm - you do not need to specify this field if you are only using Lite models
|
||||
' you should remove these entries if you are using Dinkey Lite so that algorithm arguments are random
|
||||
mydris.var_a = 1 ' sample values
|
||||
mydris.var_b = 2
|
||||
mydris.var_c = 3
|
||||
mydris.var_d = 4
|
||||
mydris.var_e = 5
|
||||
mydris.var_f = 6
|
||||
mydris.var_g = 7
|
||||
mydris.var_h = 8
|
||||
|
||||
Call CryptDRIS(mydris) ' encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
ret_code = DDProtCheck(mydris, 0)
|
||||
|
||||
Call CryptDRIS(mydris) ' decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
ProtCheckWithAlgEnc = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
ProtCheckWithAlgEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
ProtCheckWithAlgEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' if you want you can check the algorithm answer - however if algorithm is from your code then best to just use the answer in your code
|
||||
' !!!! Make sure you have replaced the MyAlgorithm routine with the algorithm you have specified in DinkeyAdd
|
||||
If MyAlgorithm(mydris.var_a, mydris.var_b, mydris.var_c, mydris.var_d, mydris.var_e, mydris.var_f, mydris.var_g, mydris.var_h) <> mydris.alg_answer Then
|
||||
MsgBox "Dinkey Dongle protection error / You have not patched your algorithm in the MyAlgorithm routine", vbOKOnly, "Error"
|
||||
ProtCheckWithAlgEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
ProtCheckWithAlgEnc = 0
|
||||
End Function
|
||||
|
||||
|
||||
' This writes the data 0,1,2,...19 to the dongle data area at offset 7
|
||||
' In order for this function to work you will need to have a data area in your dongle that is at least 28 bytes long.
|
||||
' We encrypt the DRIS and Data passed to the API. Patch the CryptDRIS and CryptApiData functions in this file from source code generated by DinkeyAdd.
|
||||
Function WriteDataEnc() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim DataToWrite As FixedByteArray
|
||||
Dim ret_code As Long
|
||||
Dim alg_ans As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = WRITE_DATA_AREA ' standard protection check and write data provided
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.rw_offset = 7
|
||||
mydris.rw_length = 20
|
||||
' NB we restrict the algorithm variables to be 24-bit values to avoid any possible overruns in the algorithm
|
||||
mydris.var_a = Rand(&HFFFFFF) ' random values
|
||||
mydris.var_b = Rand(&HFFFFFF)
|
||||
mydris.var_c = Rand(&HFFFFFF)
|
||||
mydris.var_d = Rand(&HFFFFFF)
|
||||
mydris.var_e = Rand(&HFFFFFF)
|
||||
mydris.var_f = Rand(&HFFFFFF)
|
||||
mydris.var_g = Rand(&HFFFFFF)
|
||||
mydris.var_h = Rand(&HFFFFFF)
|
||||
|
||||
For i = 0 To 19 ' initialise data to write
|
||||
DataToWrite.Data(i) = i
|
||||
Next
|
||||
|
||||
' calculate r/w algorithm answer - NB need to replace MyRWAlgorithm code with code for r/w algorithm
|
||||
alg_ans = MyRWAlgorithm(mydris.var_a, mydris.var_b, mydris.var_c, mydris.var_d, mydris.var_e, mydris.var_f, mydris.var_g, mydris.var_h)
|
||||
|
||||
' encrypt data we want to write.
|
||||
Call CryptApiData(DataToWrite.Data, 20, mydris.seed1, mydris.seed2, alg_ans)
|
||||
|
||||
Call CryptDRIS(mydris) ' encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
ret_code = DDProtCheckData(mydris, DataToWrite)
|
||||
|
||||
Call CryptDRIS(mydris) ' decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
WriteDataEnc = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
WriteDataEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
WriteDataEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
WriteDataEnc = 0
|
||||
End Function
|
||||
|
||||
|
||||
' This reads 20 bytes of data from offset 7 in the dongle data area
|
||||
' In order for this function to work you will need to have a data area in your dongle that is at least 27 bytes long.
|
||||
' We encrypt the DRIS and Data passed from the API. Patch the CryptDRIS and CryptApiData functions in this file from source code generated by DinkeyAdd.
|
||||
Function ReadDataEnc() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim DataToRead As FixedByteArray
|
||||
Dim ret_code As Long
|
||||
Dim DisplayString As String
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = READ_DATA_AREA ' standard protection check and write data provided
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.rw_offset = 7
|
||||
mydris.rw_length = 20
|
||||
' NB we restrict the algorithm variables to be 24-bit values to avoid any possible overruns in the algorithm
|
||||
mydris.var_a = Rand(&HFFFFFF) ' random values
|
||||
mydris.var_b = Rand(&HFFFFFF)
|
||||
mydris.var_c = Rand(&HFFFFFF)
|
||||
mydris.var_d = Rand(&HFFFFFF)
|
||||
mydris.var_e = Rand(&HFFFFFF)
|
||||
mydris.var_f = Rand(&HFFFFFF)
|
||||
mydris.var_g = Rand(&HFFFFFF)
|
||||
mydris.var_h = Rand(&HFFFFFF)
|
||||
|
||||
' calculate r/w algorithm answer - NB need to replace MyRWAlgorithm code with code for r/w algorithm
|
||||
alg_ans = MyRWAlgorithm(mydris.var_a, mydris.var_b, mydris.var_c, mydris.var_d, mydris.var_e, mydris.var_f, mydris.var_g, mydris.var_h)
|
||||
|
||||
Call CryptDRIS(mydris) ' encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
ret_code = DDProtCheckData(mydris, DataToRead)
|
||||
|
||||
Call CryptDRIS(mydris) ' decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
ReadDataEnc = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
ReadDataEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
ReadDataEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' encrypt data we want to write.
|
||||
Call CryptApiData(DataToRead.Data, 20, mydris.seed1, mydris.seed2, alg_ans)
|
||||
|
||||
DisplayString = "Dinkey Data Area at offset 7 contains: "
|
||||
For i = 0 To 19
|
||||
DisplayString = DisplayString + Str(DataToRead.Data(i))
|
||||
Next
|
||||
|
||||
MsgBox DisplayString, vbOKOnly
|
||||
ReadDataEnc = 0
|
||||
End Function
|
||||
|
||||
' This function will do a protection check and ask the dongle to encrypt some data using encryption key 1
|
||||
' It will then do another protection & decrypt the data
|
||||
' We encrypt the DRIS and Data passed to/from the API. Patch the CryptDRIS and CryptApiData functions in this file from source code generated by DinkeyAdd.
|
||||
Function EncryptUserDataEnc() As Long
|
||||
Dim mydris As DRIS
|
||||
Dim MyData As FixedByteArray
|
||||
Dim DisplayString As String
|
||||
Dim ret_code As Long
|
||||
|
||||
' set the DRIS to have random values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = ENCRYPT_USER_DATA ' standard protection check & encrypt data
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.data_crypt_key_num = 1
|
||||
mydris.rw_length = 20
|
||||
' NB we restrict the algorithm variables to be 24-bit values to avoid any possible overruns in the algorithm
|
||||
mydris.var_a = Rand(&HFFFFFF) ' random values
|
||||
mydris.var_b = Rand(&HFFFFFF)
|
||||
mydris.var_c = Rand(&HFFFFFF)
|
||||
mydris.var_d = Rand(&HFFFFFF)
|
||||
mydris.var_e = Rand(&HFFFFFF)
|
||||
mydris.var_f = Rand(&HFFFFFF)
|
||||
mydris.var_g = Rand(&HFFFFFF)
|
||||
mydris.var_h = Rand(&HFFFFFF)
|
||||
|
||||
For i = 0 To 19 ' initialise data
|
||||
MyData.Data(i) = i
|
||||
Next
|
||||
|
||||
' calculate r/w algorithm answer - NB need to replace MyRWAlgorithm code with code for r/w algorithm
|
||||
alg_ans = MyRWAlgorithm(mydris.var_a, mydris.var_b, mydris.var_c, mydris.var_d, mydris.var_e, mydris.var_f, mydris.var_g, mydris.var_h)
|
||||
|
||||
' encrypt data we want to pass.
|
||||
Call CryptApiData(MyData.Data, 20, mydris.seed1, mydris.seed2, alg_ans)
|
||||
|
||||
Call CryptDRIS(mydris) ' encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
ret_code = DDProtCheckData(mydris, MyData)
|
||||
|
||||
Call CryptDRIS(mydris) ' decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
EncryptUserDataEnc = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' ... could add code to check other elements of the DRIS, e.g. ret_code, sdsn as per previous example functions
|
||||
|
||||
' Now decrypt the same data to get the original values
|
||||
Call RandomSet(mydris)
|
||||
' then set the values we want to use
|
||||
mydris.header = "DRIS"
|
||||
mydris.size = Len(mydris)
|
||||
mydris.function = DECRYPT_USER_DATA ' standard protection check & decrypt data
|
||||
mydris.flags = USE_FUNCTION_ARGUMENT ' indicates we want to pass the data directly to our function. This is the only way to do it in VB.
|
||||
mydris.data_crypt_key_num = 1
|
||||
mydris.rw_length = 20
|
||||
' NB we restrict the algorithm variables to be 24-bit values to avoid any possible overruns in the algorithm
|
||||
mydris.var_a = Rand(&HFFFFFF) ' random values
|
||||
mydris.var_b = Rand(&HFFFFFF)
|
||||
mydris.var_c = Rand(&HFFFFFF)
|
||||
mydris.var_d = Rand(&HFFFFFF)
|
||||
mydris.var_e = Rand(&HFFFFFF)
|
||||
mydris.var_f = Rand(&HFFFFFF)
|
||||
mydris.var_g = Rand(&HFFFFFF)
|
||||
mydris.var_h = Rand(&HFFFFFF)
|
||||
|
||||
Call CryptDRIS(mydris) ' encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
ret_code = DDProtCheckData(mydris, MyData)
|
||||
|
||||
Call CryptDRIS(mydris) ' decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
||||
|
||||
If (ret_code <> 0) Then
|
||||
Call DisplayError(ret_code, mydris.ext_err)
|
||||
EncryptUserDataEnc = ret_code
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later in your code you can check other values in the DRIS...
|
||||
If (mydris.sdsn <> MY_SDSN) Then
|
||||
MsgBox "Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN.", vbOKOnly, "Error"
|
||||
EncryptUserDataEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' later on in your program you can check the return code again
|
||||
If (mydris.ret_code <> 0) Then
|
||||
MsgBox "Dinkey Dongle protection error", vbOKOnly, "Error"
|
||||
EncryptUserDataEnc = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' calculate r/w algorithm answer - NB need to replace MyRWAlgorithm code with code for r/w algorithm
|
||||
alg_ans = MyRWAlgorithm(mydris.var_a, mydris.var_b, mydris.var_c, mydris.var_d, mydris.var_e, mydris.var_f, mydris.var_g, mydris.var_h)
|
||||
|
||||
' decrypt data passed to us from the API.
|
||||
Call CryptApiData(MyData.Data, 20, mydris.seed1, mydris.seed2, alg_ans)
|
||||
|
||||
DisplayString = "Decrypted Data is : "
|
||||
For i = 0 To 19
|
||||
DisplayString = DisplayString + Str(MyData.Data(i))
|
||||
Next
|
||||
|
||||
MsgBox DisplayString, vbOKOnly
|
||||
EncryptUserDataEnc = 0
|
||||
End Function
|
||||
|
||||
' look at the error code and try to display an appropriate message
|
||||
' !!!! you will want to replace these error messages with your own messages.
|
||||
Public Sub DisplayError(ret_code As Long, extended_error As Long)
|
||||
Select Case ret_code
|
||||
Case 401
|
||||
MsgBox "Error! No dongles detected!", vbOKOnly, "Error"
|
||||
Case 403
|
||||
MsgBox "Error! A dongle was detected but it was a different type to the one specified in DinkeyAdd.", vbOKOnly, "Error"
|
||||
Case 404
|
||||
MsgBox "Error! A dongle was detected but it was a different model to those specified in DinkeyAdd.", vbOKOnly, "Error"
|
||||
Case 409
|
||||
MsgBox "Error! The dongle detected has not been programmed by DinkeyAdd.", vbOKOnly, "Error"
|
||||
Case 410
|
||||
MsgBox "Error! A dongle was detected but it has a different Product Code to the one specified in DinkeyAdd.", vbOKOnly, "Error"
|
||||
Case 411
|
||||
MsgBox "Error! The dongle detected does not contain the licence associated with this program.", vbOKOnly, "Error"
|
||||
Case 413
|
||||
MsgBox "Error! This program has not been protected by DinkeyAdd. For guidance please read the DinkeyAdd chapter of the Dinkey manual.", vbOKOnly, "Error"
|
||||
Case 417
|
||||
MsgBox "Error! One or more of the parameters set in the DRIS is incorrect. This could be caused if you are encrypting the DRIS in your code but did not specify DRIS encryption in DinkeyAdd - or vice versa.", vbOKOnly, "Error"
|
||||
Case 423
|
||||
MsgBox "Error! The number of network users has been exceeded.", vbOKOnly, "Error"
|
||||
Case 435
|
||||
MsgBox "Error! DinkeyServer has not been detected on the network.", vbOKOnly, "Error"
|
||||
Case 922
|
||||
MsgBox "Error! The Software Key has expired.", vbOKOnly, "Error"
|
||||
Case Else
|
||||
MsgBox "An error occurred checking the dongle. Error: " + Str(ret_code) + ". Extended Error: " + str$(extended_error) + ".", vbOKOnly, "Error"
|
||||
End Select
|
||||
End Sub
|
||||
@@ -0,0 +1,163 @@
|
||||
' A VBA Interface to the Dinkey Pro/FD API
|
||||
|
||||
|
||||
Attribute VB_Name = "DinkeyPro"
|
||||
' API functions
|
||||
' DDProtCheck - so we can ignore the second argument
|
||||
' DDProtCheckString - so we can pass data as a String
|
||||
' DDProtCheckData - so we can pass data in any format
|
||||
|
||||
#If VBA7 Then
|
||||
' For Office 2010 and newer
|
||||
#If Win64 Then
|
||||
Declare PtrSafe Function DDProtCheck Lib "dpwin64.dll" (mydris As DRIS, Data As String) As Long
|
||||
Declare PtrSafe Function DDProtCheckString Lib "dpwin64.dll" Alias "DDProtCheck" (mydris As DRIS, ByVal String1 As Any) As Long
|
||||
Declare PtrSafe Function DDProtCheckData Lib "dpwin64.dll" Alias "DDProtCheck" (mydris As DRIS, Data As FixedByteArray) As Long
|
||||
#Else
|
||||
Declare PtrSafe Function DDProtCheck Lib "dpwin32.dll" (mydris As DRIS, Data As String) As Long
|
||||
Declare PtrSafe Function DDProtCheckString Lib "dpwin32.dll" Alias "DDProtCheck" (mydris As DRIS, ByVal String1 As Any) As Long
|
||||
Declare PtrSafe Function DDProtCheckData Lib "dpwin32.dll" Alias "DDProtCheck" (mydris As DRIS, Data As FixedByteArray) As Long
|
||||
#End If
|
||||
#Else
|
||||
' For versions of Office before 2010
|
||||
Declare Function DDProtCheck Lib "dpwin32.dll" (myDris As DRIS, Data As String) As Long
|
||||
Declare Function DDProtCheckString Lib "dpwin32.dll" Alias "DDProtCheck" (myDris As DRIS, ByVal String1 As Any) As Long
|
||||
Declare Function DDProtCheckData Lib "dpwin32.dll" Alias "DDProtCheck" (myDris As DRIS, Data As FixedByteArray) As Long
|
||||
#End If
|
||||
|
||||
'Dinkey Runtime Information Structure (DRIS)
|
||||
Type DRIS
|
||||
' the first 4 fields are never encrypted
|
||||
header As String * 4 ' should be set to DRIS
|
||||
' inputs
|
||||
size As Long ' size of this structure
|
||||
seed1 As Long ' seed for data/dris encryption
|
||||
seed2 As Long ' as above
|
||||
function As Long ' specify only one function
|
||||
flags As Long ' options for the function selected. To use more than one OR them together: OPTION1 Or OPTION2...
|
||||
execs_decrement As Long ' amount by which to dec execs if we use flag: DEC_MANY_EXECS
|
||||
data_crypt_key_num As Long ' number of the key (1-3) that the dongle uses to encrypt or decrypt user data
|
||||
rw_offset As Long ' offset in the dongle data area to read or write data
|
||||
rw_length As Long ' length of data are to read/write/encrypt/decrypt
|
||||
#If VBA7 Then
|
||||
not_used As LongPtr ' This field is a pointer used in other programming languages. 4 bytes in 32-bit Access, 8 bytes in 64-bit Access
|
||||
#Else
|
||||
not_used As Long
|
||||
#End If
|
||||
alt_licence_name As String * 256 ' protection check for different licence instead of this one, must be null-terminated ascii
|
||||
var_a As Long ' variable values for user algorithms
|
||||
var_b As Long
|
||||
var_c As Long
|
||||
var_d As Long
|
||||
var_e As Long
|
||||
var_f As Long
|
||||
var_g As Long
|
||||
var_h As Long
|
||||
alg_number As Long ' the number of the user algorithm that you want to execute
|
||||
|
||||
' outputs
|
||||
ret_code As Long ' the return code from the protection check
|
||||
ext_err As Long ' extended error
|
||||
type As Long ' type of dongle detected. 1 = Pro, 2 = FD
|
||||
model As Long ' model of dongle detected. 1 = Lite, 2 = Plus, 4 = Net 5, 7 = Net Unlimited
|
||||
sdsn As Long ' Software Developer's Serial Number
|
||||
prodcode As String * 12 ' product code (null-terminated)
|
||||
dongle_number As Long ' dongle number. This number should be converted to a Double before being displayed otherwise it my appear as a negative number.
|
||||
update_number As Long
|
||||
data_area_size As Long ' size of the data area in the dongle detected
|
||||
max_alg_num As Long ' the maximum algorithm number in the dongle detected
|
||||
execs As Long ' executions left: -1 indicates 'no limit'
|
||||
exp_day As Long ' expiry day: -1 indicates 'no limit'
|
||||
exp_month As Long ' expiry month: -1 indicates 'no limit'
|
||||
exp_year As Long ' expiry year: -1 indicates 'no limit'
|
||||
features As Long ' features value
|
||||
net_users As Long ' maximum number of network users for the dongle detected: -1 indicates 'mo limit'
|
||||
alg_answer As Long ' answer to the user algorithm executed with the given variable values
|
||||
fd_capacity As Long ' capacity of the data area in FD dongle. Currently fixed at ~10MB but may change in the future.
|
||||
fd_drive As String * 128 ' drive letter of FD dongle detected e.g. 'f:\'
|
||||
swkey_type As Long ' 0 = no swkey detected, 1 = temporary software key, 2 = demo software key
|
||||
swkey_exp_day As Long ' software key expiry date (if software key detected)
|
||||
swkey_exp_month As Long
|
||||
swkey_exp_year As Long
|
||||
End Type
|
||||
|
||||
' We need a structure for an array of bytes because otherwise the VB runtime can move the data in-between function calls
|
||||
Type FixedByteArray
|
||||
Data(0 To 1023) As Byte
|
||||
End Type
|
||||
|
||||
' Functions
|
||||
Public Const PROTECTION_CHECK = 1 ' checks for dongle, check program params...
|
||||
Public Const EXECUTE_ALGORITHM = 2 ' protection check + calculate answer for specified algorithm with specified inputs
|
||||
Public Const WRITE_DATA_AREA = 3 ' protection check + writes dongle data area
|
||||
Public Const READ_DATA_AREA = 4 ' protection check + reads dongle data area
|
||||
Public Const ENCRYPT_USER_DATA = 5 ' protection check + the dongle will encrypt user data
|
||||
Public Const DECRYPT_USER_DATA = 6 ' protection check + the dongle will decrypt user data
|
||||
Public Const FAST_PRESENCE_CHECK = 7 ' checks for the presence of the correct dongle only with minimal security, no flags allowed
|
||||
Public Const STOP_NET_USER = 8 ' stops a network user (a protection check is NOT performed)
|
||||
|
||||
' Flags
|
||||
Public Const DEC_ONE_EXEC = 1 ' decrement execs by 1
|
||||
Public Const DEC_MANY_EXECS = 2 ' decrement execs by number specified in execs
|
||||
Public Const START_NET_USER = 4 ' starts a network user
|
||||
Public Const USE_FUNCTION_ARGUMENT = 16 ' use the extra argument in the function for pointers
|
||||
Public Const CHECK_LOCAL_FIRST = 32 ' always look in local ports before looking in network ports
|
||||
Public Const CHECK_NETWORK_FIRST = 64 ' always look on the network before looking in local ports
|
||||
Public Const USE_ALT_LICENCE_NAME = 128 ' use name specified in alt_licence_name instead of the default one
|
||||
Public Const DONT_SET_MAXDAYS_EXPIRY = 256 ' if the max days expiry date has not been calculated then do not do it this time
|
||||
Public Const MATCH_DONGLE_NUMBER = 512 ' restrict the search to match the dongle number specified in the DRIS
|
||||
Public Const DONT_RETURN_FD_DRIVE = 1024 ' if an FD dongle has been detected then don't return the flash drive/mount name in the DRIS
|
||||
|
||||
' Useful functions
|
||||
#If VBA7 Then
|
||||
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
|
||||
Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
|
||||
#Else
|
||||
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
|
||||
Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
|
||||
#End If
|
||||
|
||||
' given the maximum possible value generate a random number between 0 and the maximum
|
||||
Public Function Rand(ByVal High As Long) As Long
|
||||
Rand = Int((High + 1) * Rnd)
|
||||
End Function
|
||||
|
||||
' initialise the DRIS with random values
|
||||
Public Sub RandomSet(myDris As DRIS)
|
||||
Dim tempDris(Len(myDris)) As Byte
|
||||
|
||||
Call Randomize
|
||||
Call CopyMemory(tempDris(0), myDris, Len(myDris))
|
||||
|
||||
For i = 0 To Len(myDris) - 1
|
||||
tempDris(i) = Rand(255)
|
||||
Next
|
||||
|
||||
Call CopyMemory(myDris, tempDris(0), Len(myDris))
|
||||
End Sub
|
||||
|
||||
' This function will convert the C string returned in the DRIS to a VB string
|
||||
' e.g. to access the product code use TrimCString(mydris.prodcode)
|
||||
Function TrimCString(s As String) As String
|
||||
Dim i As Integer
|
||||
Dim length As Integer
|
||||
|
||||
length = Len(s)
|
||||
|
||||
For i = 1 To length
|
||||
If Mid(s, i, 1) = Chr(0) Then
|
||||
TrimCString = Left(s, i - 1) ' Take off null and rest of string
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
End Function
|
||||
|
||||
' this function should be used if you want to display the dongle_number. It will always display as a positive value
|
||||
Public Function ConvertToUnsigned(number As Long) As Double
|
||||
If (number >= 0) Then
|
||||
ConvertToUnsigned = number
|
||||
Else
|
||||
ConvertToUnsigned = number + 4294967296#
|
||||
End If
|
||||
End Function
|
||||
@@ -0,0 +1,73 @@
|
||||
Notes for protecting Access Databases with Dinkey Pro/FD
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Before doing anything it is a good idea to make a back-up of your database. It is
|
||||
possible to protect your database so well that you may have trouble accessing
|
||||
it yourself!
|
||||
|
||||
1. For Access 2007 and newer, view your form and then chose design view and view
|
||||
the properties for your form (choose the event tab).
|
||||
|
||||
For versions before Access 2007, open your form in Design View. Now click on
|
||||
View > Properties and choose the "Event" tab.
|
||||
|
||||
2. You should now see the list of events associated with your form. Set the
|
||||
"On Open" entry to "=OpenStartup()". This will cause your database to launch
|
||||
this function when it is first loaded.
|
||||
|
||||
3. For Access 2007 and higher in the Database Tools tab launch the Visual Basic editor.
|
||||
|
||||
4. In the editor, select File > Import File... and choose the file DinkeyPro.bas
|
||||
to add this module to your project.
|
||||
Repeat this step to add DPSample.bas to your project as well.
|
||||
This VBA code will check for the Dinkey Pro/FD Dongle. If a dongle is found your
|
||||
database will continue to load. If a dongle is not found then it will display
|
||||
an error message and your database will not be loaded.
|
||||
|
||||
5. You will need to supply a locked copy of dpwin32.dll with your database. To
|
||||
support 64-bit versions of Access, you will also need to supply a locked dpwin64.dll.
|
||||
These DLLs should be located in the same directory as your database. If the
|
||||
relevant DLL is not found an error will occur. It is recommended that you rename
|
||||
the DLLs with names individual to you. In this case you must also modify the
|
||||
references to dpwin32.dll and dpwin64.dll in DinkeyPro.bas to use the new names.
|
||||
|
||||
If you load your database at this point and dpwin32.dll is found it will
|
||||
return error 413: program not protected.
|
||||
|
||||
6. Lock the DLL(s) using the API method of protection using DinkeyAdd. You can
|
||||
specify the output path to be the folder that contains your database so that
|
||||
the locked DLLs are in the correct location.
|
||||
|
||||
7. You now have to do one more thing. Currently the user could load your
|
||||
database and then remove the call to check the protection and therefore have
|
||||
an unprotected copy. You must stop them doing this by saving your database
|
||||
as an ACCDE file (MDE file for Access prior to 2007). This compiles all the
|
||||
VBA code and stops it from being editable by an end user. You must save a
|
||||
copy of your original database otherwise you will not be able to make any
|
||||
changes either! You will distribute the ACCDE (MDE) file to your customers.
|
||||
|
||||
To save your database as an ACCDE file, choose the Database Tools tab and choose
|
||||
"Make ACCDE". (for versions prior to 2007 choose "Save As" and change the type
|
||||
to a MDE file).
|
||||
|
||||
Note - the VBA code in this sample is the same as the Visual Basic sample code we
|
||||
provide, except that we need to catch whether the DLL is missing or not (VB
|
||||
will terminate the program if the DLL is not found but VBA will display an error
|
||||
but continue to load the database).
|
||||
|
||||
Note - You only need to copy the relevant sample code functions that you need. All
|
||||
comments in your VBA code are visible in your spreadsheet file so be careful
|
||||
what you say! You should remove all our comments.
|
||||
|
||||
Note - Code marked with !!!! are places where you should customise the sample code so
|
||||
that it will work properly:
|
||||
|
||||
* Change the SDSN value from 10101 to the value of your SDSN in the 10 main functions.
|
||||
* Change the MY_PRODCODE value to the Product Code in the dongle
|
||||
* Change the MyAlgorithm code (if you call a user algorithm)
|
||||
* Change the CryptDRIS code (if you encrypt the DRIS)
|
||||
* Change the CryptApiData (if you encrypt Data you send to our API)
|
||||
* Change the MyRWAlgorithm code (if encrypt Data you send to our API using the R/W algorithm)
|
||||
|
||||
You will also probably want to replace our error messages (DisplayError) with your own.
|
||||
|
||||
Reference in New Issue
Block a user