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
|
||||
Reference in New Issue
Block a user