' 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