' !! this file should not be modified

Imports System.Runtime.InteropServices
Imports System.Text

Module dris_code

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi, Pack:=1)> _
     Structure DRIS
        ' the first 4 fields are never encrypted
        Dim header1 As Byte                 ' should be set to 'DRIS'
        Dim header2 As Byte
        Dim header3 As Byte
        Dim header4 As Byte
        ' inputs
        Dim size As Integer                 ' size of this structure
        Dim seed1 As Integer                ' seed for data/dris encryption
        Dim seed2 As Integer                ' as above
        ' (maybe encrypted from now on)
        Dim myfunction As Integer           ' specify only one function
        Dim flags As Integer                ' options for the function selected. To use more than one OR them together: OPTION1 Or OPTION2...
        Dim execs_decrement As UInt32       ' amount by which to dec execs if we use flag: DEC_MANY_EXECS
        Dim data_crypt_key_num As Integer   ' number of the key (1-3) that the dongle uses to encrypt or decrypt user data
        Dim rw_offset As Integer            ' offset in the dongle data area to read or write data
        Dim rw_length As Integer            ' length of data are to read/write/encrypt/decrypt
        Dim DoNotUse As IntPtr              ' do not use the rw_data_ptr element use the "Data" argument of the DDProtCheck function
        ' to set this field use the function SetAltLicenceName instead
        <VBFixedArray(256), MarshalAs(UnmanagedType.ByValArray, SizeConst:=256)> Dim _alt_licence_name As Byte()
        Dim var_a As Integer                ' variable values for user algorithm
        Dim var_b As Integer
        Dim var_c As Integer
        Dim var_d As Integer
        Dim var_e As Integer
        Dim var_f As Integer
        Dim var_g As Integer
        Dim var_h As Integer
        Dim alg_number As Integer           ' the number of the user algorithm that you want to execute
        ' outputs
        Dim ret_code As Integer             ' return code from the protection check
        Dim ext_err As Integer              ' extended error
        Dim type As Integer                 ' type of dongle detected. 1 = Pro, 2 = FD
        Dim model As Integer                ' model of dongle detected. 1 = Lite, 2 = Plus, 4 = Net 5, 7 = Net Unlimited
        Dim sdsn As Integer                 ' Software Developer's Serial Number
        'to read this field use the function GetProductCode instead
        <VBFixedArray(12), MarshalAs(UnmanagedType.ByValArray, SizeConst:=12)> Dim _prodcode As Byte()
        Dim dongle_number As UInt32
        Dim update_number As Integer
        Dim data_area_size As UInt32        ' size of the data area in the dongle detected
        Dim max_alg_num As Integer          ' the maximum algorithm number in the dongle detected
        Dim execs As Integer                ' executions left: -1 indicates 'no limit'
        Dim exp_day As Integer              ' expiry day: -1 indicates 'no limit'
        Dim exp_month As Integer            ' expiry month: -1 indicates 'no limit'
        Dim exp_year As Integer             ' expiry year: -1 indicates 'no limit'
        Dim features As UInt32              ' features value
        Dim net_users As Integer            ' maximum number of network users for the dongle detected: -1 indicates 'mo limit'
        Dim alg_answer As Integer           ' answer to the user algorithm executed with the given variable values
        Dim fd_capacity As UInt32           ' capacity of the data area in FD dongle. Currently fixed at ~10MB but may change in the future.
        'to read this field use the function GetFDDrive instead
        <VBFixedArray(128), MarshalAs(UnmanagedType.ByValArray, SizeConst:=128)> Dim _fd_drive As Byte()
        Dim swkey_type As Integer           ' 0 = no swkey detected, 1 = temporary software key, 2 = demo software key
        Dim swkey_exp_day As Integer        ' software key expiry date (if software key detected)
        Dim swkey_exp_month As Integer
        Dim swkey_exp_year As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi, Pack:=1)> _
     Structure NU_INFO
        <VBFixedString(256), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=256)> _
        Dim LicenceName As String
        <VBFixedString(50), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=50)> _
        Dim UserName As String
        <VBFixedString(256), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=256)> _
        Dim ComputerName As String
        <VBFixedString(16), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=16)> _
        Dim IPAddress As String
    End Structure

    ' functions exported from dpwin32.dll / dpwin32.dll - do 32-bit and 64-bit separately

    ' DDProtCheck
    Declare Function DDProtCheck32 Lib "dpwin32.dll" Alias "DDProtCheck" (ByRef mydris As DRIS, ByVal data() As Byte) As Integer
    Declare Function DDProtCheck64 Lib "dpwin64.dll" Alias "DDProtCheck" (ByRef mydris As DRIS, ByVal data() As Byte) As Integer

    ' DDGetNetUserList
    Declare Ansi Function DDGetNetUserList32 Lib "dpwin32.dll" Alias "DDGetNetUserList" (ByVal licence_name As String, ByRef num_net_users As Integer, _
          ByVal nu_info_bytes() As Byte, ByVal num_info_structs As Integer, ByRef extended_error As Integer) As Integer
    Declare Ansi Function DDGetNetUserList64 Lib "dpwin64.dll" Alias "DDGetNetUserList" (ByVal licence_name As String, ByRef num_net_users As Integer, _
        ByVal nu_info_bytes() As Byte, ByVal num_info_structs As Integer, ByRef extended_error As Integer) As Integer

    ' call the correct dll depending on whether we are running 32-bit or 64-bit code
    Function DDProtCheck(ByRef mydris As DRIS, ByVal data() As Byte) As Integer
        If (IntPtr.Size = 4) Then
            DDProtCheck = DDProtCheck32(mydris, data)
        Else
            DDProtCheck = DDProtCheck64(mydris, data)
        End If
    End Function

    Function DDGetNetUserList(ByVal licence_name As String, ByRef num_net_users As Integer, ByRef nu_info_array() As NU_INFO, ByVal num_info_structs As Integer, ByRef extended_error As Integer) As Integer
        Dim i As Integer
        Dim my_nu_info As New NU_INFO                 ' NB this only exists so we can get the size of the NU_INFO stucture
        Dim nu_info_bytes(num_info_structs * Marshal.SizeOf(my_nu_info)) As Byte
        Dim nu_info_one_struct(Marshal.SizeOf(my_nu_info)) As Byte
        Dim MyGC As GCHandle

        ' call the function and get info as a byte array
        If (IntPtr.Size = 4) Then
            DDGetNetUserList = DDGetNetUserList32(licence_name, num_net_users, nu_info_bytes, num_info_structs, extended_error)
        Else
            DDGetNetUserList = DDGetNetUserList64(licence_name, num_net_users, nu_info_bytes, num_info_structs, extended_error)
        End If

        ' convert byte array to an array of structs
        For i = 0 To num_net_users - 1
            nu_info_array(i) = New NU_INFO
            Array.Copy(nu_info_bytes, i * Marshal.SizeOf(my_nu_info.GetType), nu_info_one_struct, 0, Marshal.SizeOf(my_nu_info.GetType))
            MyGC = GCHandle.Alloc(nu_info_one_struct, GCHandleType.Pinned)
            nu_info_array(i) = Marshal.PtrToStructure(MyGC.AddrOfPinnedObject, my_nu_info.GetType)
            MyGC.Free()
        Next

    End Function

    ' Functions
    Public Const PROTECTION_CHECK As Integer = 1            ' checks for dongle, check program params...
    Public Const EXECUTE_ALGORITHM As Integer = 2           ' protection check + calculate answer for specified algorithm with specified inputs
    Public Const WRITE_DATA_AREA As Integer = 3             ' protection check + writes dongle data area
    Public Const READ_DATA_AREA As Integer = 4              ' protection check + reads dongle data area
    Public Const ENCRYPT_USER_DATA As Integer = 5           ' protection check + the dongle will encrypt user data
    Public Const DECRYPT_USER_DATA As Integer = 6           ' protection check + the dongle will decrypt user data
    Public Const FAST_PRESENCE_CHECK As Integer = 7         ' checks for the presence of the correct dongle only with minimal security, no flags allowed
    Public Const STOP_NET_USER As Integer = 8               ' stops a network user (a protection check is NOT performed)

    ' Flags
    Public Const DEC_ONE_EXEC As Integer = 1                ' decrement execs by 1
    Public Const DEC_MANY_EXECS As Integer = 2              ' decrement execs by number specified in execs
    Public Const START_NET_USER As Integer = 4              ' starts a network user
    Public Const USE_FUNCTION_ARGUMENT As Integer = 16      ' use the extra argument in the function for pointers
    Public Const CHECK_LOCAL_FIRST As Integer = 32          ' always look in local ports before looking in network ports
    Public Const CHECK_NETWORK_FIRST As Integer = 64        ' always look on the network before looking in local ports
    Public Const USE_ALT_LICENCE_NAME As Integer = 128      ' use name specified in alt_licence_name instead of the default one
    Public Const DONT_SET_MAXDAYS_EXPIRY As Integer = 256   ' if the max days expiry date has not been calculated then do not do it this time
    Public Const MATCH_DONGLE_NUMBER As Integer = 512       ' restrict the search to match the dongle number specified in the DRIS
    Public Const DONT_RETURN_FD_DRIVE As Integer = 1024     ' if an FD dongle has been detected then don't return the flash drive/mount name in the DRIS

    Public Const NU_INFO_SIZE As Integer = (256 + 50 + 256 + 16) ' size of NU_INFO structure (for listing network users)

    ' **********************   useful functions for use in sample code  ***************************
    ' use this function to set the alt_licence_name field of the DRIS
    Public Sub SetAltLicenceName(ByVal mydris As DRIS, ByVal altlicencename As String)
        Dim i, num_bytes As Integer
        Dim ascii As New ASCIIEncoding
        Dim temp As Byte()

        temp = ascii.GetBytes(altlicencename)
        num_bytes = ascii.GetByteCount(altlicencename)
        For i = 0 To num_bytes - 1
            mydris._alt_licence_name(i) = temp(i)
        Next
        mydris._alt_licence_name(num_bytes) = 0           'null-terminate string
    End Sub

    ' use this function to read the prodcode field of the DRIS
    Public Function GetProductCode(ByVal mydris As DRIS) As String
        Dim ascii As New ASCIIEncoding
        Dim i As Integer
        For i = 0 To 11
            If mydris._prodcode(i) = 0 Then
                Exit For
            End If
        Next
        Return ascii.GetString(mydris._prodcode, 0, i)
    End Function

    ' use this function to read the fd_drive field of the DRIS
    Public Function GetFDDrive(ByVal mydris As DRIS) As String
        Dim ascii As New ASCIIEncoding
        Dim i As Integer
        For i = 0 To 127
            If mydris._fd_drive(i) = 0 Then
                Exit For
            End If
        Next
        Return ascii.GetString(mydris._fd_drive, 0, i)
    End Function

    ' copies an integer to offset "index" in trhe specified byte array
    Public Sub Set4Bytes(ByVal data() As Byte, ByVal index As Integer, ByVal value As Integer)
        Dim MyGC As GCHandle = GCHandle.Alloc(value, GCHandleType.Pinned)
        Dim AddressOfValue As IntPtr = MyGC.AddrOfPinnedObject()
        Marshal.Copy(AddressOfValue, data, index, 4)
        MyGC.Free()
    End Sub

    ' converts to DRIS structure to a byte array (so we can do encryption)
    Public Sub DrisToByteArray(ByVal mydris As DRIS, ByVal data() As Byte)
        Dim MyGC As GCHandle = GCHandle.Alloc(data, GCHandleType.Pinned)
        Marshal.StructureToPtr(mydris, MyGC.AddrOfPinnedObject, False)
        MyGC.Free()
    End Sub

    ' converts a byte array to the DRIS structure (so we can do encryption)
    Public Sub ByteArrayToDris(ByVal data() As Byte, ByRef mydris As DRIS)
        Dim MyGC As GCHandle = GCHandle.Alloc(data, GCHandleType.Pinned)
        mydris = Marshal.PtrToStructure(MyGC.AddrOfPinnedObject, mydris.GetType)
        MyGC.Free()
    End Sub

    ' initialise the DRIS with random values
    Public Sub RandomSet(ByRef mydris As DRIS)
        Dim temp_dris(Marshal.SizeOf(mydris) - 1) As Byte
        Dim rnd As New Random

        rnd.NextBytes(temp_dris)
        ByteArrayToDris(temp_dris, mydris)
    End Sub

End Module