826 lines
37 KiB
Fortran
826 lines
37 KiB
Fortran
! dlltest - sample program to call DinkeyPro/FD runtime module (dpwin32.dll)
|
|
!
|
|
! this sample code has been compiled and tested using Intel Fortran XE 2011
|
|
! but should work with earlier versions.
|
|
|
|
! The sample code contains 10 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.
|
|
|
|
!If you are using Dinkey Lite then you can only use 4 functions:
|
|
!ProtCheck, ProtCheckWithAlg, ProtCheckEnc, ProtCheckWithAlgEnc
|
|
|
|
! this file contains 10 protection-check functions.
|
|
! ProtCheck a standard protection check
|
|
! ProtCheckWithAlg a protection check & executing an algorithm
|
|
! 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 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
|
|
|
|
PROGRAM main
|
|
! call the function(s) of your choice here
|
|
! by default I have chosen a standard protection check
|
|
if (ProtCheck() == 0) then
|
|
print *,"It worked!"
|
|
end if
|
|
END PROGRAM main
|
|
|
|
! this module contains the DRIS structure declaration and also declares important constants
|
|
MODULE DinkeyPro
|
|
|
|
integer,parameter :: MY_SDSN = 10101 !!!! change this value to be the value of your SDSN (demo = 10101)
|
|
|
|
! declare dris data type
|
|
!DEC$ PACK:1 ! this needs to be byte aligned
|
|
TYPE DRIS
|
|
sequence
|
|
! the first 4 fields are never encrypted
|
|
character(len=4) :: header ! should be set to 'DRIS'
|
|
! inputs
|
|
integer(4) :: size ! size of this structure
|
|
integer(4) :: seed1 ! seed for data/dris encryption
|
|
integer(4) :: seed2 ! as above
|
|
! (maybe encrypted from now on)
|
|
integer(4) :: function ! specify only one function
|
|
integer(4) :: flags ! options for the function selected. To use more than one OR them together e.g. OR(OPTION1, OPTION2)
|
|
integer(4) :: execs_decrement ! amount by which to dec execs if we use flag: DEC_MANY_EXECS
|
|
integer(4) :: data_crypt_key_num ! number of the key (1-3) that the dongle uses to encrypt or decrypt user data
|
|
integer(4) :: rw_offset ! offset in the dongle data area to read or write data
|
|
integer(4) :: rw_length ! length of data are to read/write/encrypt/decrypt
|
|
!DEC$ IF DEFINED (_M_X64)
|
|
integer(8) :: unused ! pass data by function parameter instead. 8 bytes long for 64-bit Fortran code.
|
|
!DEC$ ELSE
|
|
integer(4) :: unused ! pass data by function parameter instead. 4 bytes long for 32-bit Fortran code.
|
|
!DEC$ ENDIF
|
|
character(len=256) :: alt_licence_name ! protection check for different licence instead of the default one, must be null-terminated
|
|
integer(4) :: var_a ! variable values for user algorithm
|
|
integer(4) :: var_b
|
|
integer(4) :: var_c
|
|
integer(4) :: var_d
|
|
integer(4) :: var_e
|
|
integer(4) :: var_f
|
|
integer(4) :: var_g
|
|
integer(4) :: var_h
|
|
integer(4) :: alg_number ! the number of the user algorithm that you want to execute
|
|
|
|
! outputs
|
|
integer(4) :: ret_code ! return code from the protection check
|
|
integer(4) :: ext_err ! extended error
|
|
integer(4) :: type ! type of dongle detected. 1 = Pro, 2 = FD
|
|
integer(4) :: model ! model of dongle detected. 1= Lite, 2 = Plus, 4 = Net 5, 7 = Net Unlimited
|
|
integer(4) :: sdsn ! Software Developer's Serial Number
|
|
character(len=12) :: prodcode ! Product Code (null-terminated)
|
|
integer(4) :: dongle_number ! NB this should be an unsigned value really
|
|
integer(4) :: update_number
|
|
integer(4) :: data_area_size ! size of the data area used in the dongle detected
|
|
integer(4) :: max_alg_num ! the maximum algorithm number in the dongle detected
|
|
integer(4) :: execs ! executions left: -1 indicates 'no limit'
|
|
integer(4) :: exp_day ! expiry day: -1 indicates 'no limit'
|
|
integer(4) :: exp_month ! expiry month: -1 indicates 'no limit'
|
|
integer(4) :: exp_year ! expiry year: -1 indicates 'no limit'
|
|
integer(4) :: features ! features value
|
|
integer(4) :: net_users ! maximum number of network users for the dongle detected: -1 indicates 'no limit'
|
|
integer(4) :: alg_answer ! answer to the user algorithm executed with the given variable values
|
|
integer(4) :: fd_capacity ! capacity of the data area in FD dongle.
|
|
character(len=128) :: fd_drive ! drive letter of FD dongle detected e.g. 'f:\' (or mount name under Linux)
|
|
integer(4) :: swkey_type ! 0 = no swkey detected, 1 = temporary software key, 2 = demo software key
|
|
integer(4) :: swkey_exp_day ! software key expiry date (if software key detected)
|
|
integer(4) :: swkey_exp_month
|
|
integer(4) :: swkey_exp_year
|
|
END TYPE DRIS
|
|
!DEC$ PACK
|
|
|
|
!DEC$ IF DEFINED (_M_X64)
|
|
integer,parameter :: DRIS_SIZE = 564 ! I am sure there should be a way to get this programatically!
|
|
!DEC$ ELSE
|
|
integer,parameter :: DRIS_SIZE = 560 ! I am sure there should be a way to get this programatically!
|
|
!DEC$ ENDIF
|
|
|
|
! functions - must specify only one
|
|
integer,parameter :: PROTECTION_CHECK = 1 ! checks for dongle, check program params...
|
|
integer,parameter :: EXECUTE_ALGORITHM = 2 ! protection check + calculate answer for specified algorithm with specified inputs
|
|
integer,parameter :: WRITE_DATA_AREA = 3 ! protection check + writes dongle data area
|
|
integer,parameter :: READ_DATA_AREA = 4 ! protection check + reads dongle data area
|
|
integer,parameter :: ENCRYPT_USER_DATA = 5 ! protection check + the dongle will encrypt user data
|
|
integer,parameter :: DECRYPT_USER_DATA = 6 ! protection check + the dongle will decrypt user data
|
|
integer,parameter :: FAST_PRESENCE_CHECK = 7 ! checks for the presence of the correct dongle only with minimal security, no flags allowed.
|
|
integer,parameter :: STOP_NET_USER = 8 ! stops a network user (a protection check is NOT performed)
|
|
|
|
! flags - can specify as many as you like
|
|
integer,parameter :: DEC_ONE_EXEC = 1 ! decrement execs by 1
|
|
integer,parameter :: DEC_MANY_EXECS = 2 ! decrement execs by number specified in execs_decrement
|
|
integer,parameter :: START_NET_USER = 4 ! starts a network user
|
|
integer,parameter :: USE_FUNCTION_ARGUMENT = 16 ! use the extra argument in the function for pointers
|
|
integer,parameter :: CHECK_LOCAL_FIRST = 32 ! always look in local ports before looking in network ports
|
|
integer,parameter :: CHECK_NETWORK_FIRST = 64 ! always look on the network before looking in local ports
|
|
integer,parameter :: USE_ALT_LICENCE_NAME = 128 ! use name specified in alt_licence_name instead of the default one
|
|
integer,parameter :: DONT_SET_MAXDAYS_EXPIRY = 256 ! if the max days expiry date has not been calculated then do not do it this time
|
|
integer,parameter :: MATCH_DONGLE_NUMBER = 512 ! restrict the search to match the dongle number specified in the DRIS
|
|
integer,parameter :: DONT_RETURN_FD_DRIVE = 1024 ! if an FD dongle has been detected then don't return the flash drive/mount name in the DRIS
|
|
|
|
! declare the protection check function in the Dinkey Pro/FD runtime module
|
|
INTERFACE
|
|
FUNCTION DDProtCheck(mydris, mydata)
|
|
!DEC$ ATTRIBUTES STDCALL, DECORATE, ALIAS:'DDProtCheck', DLLIMPORT :: DDProtCheck
|
|
import
|
|
type (DRIS) :: mydris
|
|
!DEC$ ATTRIBUTES REFERENCE :: mydris
|
|
character(len=*) :: mydata
|
|
!DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: mydata
|
|
integer :: DDProtCheck
|
|
END FUNCTION DDProtCheck
|
|
END INTERFACE
|
|
|
|
! this is an instance of the dris. We make an equivalence between the derived-type
|
|
! and a byte_array because for encryption we need to access the memory as a byte array
|
|
type (DRIS) :: mydris
|
|
integer(1), dimension(DRIS_SIZE) :: mydris_byte_array
|
|
equivalence(mydris, mydris_byte_array)
|
|
|
|
END MODULE DinkeyPro
|
|
|
|
! ************************* our 10 functions **********************************
|
|
|
|
! ************************** ProtCheck ***************************************
|
|
FUNCTION ProtCheck()
|
|
use DinkeyPro
|
|
integer :: ret_code
|
|
integer(8) :: display_dongle_number
|
|
|
|
call set_random(mydris_byte_array) ! we have to call this function using the byte array equivalence of the dris type
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
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)
|
|
ProtCheck = ret_code
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
ProtCheck = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
ProtCheck = -1
|
|
return
|
|
end if
|
|
|
|
! sample to show how to display dongle number (this is the only value in the dris that should be an unsigned integer)
|
|
display_dongle_number = mydris%dongle_number
|
|
call ConvertDongleNumber(display_dongle_number)
|
|
print *,"Dongle Check successful. Dongle Number is: ",display_dongle_number
|
|
END FUNCTION ProtCheck
|
|
|
|
! ************************** ProtCheckWithAlg ******************************
|
|
|
|
! !!!! 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 a Dinkey Lite dongle.
|
|
FUNCTION MyAlgorithm(a, b, c, d, e, f, g, h)
|
|
integer :: a,b,c,d,e,f,g,h,MyAlgorithm
|
|
MyAlgorithm = a + b + c + d + e + f + g + h
|
|
return
|
|
END FUNCTION MyAlgorithm
|
|
|
|
! 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 Lite models copy the sample
|
|
! code from DinkeyLook
|
|
FUNCTION ProtCheckWithAlg()
|
|
use DinkeyPro
|
|
integer :: ret_code
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = EXECUTE_ALGORITHM ! standard protection check & execute 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 algorithm 1 (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
|
|
|
|
ret_code = DDProtCheck(mydris, 0)
|
|
ProtCheckWithAlg = ret_code
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
ProtCheckWithAlg = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
ProtCheckWithAlg = -1
|
|
return
|
|
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
|
|
print *,"Dinkey protection error! You have not patched your algorithm in the MyAlgorithm routine"
|
|
ProtCheckWithAlg = -1
|
|
return
|
|
end if
|
|
END FUNCTION ProtCheckWithAlg
|
|
|
|
! ************************** WriteBytes ***************************************
|
|
! This writes the Data "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.
|
|
FUNCTION WriteBytes()
|
|
use DinkeyPro
|
|
integer :: ret_code
|
|
character(len=14) :: WriteData = "Hello, World!"c ! it should be a null-terminated string
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = WRITE_DATA_AREA ! standard protection check and write data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%rw_offset = 7
|
|
mydris%rw_length = len(WriteData)
|
|
|
|
ret_code = DDProtCheck(mydris, WriteData)
|
|
WriteBytes = ret_code
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
WriteBytes = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
WriteBytes = -1
|
|
return
|
|
end if
|
|
END FUNCTION WriteBytes
|
|
|
|
! ************************** ReadBytes ***************************************
|
|
! This reads 14 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 21 bytes long.
|
|
! In order for the data to be displayed properly by this routine it will need to be text data
|
|
FUNCTION ReadBytes()
|
|
use DinkeyPro
|
|
integer :: ret_code
|
|
character(len=14) :: ReadData
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = READ_DATA_AREA ! standard protection check and read data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%rw_offset = 7
|
|
mydris%rw_length = len(ReadData)
|
|
|
|
ret_code = DDProtCheck(mydris, ReadData)
|
|
ReadBytes = ret_code
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
ReadBytes = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
ReadBytes = -1
|
|
return
|
|
end if
|
|
|
|
print *,"Dinkey Dongle Data area, offset 7 is: ",ReadData
|
|
END FUNCTION ReadBytes
|
|
|
|
! ************************** EncryptUserData ***************************************
|
|
! 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
|
|
FUNCTION EncryptUserData()
|
|
use DinkeyPro
|
|
integer :: ret_code
|
|
character(len=14) :: MyData = "Hello, World!"c
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = ENCRYPT_USER_DATA ! standard protection check and encrypt user data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%data_crypt_key_num = 1
|
|
mydris%rw_length = len(MyData)
|
|
|
|
ret_code = DDProtCheck(mydris, MyData)
|
|
EncryptUserData = ret_code
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
! ... could add code to check other elements of the DRIS, e.g. ret_code, sdsn, ...
|
|
|
|
print *,"Encrypted data is: ",MyData
|
|
|
|
! Now decrypt the same data to get the original values
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = DECRYPT_USER_DATA ! standard protection check and decrypt user data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%data_crypt_key_num = 1
|
|
mydris%rw_length = len(MyData)
|
|
|
|
ret_code = DDProtCheck(mydris, MyData)
|
|
EncryptUserData = ret_code
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
EncryptUserData = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
EncryptUserData = -1
|
|
return
|
|
end if
|
|
|
|
print *,"Decrypted data is: ",MyData
|
|
END FUNCTION EncryptUserData
|
|
|
|
! !!!!!!!!!!! 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
|
|
FUNCTION MyRWAlgorithm(a, b, c, d, e, f, g, h)
|
|
integer :: a,b,c,d,e,f,g,h,MyRWAlgorithm
|
|
MyRWAlgorithm = IEOR(IEOR(IEOR(IEOR(IEOR(a,b),c),d),e),f)
|
|
return
|
|
END FUNCTION MyRWAlgorithm
|
|
|
|
! !!!! please patch the 3 parameters specified below with the 3 parameters specified in DinkeyAdd
|
|
SUBROUTINE CryptDRIS(dris_byte_array)
|
|
use DinkeyPro
|
|
integer(1), dimension(DRIS_SIZE) :: dris_byte_array
|
|
integer :: i,j,k,temp,t
|
|
integer, dimension(256) :: bigseed,S
|
|
|
|
do i=1,256
|
|
bigseed(i) = dris_byte_array(9 + modulo(i-1,8)) ! this takes the values from seed1, seed2 directly
|
|
end do
|
|
|
|
do i=1,256
|
|
S(i) = i-1
|
|
end do
|
|
|
|
j = 0
|
|
do i=1,256
|
|
j = IAND(j + S(i) + bigseed(i) + 123, 255) ! first parameter patched here
|
|
temp = S(i)
|
|
S(i) = S(j+1)
|
|
S(j+1) = temp
|
|
end do
|
|
|
|
i = 0
|
|
j = 0
|
|
do k=17,DRIS_SIZE
|
|
i = IAND(i + 1, 255)
|
|
j = IAND(j + S(i+1) + 212, 255) ! second parameter patched here
|
|
temp = S(i+1)
|
|
S(i+1) = S(j+1)
|
|
S(j+1) = temp
|
|
t = IAND(S(i+1) + S(j+1) + 97,255) ! third parameter patched here
|
|
dris_byte_array(k) = IEOR(dris_byte_array(k),S(t+1))
|
|
end do
|
|
return
|
|
END SUBROUTINE CryptDRIS
|
|
|
|
! !!!! please patch the 3 parameters specified below with the 3 parameters specified in DinkeyAdd
|
|
! if you are using the r/w algorithm then there is no need to change this function
|
|
! NB we pass the whole of the DRIS but we only need it for seed1 and seed2 values
|
|
SUBROUTINE CryptApiData(mydata, length, dris_byte_array, alg_answer)
|
|
use DinkeyPro
|
|
integer :: length, alg_answer, seed1, seed2
|
|
integer(1), dimension(length) :: mydata
|
|
integer(1), dimension(DRIS_SIZE) :: dris_byte_array
|
|
integer :: i,j,k,temp,t
|
|
integer, dimension(256) :: bigseed,S
|
|
|
|
do i=1,256
|
|
bigseed(i) = dris_byte_array(9 + modulo(i-1,8)) ! this takes the values from seed1, seed2 directly
|
|
end do
|
|
|
|
do i=1,256
|
|
S(i) = i-1
|
|
end do
|
|
|
|
j = 0
|
|
do i=1,256
|
|
j = IAND(j + S(i) + bigseed(i) + IAND(alg_answer, 255), 255) ! first parameter patched here
|
|
temp = S(i)
|
|
S(i) = S(j+1)
|
|
S(j+1) = temp
|
|
end do
|
|
|
|
i = 0
|
|
j = 0
|
|
do k=1,length
|
|
i = IAND(i + 1, 255)
|
|
j = IAND(j + S(i+1) + IAND(ISHFT(alg_answer, -8),255), 255) ! second parameter patched here
|
|
temp = S(i+1)
|
|
S(i+1) = S(j+1)
|
|
S(j+1) = temp
|
|
t = IAND(S(i+1) + S(j+1) + IAND(ISHFT(alg_answer, -16),255),255) ! third parameter patched here
|
|
mydata(k) = IEOR(mydata(k),S(t+1))
|
|
end do
|
|
return
|
|
END SUBROUTINE CryptApiData
|
|
|
|
! ************************** ProtCheckEnc ***************************************
|
|
! We encrypt the DRIS passed to the API. Patch the CryptDRIS function in this file from source code generated by DinkeyAdd.
|
|
FUNCTION ProtCheckEnc()
|
|
use DinkeyPro
|
|
integer :: ret_code
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
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_byte_array) ! encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
ret_code = DDProtCheck(mydris, 0)
|
|
ProtCheckEnc = ret_code
|
|
|
|
call CryptDRIS(mydris_byte_array) ! decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
ProtCheckEnc = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
ProtCheckEnc = -1
|
|
return
|
|
end if
|
|
END FUNCTION ProtCheckEnc
|
|
|
|
! ************************** ProtCheckWithAlgEnc ******************************
|
|
! 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 Lite models copy the sample
|
|
! code 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()
|
|
use DinkeyPro
|
|
integer :: ret_code
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = EXECUTE_ALGORITHM ! standard protection check & execute 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 algorithm 1 (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_byte_array) ! encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
ret_code = DDProtCheck(mydris, 0)
|
|
ProtCheckWithAlgEnc = ret_code
|
|
|
|
call CryptDRIS(mydris_byte_array) ! decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
ProtCheckWithAlgEnc = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
ProtCheckWithAlgEnc = -1
|
|
return
|
|
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
|
|
print *,"Dinkey protection error! You have not patched your algorithm in the MyAlgorithm routine"
|
|
ProtCheckWithAlgEnc = -1
|
|
return
|
|
end if
|
|
END FUNCTION ProtCheckWithAlgEnc
|
|
|
|
! ************************** WriteBytesEnc ***************************************
|
|
! This writes the Data "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.
|
|
! 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 WriteBytesEnc()
|
|
use DinkeyPro
|
|
integer :: ret_code,alg_ans
|
|
character(len=14) :: WriteData = "Hello, World!"c
|
|
integer(1), dimension(14) :: WriteDataByteArray
|
|
equivalence(WriteData, WriteDataByteArray) ! to encrypt it we need to pass it as a byte array
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = WRITE_DATA_AREA ! standard protection check and write data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%rw_offset = 7
|
|
mydris%rw_length = len(WriteData)
|
|
|
|
! 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(WriteDataByteArray, len(WriteData), mydris_byte_array, alg_ans);
|
|
|
|
call CryptDRIS(mydris_byte_array) ! encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
ret_code = DDProtCheck(mydris, WriteData)
|
|
WriteBytesEnc = ret_code
|
|
|
|
call CryptDRIS(mydris_byte_array) ! decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
WriteBytesEnc = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
WriteBytesEnc = -1
|
|
return
|
|
end if
|
|
END FUNCTION WriteBytesEnc
|
|
|
|
! ************************** ReadBytesEnc ***************************************
|
|
! This reads 14 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 21 bytes long.
|
|
! In order for the data to be displayed properly by this routine it will need to be text data
|
|
! 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 ReadBytesEnc()
|
|
use DinkeyPro
|
|
integer :: ret_code,alg_ans
|
|
character(len=14) :: ReadData
|
|
integer(1), dimension(14) :: ReadDataByteArray
|
|
equivalence(ReadData, ReadDataByteArray) ! to encrypt it we need to pass it as a byte array
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = READ_DATA_AREA ! standard protection check and read data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%rw_offset = 7
|
|
mydris%rw_length = len(ReadData)
|
|
|
|
! 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_byte_array) ! encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
ret_code = DDProtCheck(mydris, ReadData)
|
|
ReadBytesEnc = ret_code
|
|
|
|
call CryptDRIS(mydris_byte_array) ! decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
ReadBytesEnc = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
ReadBytesEnc = -1
|
|
return
|
|
end if
|
|
|
|
! decrypt data we have just read.
|
|
call CryptApiData(ReadDataByteArray, len(ReadData), mydris_byte_array, alg_ans);
|
|
print *,"Dinkey Dongle Data area, offset 7 is: ",ReadData
|
|
END FUNCTION ReadBytesEnc
|
|
|
|
! ************************** EncryptUserDataEnc ***************************************
|
|
! 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
|
|
! 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()
|
|
use DinkeyPro
|
|
integer :: ret_code,alg_ans
|
|
character(len=14) :: MyData = "Hello, World!"c
|
|
integer(1), dimension(14) :: MyDataByteArray
|
|
equivalence(MyData, MyDataByteArray) ! to encrypt it we need to pass it as a byte array
|
|
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = ENCRYPT_USER_DATA ! standard protection check and encrypt user data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%data_crypt_key_num = 1
|
|
mydris%rw_length = len(MyData)
|
|
|
|
! 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(MyDataByteArray, len(MyData), mydris_byte_array, alg_ans);
|
|
|
|
call CryptDRIS(mydris_byte_array) ! encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
ret_code = DDProtCheck(mydris, MyData)
|
|
EncryptUserDataEnc = ret_code
|
|
|
|
call CryptDRIS(mydris_byte_array) ! decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
! ... could add code to check other elements of the DRIS, e.g. ret_code, sdsn, ...
|
|
|
|
print *,"Encrypted data is: ",MyData
|
|
|
|
! Now decrypt the same data to get the original values
|
|
call set_random(mydris_byte_array)
|
|
mydris%header = 'DRIS'
|
|
mydris%size = DRIS_SIZE
|
|
mydris%function = DECRYPT_USER_DATA ! standard protection check and decrypt user data
|
|
mydris%flags = USE_FUNCTION_ARGUMENT ! this way we don't need to worry about pointers in the DRIS
|
|
mydris%data_crypt_key_num = 1
|
|
mydris%rw_length = len(MyData)
|
|
|
|
call CryptDRIS(mydris_byte_array) ! encrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
ret_code = DDProtCheck(mydris, MyData)
|
|
EncryptUserDataEnc = ret_code
|
|
|
|
call CryptDRIS(mydris_byte_array) ! decrypt DRIS (!!!!you should separate from DDProtCheck for greater security)
|
|
|
|
if (ret_code /= 0) then
|
|
call DisplayError(ret_code, mydris%ext_err) ! display messages for any errors that have occurred
|
|
return
|
|
end if
|
|
|
|
if (mydris%sdsn /= MY_SDSN) then
|
|
print *,"Incorrect SDSN! Please modify your source code so that MY_SDSN is set to be your SDSN."
|
|
EncryptUserDataEnc = -1
|
|
return
|
|
end if
|
|
|
|
! later on in your program you can check the return code again
|
|
if (mydris%ret_code /= 0) then
|
|
print *,"Dinkey Dongle protection error."
|
|
EncryptUserDataEnc = -1
|
|
return
|
|
end if
|
|
|
|
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 that was passed to us by the API.
|
|
call CryptApiData(MyDataByteArray, len(MyData), mydris_byte_array, alg_ans);
|
|
print *,"Decrypted data is: ",MyData
|
|
END FUNCTION EncryptUserDataEnc
|
|
|
|
! ************************** useful subroutines *******************************
|
|
! subroutine to randomise each element of the DRIS (expects you to pass the DRIS as a byte array
|
|
SUBROUTINE set_random(dris_byte_array)
|
|
use DinkeyPro
|
|
integer(1), dimension(DRIS_SIZE) :: dris_byte_array
|
|
real,dimension(DRIS_SIZE) :: temp
|
|
|
|
call random_seed()
|
|
call random_number(temp)
|
|
do i=1,DRIS_SIZE
|
|
dris_byte_array(i) = temp(i)*256
|
|
end do
|
|
return
|
|
END SUBROUTINE set_random
|
|
|
|
! subroutine to convert an unsigned integer (stored as a signed integer) to the correct unsigned value (for display purposes)
|
|
! e.g. the dongle_number value in the dris - should be an unsigned integer but Fortran 90 does not support them
|
|
SUBROUTINE ConvertDongleNumber(value)
|
|
integer(8) :: value
|
|
|
|
if (value < 0) then
|
|
value = value + 4294967296 ! make the -ve value a +ve value
|
|
end if
|
|
return
|
|
END SUBROUTINE ConvertDongleNumber
|
|
|
|
! displays messages for the most common errors. You will want to change this for your code
|
|
SUBROUTINE DisplayError(ret_code, extended_error)
|
|
integer :: ret_code, extended_error
|
|
|
|
select case (ret_code)
|
|
case (401)
|
|
print *,"Error! No dongles detected!"
|
|
case (403)
|
|
print *,"Error! The dongle detected has a different type to the one specified in DinkeyAdd."
|
|
case (404)
|
|
print *,"Error! The dongle detected has a different model to those specified in DinkeyAdd."
|
|
case (409)
|
|
print *,"Error! The dongle detected has not been programmed by DinkeyAdd."
|
|
case (410)
|
|
print *,"Error! The dongle detected has a different Product Code to the one specified in DinkeyAdd."
|
|
case (411)
|
|
print *,"Error! The dongle detected does not contain the licence associated with this program."
|
|
case (413)
|
|
print *,"Error! This program has not been protected by DinkeyAdd. For guidance please read the DinkeyAdd chapter of the Dinkey manual."
|
|
case (417)
|
|
print *,"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."
|
|
case (423)
|
|
print *,"Error! The number of network users has been exceeded."
|
|
case (435)
|
|
print *,"Error! DinkeyServer has not been detected on the network."
|
|
case (922)
|
|
print *,"Error! The Software Key has expired."
|
|
case default
|
|
print *,"An error occurred checking the dongle. Error: ", ret_code, " Extended Error: ", extended_error
|
|
end select
|
|
return
|
|
END SUBROUTINE DisplayError |