Add Original SDK
This commit is contained in:
@@ -0,0 +1,98 @@
|
||||
' !! this file should not be modified
|
||||
|
||||
Attribute VB_Name = "Module1"
|
||||
' API functions
|
||||
Declare Function DCGetInfo Lib "DinkeyChange.dll" (ByVal type_mask As Long, ByVal model_mask As Long, ByVal prodcode_mask As Any, ByVal array_length As Long, _
|
||||
num_found As Long, type_array As FixedIntegerArray, model_array As FixedIntegerArray, prodcode_array As FixedByteArray, dongle_number_array As FixedIntegerArray, update_number_array As FixedIntegerArray) As Long
|
||||
Declare Function DCGetDiagnosticInfo Lib "DinkeyChange.dll" (ByVal DiagFileName As Any) As Long
|
||||
Declare Function DCDoUpdateCodeString Lib "DinkeyChange.dll" (ByVal UpdateCode As Any, confirmation_code As Long, extended_error As Long) As Long
|
||||
Declare Function DCDoUpdateCodeFromFile Lib "DinkeyChange.dll" (ByVal UpdateCodeFile As Any, confirmation_code As Long, extended_error As Long) As Long
|
||||
Declare Function DCRestoreDinkeyFDLite Lib "DinkeyChange.dll" () As Long
|
||||
Declare Function DCGetMachineID Lib "DinkeyChange.dll" (machineID As Long, extended_error As Long) As Long
|
||||
Declare Function DCDownloadTempSoftwareKey Lib "DinkeyChange.dll" (ByVal machineID As Long, extended_error As Long) As Long
|
||||
Declare Function DCDownloadDemoSoftwareKey Lib "DinkeyChange.dll" (ByVal machineID As Long, ByVal ProdCode As Any, ByVal model As Long, extended_error As Long) As Long
|
||||
|
||||
' maximum number of USB dongles that can be attached to a machine at any one time
|
||||
Public Const MAX_USB_DEVICES = 128
|
||||
|
||||
' mask values
|
||||
Public Const TYPE_MASK_PRO = 1
|
||||
Public Const TYPE_MASK_FD = 2
|
||||
Public Const TYPE_MASK_ALL = (TYPE_MASK_PRO Or TYPE_MASK_FD)
|
||||
|
||||
Public Const MODEL_MASK_LITE = 1
|
||||
Public Const MODEL_MASK_PLUS = 2
|
||||
Public Const MODEL_MASK_NET = 4
|
||||
Public Const MODEL_MASK_ALL = (MODEL_MASK_LITE Or MODEL_MASK_PLUS Or MODEL_MASK_NET)
|
||||
Public Const MODEL_MASK_DEFAULT = (MODEL_MASK_PLUS Or MODEL_MASK_NET)
|
||||
|
||||
' type values for DCGetInfo (returned in the array)
|
||||
Public Const TYPE_PRO = 1
|
||||
Public Const TYPE_FD = 2
|
||||
|
||||
' model values for DCGetInfo (returned in the array)
|
||||
Public Const MODEL_LITE = 1
|
||||
Public Const MODEL_PLUS = 2
|
||||
Public Const MODEL_NET5 = 4
|
||||
Public Const MODEL_NETU = 7
|
||||
|
||||
' model values for DCDownloadDemoSoftwareKey
|
||||
Public Const SWKEY_MODEL_DEFAULT = &HFFFFFFFF ' NB this assumes that the Demo Software Key Template was created with only one valid dongle model
|
||||
Public Const SWKEY_MODEL_PRO_LITE = 0
|
||||
Public Const SWKEY_MODEL_PRO_PLUS = 1
|
||||
Public Const SWKEY_MODEL_PRO_NET = 2
|
||||
Public Const SWKEY_MODEL_FD_LITE = 3
|
||||
Public Const SWKEY_MODEL_FD_PLUS = 4
|
||||
Public Const SWKEY_MODEL_FD_NET = 5
|
||||
|
||||
'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 MAX_USB_DEVICES * 9) As Byte ' 9 is the prodcode length (including terminating null)
|
||||
End Type
|
||||
|
||||
' and ints
|
||||
Type FixedIntegerArray
|
||||
data(1 To MAX_USB_DEVICES) As Long
|
||||
End Type
|
||||
|
||||
' this function converts an unsigned integer to a double for display purposes (otherwise it may display the dongle number as a negative number!)
|
||||
Public Function UIntToDouble(ByVal number As Long) As Double
|
||||
UIntToDouble = CDbl(number)
|
||||
If UIntToDouble < 0 Then
|
||||
UIntToDouble = UIntToDouble + 2 ^ 32
|
||||
End If
|
||||
End Function
|
||||
|
||||
' this function gets the index-th prodcode from the array
|
||||
Public Function GetProdCodeFromArray(prodcode As FixedByteArray, ByVal index As Long) As String
|
||||
Dim data As Byte ' this will be a byte of data from array
|
||||
|
||||
index = index - 1 ' so it is 0-based
|
||||
GetProdCodeFromArray = ""
|
||||
For i = 0 To 8
|
||||
data = prodcode.data((index * 9) + i)
|
||||
If data = 0 Then ' stop when we get to the null
|
||||
Exit For
|
||||
Else ' otherwise append character to string
|
||||
GetProdCodeFromArray = GetProdCodeFromArray & Chr(data)
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
' this function will convert the C string returned in the DCIS to a VB string
|
||||
' e.g. to access the product code use TrimCString(mydcis.prodcode)
|
||||
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
|
||||
|
||||
@@ -0,0 +1,361 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form ChangeTest
|
||||
Caption = "ChangeTest"
|
||||
ClientHeight = 9705
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5235
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 9705
|
||||
ScaleWidth = 5235
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CommandButton DownloadDemoSoftwareKey
|
||||
Caption = "Download Demo Software Key"
|
||||
Height = 315
|
||||
Left = 960
|
||||
TabIndex = 16
|
||||
Top = 9120
|
||||
Width = 3015
|
||||
End
|
||||
Begin VB.TextBox SwKeyProdCode
|
||||
Height = 375
|
||||
Left = 240
|
||||
TabIndex = 15
|
||||
Top = 8640
|
||||
Width = 4695
|
||||
End
|
||||
Begin VB.TextBox ShowMachineID
|
||||
Height = 375
|
||||
Left = 2640
|
||||
TabIndex = 13
|
||||
Top = 6720
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.CommandButton DownloadTempSoftwareKey
|
||||
Caption = "Download Temporary Software Key"
|
||||
Height = 375
|
||||
Left = 1080
|
||||
TabIndex = 12
|
||||
Top = 7560
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.CommandButton GetMachineID
|
||||
Caption = "Get Machine ID"
|
||||
Height = 375
|
||||
Left = 240
|
||||
TabIndex = 11
|
||||
Top = 6720
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.CommandButton RestoreFDLite
|
||||
Caption = "Restore FD Lite"
|
||||
Height = 375
|
||||
Left = 1080
|
||||
TabIndex = 10
|
||||
Top = 5760
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.CommandButton DoUpdateCodeFile
|
||||
Caption = "Make Changes"
|
||||
Height = 375
|
||||
Left = 1080
|
||||
TabIndex = 9
|
||||
Top = 4920
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.TextBox UpdateCodeFile
|
||||
Height = 405
|
||||
Left = 240
|
||||
TabIndex = 8
|
||||
Top = 4440
|
||||
Width = 4695
|
||||
End
|
||||
Begin VB.CommandButton DoUpdateCodeString
|
||||
Caption = "Make Changes"
|
||||
Height = 375
|
||||
Left = 1080
|
||||
TabIndex = 6
|
||||
Top = 3360
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.TextBox UpdateCodeString
|
||||
Height = 405
|
||||
Left = 240
|
||||
TabIndex = 5
|
||||
Top = 2880
|
||||
Width = 4695
|
||||
End
|
||||
Begin VB.CommandButton WriteDiags
|
||||
Caption = "Write Diagnostics to File"
|
||||
Height = 375
|
||||
Left = 1080
|
||||
TabIndex = 3
|
||||
Top = 1800
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.TextBox DiagFileName
|
||||
Height = 405
|
||||
Left = 240
|
||||
TabIndex = 2
|
||||
Top = 1320
|
||||
Width = 4695
|
||||
End
|
||||
Begin VB.CommandButton GetInfo
|
||||
Caption = "Get Dongle Information"
|
||||
Height = 375
|
||||
Left = 1080
|
||||
TabIndex = 0
|
||||
Top = 360
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.Label Label4
|
||||
Caption = "Demo Software Key Product Code:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 14
|
||||
Top = 8400
|
||||
Width = 4695
|
||||
End
|
||||
Begin VB.Label Label3
|
||||
Caption = "Enter path of Update Code file:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 7
|
||||
Top = 4200
|
||||
Width = 4695
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
Caption = "Enter short Update Code here:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 4
|
||||
Top = 2640
|
||||
Width = 4695
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Caption = "Enter Diagnostic filename:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 1
|
||||
Top = 1080
|
||||
Width = 4695
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "ChangeTest"
|
||||
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
|
||||
|
||||
' Display Dongle Information
|
||||
Private Sub GetInfo_Click()
|
||||
Dim ret_code As Long
|
||||
Dim num_found As Long
|
||||
Dim DisplayString, DongleType, DongleModel, ProdCodeString As String
|
||||
' these are the arrays of dongle information filled-in by DCGetInfo
|
||||
Dim type_array As FixedIntegerArray
|
||||
Dim model_array As FixedIntegerArray
|
||||
Dim prodcode_array As FixedByteArray
|
||||
Dim dongle_number_array As FixedIntegerArray
|
||||
Dim update_number_array As FixedIntegerArray
|
||||
|
||||
' find dongle information for all dongle types, Plus & Net models, for all product codes
|
||||
' NB In practice you will probably want to set the prodcode_mask to the value of your product code
|
||||
ret_code = DCGetInfo(TYPE_MASK_ALL, MODEL_MASK_DEFAULT, "", MAX_USB_DEVICES, num_found, type_array, model_array, prodcode_array, dongle_number_array, update_number_array)
|
||||
|
||||
' check for errors
|
||||
If ret_code = 401 Then
|
||||
MsgBox "No dongles detected matching the search criteria specified", vbOKOnly, "Error"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If ret_code <> 0 Then
|
||||
MsgBox "Error " + Str$(ret_code) + " getting dongle information", vbOKOnly, "Error"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'display dongle details
|
||||
DisplayString = "" ' initialise
|
||||
For i = 1 To num_found
|
||||
If type_array.data(i) = 1 Then ' dongle type
|
||||
DongleType = "Pro"
|
||||
Else
|
||||
DongleType = "FD"
|
||||
End If
|
||||
If model_array.data(i) = 1 Then ' dongle model
|
||||
DongleModel = "Lite"
|
||||
ElseIf model_array.data(i) = 2 Then
|
||||
DongleModel = "Plus"
|
||||
Else
|
||||
DongleModel = "Net"
|
||||
End If
|
||||
ProdCodeString = GetProdCodeFromArray(prodcode_array, i) ' product code
|
||||
' add details for this dongle to list
|
||||
DisplayString = DisplayString + Str$(i) + ". Dinkey " + DongleType + " " + DongleModel + ", product code " + ProdCodeString + " with dongle number " + Str$(UIntToDouble(dongle_number_array.data(i))) + ", update number " + Str$(update_number_array.data(i)) + vbNewLine
|
||||
Next
|
||||
|
||||
MsgBox DisplayString, vbOKOnly
|
||||
|
||||
End Sub
|
||||
|
||||
' Write dongle diagnostics to file
|
||||
Private Sub WriteDiags_Click()
|
||||
Dim ret_code As Long
|
||||
|
||||
ret_code = DCGetDiagnosticInfo(DiagFileName.Text)
|
||||
|
||||
If ret_code = 754 Then
|
||||
MsgBox "Could not create the diagnostic file. Please check that the path exists:" + DiagFileName.Text, vbOKOnly, "Error"
|
||||
Exit Sub
|
||||
ElseIf ret_code <> 0 Then
|
||||
MsgBox "Error " + Str$(ret_code) + " writing diagnostic file.", vbOKOnly, "Error"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' display success
|
||||
MsgBox "Diagnostic file written successfully.", vbOKOnly
|
||||
End Sub
|
||||
|
||||
' update dongle with short code entered
|
||||
Private Sub DoUpdateCodeString_Click()
|
||||
Dim ret_code, confirmation_code, extended_error As Long
|
||||
|
||||
ret_code = DCDoUpdateCodeString(UpdateCodeString.Text, confirmation_code, extended_error)
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, extended_eror)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
MsgBox "Dongle updated successfully!" + vbNewLine + "Confirmation code is: " + Hex(confirmation_code), vbOnly
|
||||
End Sub
|
||||
|
||||
' update dongle using update code in specified file
|
||||
Private Sub DoUpdateCodeFile_Click()
|
||||
Dim ret_code, confirmation_code, extended_error As Long
|
||||
|
||||
ret_code = DCDoUpdateCodeFromFile(UpdateCodeFile.Text, confirmation_code, extended_error)
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, extended_eror)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
MsgBox "Dongle updated successfully!" + vbNewLine + "Confirmation code is: " + Hex(confirmation_code), vbOnly
|
||||
End Sub
|
||||
|
||||
Private Sub RestoreFDLite_Click()
|
||||
Dim ret_code As Long
|
||||
|
||||
ret_code = DCRestoreDinkeyFDLite()
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' display success
|
||||
MsgBox "Dinkey FD Lite dongle restored successfully.", vbOKOnly
|
||||
End Sub
|
||||
|
||||
Private Sub GetMachineID_Click()
|
||||
Dim ret_code, machineID, extended_error As Long
|
||||
|
||||
ret_code = DCGetMachineID(machineID, extended_error)
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' display machine ID in text box
|
||||
ShowMachineID.Text = Hex(machineID)
|
||||
End Sub
|
||||
|
||||
Private Sub DownloadTempSoftwareKey_Click()
|
||||
Dim ret_code, machineID, extended_error As Long
|
||||
|
||||
' first get the machine ID...
|
||||
ret_code = DCGetMachineID(machineID, extended_error)
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' ...then try to download the temporary software key
|
||||
ret_code = DCDownloadTempSoftwareKey(machineID, extended_error)
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
MsgBox "The Temporary Software Key has been downloaded successfully!", vbOnly
|
||||
End Sub
|
||||
|
||||
Private Sub DownloadDemoSoftwareKey_Click()
|
||||
Dim ret_code, machineID, extended_error As Long
|
||||
|
||||
' first get the machine ID...
|
||||
ret_code = DCGetMachineID(machineID, extended_error)
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' ...then try to download the demo software key
|
||||
'(NB we are assuming only one dongle model is set in the Demo Software Template.
|
||||
' If multiple models are set you will also need to specify the exact model)
|
||||
ret_code = DCDownloadDemoSoftwareKey(machineID, SwKeyProdCode.Text, SWKEY_MODEL_DEFAULT, extended_error)
|
||||
|
||||
If ret_code <> 0 Then
|
||||
Call DisplayError(ret_code, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
MsgBox "The Demo Software Key has been downloaded successfully!", vbOnly
|
||||
End Sub
|
||||
|
||||
' look at the error code and try to display an appropriate message
|
||||
Public Sub DisplayError(ByVal ret_code As Long, ByVal extended_error As Long)
|
||||
Select Case ret_code
|
||||
Case 401
|
||||
MsgBox "Error! No dongles detected that meet the search criteria!", vbOKOnly, "Error"
|
||||
Case 409
|
||||
MsgBox "Error! The dongle detected has not been programmed by DinkeyAdd.", vbOKOnly, "Error"
|
||||
Case 758:
|
||||
MsgBox "Error! Cannot open the Update Code file specified.", vbOKOnly, "Error"
|
||||
Case 759:
|
||||
MsgBox "Error! The file specified is not a valid Update Code file.", vbOKOnly, "Error"
|
||||
Case 762, 763, 764
|
||||
MsgBox "Error! Update Code is not in a correct format / update code file is corrupt.", vbOKOnly, "Error"
|
||||
Case 765
|
||||
MsgBox "Error! The Update Code does not match any dongle attached to your machine.", vbOKOnly, "Error"
|
||||
Case 766
|
||||
MsgBox "Error! The update number for this Update Code is too high. You need to first enter an update code that was previously sent to you.", vbOKOnly, "Error"
|
||||
Case 767:
|
||||
MsgBox "Error! You have already entered this Update Code.", vbOKOnly, "Error"
|
||||
Case 1905:
|
||||
MsgBox "Error! There is no Software Key available for download.", vbOKOnly, "Error"
|
||||
Case 1907:
|
||||
MsgBox "Error! The Temporary Software Key has expired. Cannot download it.", vbOKOnly, "Error"
|
||||
Case 1910:
|
||||
MsgBox "Error! The Software Key has already been downloaded.", vbOKOnly, "Error"
|
||||
Case 1921
|
||||
MsgBox "Error! You specified the 'default model' but there is more than one model available. You need to specify a specific dongle model.", vbOKOnly, "Error"
|
||||
Case 1922:
|
||||
MsgBox "Error! The model you requested is not available.", vbOKOnly, "Error"
|
||||
Case 1923:
|
||||
MsgBox "Error! The Demo Software Key Template has been disabled.", vbOKOnly, "Error"
|
||||
Case 1924:
|
||||
MsgBox "Error! You have run out of Demo Software Key activations. You need to order some more.", 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
|
||||
@@ -0,0 +1,35 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation
|
||||
Module=Module1; ChangeTest.bas
|
||||
Form=ChangeTest.frm
|
||||
Startup="ChangeTest"
|
||||
HelpFile=""
|
||||
ExeName32="ChangeTest.exe"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
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
|
||||
@@ -0,0 +1,2 @@
|
||||
Module1 = 525, 283, 1161, 899,
|
||||
ChangeTest = 244, 99, 880, 715, , 66, 66, 702, 841, C
|
||||
@@ -0,0 +1,22 @@
|
||||
ChangeTest - sample code to call DinkeyChange.dll in Visual Basic
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Note: For VB.net code please look in the vb.net folder.
|
||||
|
||||
The sample code contains 7 functions. Just use which ever functions are most
|
||||
appropriate and customise in your own way. The sample code is just a guide.
|
||||
As none of the parameters are sensitive then there is no need to implement
|
||||
strong security in calling DinkeyChange.
|
||||
|
||||
Note - to run the project from the IDE you will need to place the protected
|
||||
DinkeyChange.dll in the 32-bit Windows System folder*. For release you can place
|
||||
DinkeyChange.dll in the folder of the compiled executable or in the Windows System
|
||||
directory. The former is generally considered better as it is easier to install.
|
||||
|
||||
It is also recommended that you rename DinkeyChange.dll to a name of your choice. In
|
||||
this case you will need to modify the dll name in the ChangeTest.bas file.
|
||||
|
||||
~~~~~~~~~~~~~~~~~
|
||||
* Windows System folder for 32-bit dlls is:
|
||||
c:\windows\system32 32-bit Windows
|
||||
c:\windows\sysWOW64 64-bit Windows
|
||||
@@ -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
|
||||
@@ -0,0 +1,2 @@
|
||||
Form1 = 243, 27, 938, 801, , 22, 22, 577, 462, C
|
||||
Module1 = 22, 69, 888, 858,
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
Reference in New Issue
Block a user