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