Files
PS_Dinkey/Dinkey Pro 7.6.1/Samples/Visual Basic/DinkeyChange/ChangeTest.frm
2026-05-06 07:47:36 +02:00

362 lines
12 KiB
Plaintext

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