j.foucher/PS_Dinkey
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add Original SDK

Browse Source
This commit is contained in:
j.foucher
2026-05-06 07:47:36 +02:00
parent 2915e04380
commit 0ed627517a
674 changed files with 89334 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
Dinkey Pro 7.6.1/$DOCUMENTS/Dinkey Pro 7.6.1 Examples/Samples/Visual Basic/Runtime/DllTest.vbp Normal file
View File

@@ -0,0 +1,35 @@
Type=Exe
Form=Form1.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\system32\stdole2.tlb#OLE Automation
Module=Module1; dris.bas
IconForm="Form1"
Startup="Form1"
ExeName32="DllTest.exe"
Command32=""
Name="DllTest"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microcosm Ltd"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

2
Dinkey Pro 7.6.1/$DOCUMENTS/Dinkey Pro 7.6.1 Examples/Samples/Visual Basic/Runtime/DllTest.vbw Normal file
View File

@@ -0,0 +1,2 @@
Form1 = 243, 27, 938, 801, , 22, 22, 577, 462, C
Module1 = 22, 69, 888, 858,

980
Dinkey Pro 7.6.1/$DOCUMENTS/Dinkey Pro 7.6.1 Examples/Samples/Visual Basic/Runtime/Form1.frm Normal file
View File

@@ -0,0 +1,980 @@
VERSION 5.00
Begin VB.Form Form1
Caption = "DllTest"
ClientHeight = 2940
ClientLeft = 60
ClientTop = 345
ClientWidth = 4605
LinkTopic = "Form1"
ScaleHeight = 2940
ScaleWidth = 4605
StartUpPosition = 3 'Windows Default
Begin VB.Label Label1
Caption = "It Worked!"
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 1080
TabIndex = 0
Top = 840
Width = 2535
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' !! We strongly recommend that you read the "readme.txt" file for this sample.
' !! It contains important instructions on how to use the sample code
' The sample code contains 13 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 13 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
'
' DisplayNetUsers this function displays the current network users (network dongle only)
' If you are using Dinkey Lite then you can only use 4 functions:
' ProtCheck, ProtCheckWithAlg, ProtCheckEnc, ProtCheckWithAlgEnc
' !!!!
Const MY_SDSN = 10101 ' !!!! change this value to be the value of your SDSN (demo = 10101)
Const MY_PRODCODE = "DEMO" ' !!!! change this value to match the Product Code in the dongle
Private Sub Form_Load()
' call the function(s) of your choice here
' here I have chosen a standard protection check
If ProtCheck() <> 0 Then
End 'terminate
End If
End Sub
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
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
'to access product code you will need to use the TrimCString function like this:
'TrimCString(mydris.prodcode)
'to access the dongle number you will need to use the ConvertToUnsigned function like this:
'ConvertToUnsigned(mydris.dongle_number)
' NB if you are using a network dongle and you want to list the network users then use this function:
' DisplayNetUsers (mydris.net_users, mydris.model)
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
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
' decrypt data we have just read
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
' This function displays the current network users (for DinkeyNet only).
' The DDProtCheck function must be called before this function is called.
' (Normally you would use DinkeyServer to view the network users but this enables you to do it from the client if you want)
Function DisplayNetUsers(net_users As Integer, model As Integer) As Integer
Dim num_net_users, extended_error, ret_code, i, max_net_users As Long
Dim DisplayString As String
Dim nu_info_bytes As LargeFixedByteArray ' !!!! only contains space for info for up to 20 net users. If you want more then you must change the type definition
If net_users = -1 Then
max_net_users = 20 ' if unlimited network users are allowed then display up to 20 users (for example, to change this limit see note above)
Else
max_net_users = net_users
End If
If max_net_users = 0 Then ' no network users are allowed, so nothing to do!
DisplayNetUsers = 0
Exit Function
End If
If model < 3 Then
MsgBox "A network dongle has not been detected. Therefore you cannot display the network users.", vbOKOnly
DisplayNetUsers = -1
Exit Function
End If
' now get net users
ret_code = DDGetNetUserList("", num_net_users, nu_info_bytes, max_net_users, extended_error)
If ret_code <> 0 Then
MsgBox "Error " + Str$(ret_code) + "/" + Str$(extended_error) + " finding network user information.", vbOKOnly
Else
DisplayString = "number of net users: " + Str(num_net_users) + vbNewLine
For i = 0 To num_net_users - 1
DisplayString = DisplayString + Str$(i + 1) + ". licence: " + GetLicenceName(nu_info_bytes, i) + ", user: " + GetUserName(nu_info_bytes, i) + ", computer: " + GetComputerName(nu_info_bytes, i) + ", ip address: " + GetIpAddress(nu_info_bytes, i) + vbNewLine
Next
MsgBox DisplayString, vbOKOnly, "Net Users"
End If
DisplayNetUsers = ret_code
End Function
' look at the error code and try to display an appropriate message
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

64
Dinkey Pro 7.6.1/$DOCUMENTS/Dinkey Pro 7.6.1 Examples/Samples/Visual Basic/Runtime/README.txt Normal file
View File

@@ -0,0 +1,64 @@
DllTest - sample code to call dpwin32.dll in Visual Basic
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This project is written in Visual Basic 6.0 but will the code will also
work in version 5.0 (but you will have to create your own project).
For VB.net code please look in the vb.net folder.
The source files in the project are:
File name Folder Description
Form1.frm Samples\vb main source code file for VB
dris.bas Samples\vb contains the DRIS structure & function declarations
The idea is to include the dris.bas file in your project and use/modify which ever
functions from form1.frm you feel are appropriate.
The sample code contains 13 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.
Code marked with !!!! are places where you should customise the sample code so
that it will work properly:
* Change the MY_SDSN value to the value of your SDSN
* Change the MY_PRODCODE value to the Product Code in the dongle
* Change the MyAlgorithm code (if you call a user algorithm)
* Change the CryptDRIS code (if you encrypt the DRIS)
* Change the CryptApiData (if you encrypt Data you send to our API)
* Change the MyRWAlgorithm code (if encrypt Data you send to our API using the R/W algorithm)
You will also probably want to replace our error messages with your own.
Note - you should protect dpwin32.dll and not your program. Because your program
is linked to the DLL it is protected.
Note - to run the project from the IDE you will need to place the protected
dpwin32.dll in the 32-bit Windows System folder*. For release you can place
dpwin32.dll in the folder of the compiled executable or in the Windows System folder.
The former is generally considered better as it is easier to install.
It is also recommended that you rename dpwin32.dll to a name of your choice. In
this case you will need to modify the dll name in the dris.bas file.
Special Note for using Algorithms in Visual Basic
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The algorithms are calculated on 32-bit integers (Long in VB). It is quite possible for
the MyAlgorithm and MyRWAlgorithm functions to overflow if the values provided are too big.
In the dongle the algorithms can never overflow - if the answer is too big then the high part
of the answer is ignored. In practical terms:
When you are using the r/w algorithm it is best not to pass random 32-bit integers. It is
better to restrict the variables to 24-bit to avoid the possibility of overflows.
When using a user algorithm it will behave exactly as the corresponding MyAlgorithm function
will in VB except it will not give overflow errors.
~~~~~~~~~~~~~~~~~
* Windows System folder for 32-bit dlls is:
c:\windows\system32 32-bit Windows
c:\windows\sysWOW64 64-bit Windows

214
Dinkey Pro 7.6.1/$DOCUMENTS/Dinkey Pro 7.6.1 Examples/Samples/Visual Basic/Runtime/dris.bas Normal file
View File

@@ -0,0 +1,214 @@
' !! this file should not be modified
Attribute VB_Name = "Module1"
' API functions
' DDProtCheck - so we can ignore the second argument
Declare Function DDProtCheck Lib "dpwin32.dll" (mydris As DRIS, data As String) As Long
' DDProtCheckString - so we can pass data as a String
Declare Function DDProtCheckString Lib "dpwin32.dll" Alias "DDProtCheck" (mydris As DRIS, ByVal String1 As Any) As Long
' DDProtCheckData - so we can pass data in any format
Declare Function DDProtCheckData Lib "dpwin32.dll" Alias "DDProtCheck" (mydris As DRIS, data As FixedByteArray) As Long
' DDGetNetUserList
Declare Function DDGetNetUserList Lib "dpwin32.dll" (ByVal licence_name As Any, num_net_users As Long, nu_info_bytes As LargeFixedByteArray, ByVal num_info_structs As Long, extended_error As Long) As Long
'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
' (maybe encrypted from now on)
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
not_used As Long ' pass the data as a parameter instead for VB
alt_licence_name As String * 256 ' protection check for different licence instead of the default 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 positive value using ConvertToUnsigned 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.
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
'this is a similar structure that can be used for the DDGetNetUserList call.
'!!!! this structure will acommodate info for upto 20 net users. If you want to alow for more then increase the array size
Public Const NU_INFO_SIZE = (256 + 50 + 256 + 16)
Type LargeFixedByteArray
data(0 To NU_INFO_SIZE * 20) 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
Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
' 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 temp_dris(Len(mydris)) As Byte
Randomize
Call CopyMemory(temp_dris(0), mydris, Len(mydris))
For i = 0 To Len(mydris) - 1
temp_dris(i) = Rand(255)
Next
Call CopyMemory(mydris, temp_dris(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)
Public Function TrimCString(Str As String) As String
Dim i As Integer
Dim length As Integer
length = Len(Str)
For i = 1 To length
If Mid(Str, i, 1) = Chr$(0) Then
TrimCString = Left$(Str, 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
' routine to extract Licence Name from array of NU_INFO structures (implemented as a LargeFixedByteArray)
Public Function GetLicenceName(nu_info_bytes As LargeFixedByteArray, ByVal index As Long) As String
Dim data As Byte ' this will be a byte of data from array
Dim start As Long
start = (index * NU_INFO_SIZE) + 0
GetLicenceName = ""
For i = 0 To 255
data = nu_info_bytes.data(start + i)
If data = 0 Then ' stop when we get to the null
Exit For
Else ' otherwise append character to string
GetLicenceName = GetLicenceName & Chr(data)
End If
Next
End Function
' routine to extract User Name from array of NU_INFO structures (implemented as a LargeFixedByteArray)
Public Function GetUserName(nu_info_bytes As LargeFixedByteArray, ByVal index As Long) As String
Dim data As Byte ' this will be a byte of data from array
Dim start As Long
start = (index * NU_INFO_SIZE) + 256
GetUserName = ""
For i = 0 To 49
data = nu_info_bytes.data(start + i)
If data = 0 Then ' stop when we get to the null
Exit For
Else ' otherwise append character to string
GetUserName = GetUserName & Chr(data)
End If
Next
End Function
' routine to extract Computer Name from array of NU_INFO structures (implemented as a LargeFixedByteArray)
Public Function GetComputerName(nu_info_bytes As LargeFixedByteArray, ByVal index As Long) As String
Dim data As Byte ' this will be a byte of data from array
Dim start As Long
start = (index * NU_INFO_SIZE) + 256 + 50
GetComputerName = ""
For i = 0 To 255
data = nu_info_bytes.data(start + i)
If data = 0 Then ' stop when we get to the null
Exit For
Else ' otherwise append character to string
GetComputerName = GetComputerName & Chr(data)
End If
Next
End Function
' routine to extract ipAddress from array of NU_INFO structures (implemented as a LargeFixedByteArray)
Public Function GetIpAddress(nu_info_bytes As LargeFixedByteArray, ByVal index As Long) As String
Dim data As Byte ' this will be a byte of data from array
Dim start As Long
start = (index * NU_INFO_SIZE) + 256 + 50 + 256
GetIpAddress = ""
For i = 0 To 15
data = nu_info_bytes.data(start + i)
If data = 0 Then ' stop when we get to the null
Exit For
Else ' otherwise append character to string
GetIpAddress = GetIpAddress & Chr(data)
End If
Next
End Function