Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Dongle/HASP/HASP HL Dynamic RealBasic Sample
Function:
Required plugins for this example: MBS Dongle Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Dongle/HASP/HASP HL Dynamic RealBasic Sample
This example is the version from Thu, 6th Apr 2016.
Project "HASP HL Dynamic RealBasic Sample.rbp"
FileTypes
Filetype c2v
Filetype v2c
End FileTypes
Class Window1 Inherits Window
Control GroupBox1 Inherits GroupBox
ControlInstance GroupBox1 Inherits GroupBox
End Control
Control GroupBox2 Inherits GroupBox
ControlInstance GroupBox2 Inherits GroupBox
End Control
Control LocalOnly Inherits RadioButton
ControlInstance LocalOnly Inherits RadioButton
EventHandler Sub Action() process.Enabled = false End EventHandler
End Control
Control NetOnly Inherits RadioButton
ControlInstance NetOnly Inherits RadioButton
EventHandler Sub Action() process.Enabled = true End EventHandler
End Control
Control process Inherits CheckBox
ControlInstance process Inherits CheckBox
End Control
Control Both Inherits RadioButton
ControlInstance Both Inherits RadioButton
EventHandler Sub Action() process.Enabled = true End EventHandler
End Control
Control RunTests Inherits PushButton
ControlInstance RunTests Inherits PushButton
EventHandler Sub Action() dim now as new Date App.MouseCursor = System.Cursors.Wait message "____________________________________________________________",0 message "API Demo started (" + now.LongDate + " " + now.LongTime + ")", 0 message rundemo( 0 ) message rundemo( 1 ) // Programmnumber 1 to 8 are handled differently on HASP HL Time message message "API Demo completed", 0 App.MouseCursor = nil End EventHandler
End Control
Control GroupBox3 Inherits GroupBox
ControlInstance GroupBox3 Inherits GroupBox
End Control
Control c2v Inherits PushButton
ControlInstance c2v Inherits PushButton
EventHandler Sub Action() dim newc2v as String dim path as FolderItem dim fp as TextOutputStream dim feature As Integer dim hasp as HaspHLDMBS dim now as new Date App.MouseCursor = System.Cursors.Wait message "____________________________________________________________",0 message "Generation of Status Information (" + now.LongDate + " " + now.LongTime + ")", 0 message message "Retrieving Update Information" feature = HASP_PROGNUM_FEATURETYPE // login to default feature if localonly.value then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_NO_REMOTE ) elseif netonly.value Then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_NO_LOCAL ) end if process.value Then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_PROCESS ) end message "Login Default Feature" hasp = new HaspHLDMBS( feature, vendor_code_DEMOMA ) putresult hasp message "Retrieving Session Information" newc2v = hasp.GetSessionInfo( HASP_UPDATEINFO ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message newc2v message message "Prompt for Filename" path = GetSaveFolderItem( "csv", "hasp_demo.c2v" ) if path <> nil then message "Save Uodate iInformation to file '" + path.AbsolutePath + "'" fp = path.CreateTextFile fp.Write( ConvertEncoding( newc2v, Encodings.UTF8 )) fp.Close end end message "Logout Default Feature" hasp.close putresult hasp message message "Generation of Status Information completed" App.MouseCursor = nil End EventHandler
End Control
Control v2c Inherits PushButton
ControlInstance v2c Inherits PushButton
EventHandler Sub Action() dim newv2c, answer as String dim path as FolderItem dim fp as TextInputStream dim feature as integer dim hasp As HaspHLDMBS App.MouseCursor = System.Cursors.Wait dim now as new Date message "____________________________________________________________",0 message "HASP HL Update started (" + now.LongDate + " " + now.LongTime + ")", 0 message message "Prompt for Filename" path = GetOpenFolderItem( "v2c" ) if path = nil or hasp = nil then App.MouseCursor = nil return end message "Read Update Info from File '" + path.AbsolutePath + "'" fp = path.OpenAsTextFile newv2c = fp.ReadAll(Encodings.UTF8) fp.Close message "Update Information:" message newv2c feature = HASP_PROGNUM_FEATURETYPE // login to default feature if localonly.value then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_NO_REMOTE ) elseif netonly.value Then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_NO_LOCAL ) end if process.value Then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_PROCESS ) end message "Login Default Feature" hasp = new HaspHLDMBS( feature,vendor_code_DEMOMA ) putresult hasp answer = hasp.update( newv2c ) putresult hasp message "Akcknoledge Information:" message answer message "Logout Default Feature" hasp.close putresult hasp message message "HASP HL Update completed", 0 App.MouseCursor = nil End EventHandler
End Control
Control GroupBox4 Inherits GroupBox
ControlInstance GroupBox4 Inherits GroupBox
End Control
Control ClearHist Inherits PushButton
ControlInstance ClearHist Inherits PushButton
EventHandler Sub Action() history.Text = "" End EventHandler
End Control
Control history Inherits TextArea
ControlInstance history Inherits TextArea
End Control
Control closeit Inherits PushButton
ControlInstance closeit Inherits PushButton
EventHandler Sub Action() quit End EventHandler
End Control
EventHandler Sub Close() quit End EventHandler
EventHandler Sub Open() // End EventHandler
Function blobtostr(blob as MemoryBlock) As String ' This helper function only converts a memory block to a string, replacing ASCII control characters to "." dim c,i,s,z as Integer dim result as String dim buf as MemoryBlock if blob<>nil then s=blob.Size buf=NewMemoryBlock(s) buf.StringValue(0,s)=blob.StringValue(0,s) c=blob.Size -1 for i = 0 to c z=blob.Byte(i) if z < 32 or z > 127 then buf.Byte(i)=46 // asc(".") end next result=buf.StringValue(0,s) Return DefineEncoding(result,encodings.ASCII) end if End Function
Sub message() 'This function adds an empty line to the history field message "", 1 End Sub
Sub message(str As String) ' This function only adds a message line to the history field with standrd indentation message str, 1 End Sub
Sub message(str As String, indent as Integer) ' This function only adds a text line to the history field with indentation dim i As Integer dim in_str, tabstr as String tabstr = " " // convert tabs to 3 spaces - only works for leading tabs for i = 1 to indent in_str = in_str + tabstr next str = ReplaceLineEndings( str, EndOfLine + in_str ) str = ReplaceAll( str, Encodings.ASCII.chr(9), tabstr ) history.SelText = in_str + str + EndOfLine history.SelStart = Len(history.Text) history.Refresh App.DoEvents End Sub
Sub putblobhex(blob As MemoryBlock) ' This function only adds the contents of a MemoryBlock in Hex-Format into the history field dim i as Integer dim str as String if blob<>nil then for i = 1 to blob.Size if blob.Byte( i-1 ) < 16 then str = str + ("&H0" + hex( blob.Byte(i-1)) + " ") else str = str + ("&H" + hex( blob.Byte(i-1)) + " ") End if i mod 8 = 0 Then str = str + EndOfLine end ' snip the output, if the MemoryBlock is larger than 64 Bytes if i >= 64 then str = str + "[snipped]" Exit end next message str, 2 end if End Sub
Sub putresult(hasp as HaspHLDMBS) ' This function displays the result of a hasp call in human readable format in the history field message "Result: " + GetHASPErrorMesage(hasp.Lasterror) End Sub
Sub rundemo(featureid As Integer) ' This method runs the actual tests on the given program number dim blob, smblob as MemoryBlock // container for file contents dim cblob as MemoryBlock // container for data for en-/decryption dim i as Integer // used in for loops dim size, fileid as Integer // storage for file size and file id dim answer as String // storage for the answer of hasp_get_sessioninfo calls dim rtcdate as new date dim testdate As new Date // actual date and temporary date dim hasp As HaspHLDMBS // Instance of the RB HASP object, wrapping the RB Plugin dim feature as Integer // storage for the complete feature id dim featurestr as String // string for readable output dim rtcdatemem as MemoryBlock dim day,year,month,hour,minute,second as integer const HASP_PROGNUM_FEATURETYPE=&hffff0000 const HASP_PROGNUM_OPT_NO_REMOTE=&h00004000 const HASP_PROGNUM_OPT_NO_LOCAL=&h00008000 const HASP_PROGNUM_OPT_CLASSIC=&h00001000 const HASP_PROGNUM_OPT_PROCESS=&h00002000 ' Set up the featureId, consisting of Program number and the login flags feature = Bitwise.BitOr( featureid, HASP_PROGNUM_FEATURETYPE ) if localonly.value then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_NO_REMOTE ) elseif netonly.value Then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_NO_LOCAL ) end if process.value Then feature = Bitwise.BitOr( feature, HASP_PROGNUM_OPT_PROCESS ) end if featureid = 0 then featurestr = "Default Feature (ProgNumDefaultFeature)" else featurestr = "Feature: Programm Number &H"+ hex( feature ) end message "Login Demo with " + featurestr hasp=new HaspHLDMBS(feature,vendor_code_DEMOMA) putresult hasp if hasp.Lasterror <> HASP_STATUS_OK then return message message "Logout Demo" hasp.Close putresult hasp message message "Login/Logout Demo with " + featurestr message "Login" hasp=new HaspHLDMBS(feature,vendor_code_DEMOMA) putresult hasp message "Logout" hasp.Close putresult hasp message message "Login Demo with " + featurestr hasp=new HaspHLDMBS(feature,vendor_code_DEMOMA) putresult hasp message message "Get Session Information Demo" message "Retrieving Key Information" answer = hasp.GetSessionInfo( HASP_KEYINFO ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Key Information:" message answer end message message "Retrieving Session Information" answer = hasp.GetSessionInfo( HASP_SESSIONINFO ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Session Information:" message answer end message message "Retrieving Update Information" answer = hasp.GetSessionInfo( HASP_UPDATEINFO ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Update Information:" message answer end message message message "Read/Write Demo" fileid = HASP_FILEID_MAIN message "Reading contents of file: " + str( fileid ) message "Retrieving the size of the file" size = hasp.GetSize( fileid ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then // ONLY IF FILE IS SUPPORTED message "Size of the file is: " + Format(size,"0")+" bytes" message "Reading Data" blob = hasp.ReadMemory( fileid, 0, size ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then putblobhex blob end message "Read first eight byte" // set up a new MemoryBlock for testing the write function smblob = hasp.ReadMemory( fileid, 0, 8 ) putresult hasp putblobhex smblob message "Writing to File" for i = 0 to 7 // overwrite with new data smblob.Byte( i ) = i + 8 next hasp.WriteMemory( fileid, 0, smblob,0,smblob.Size ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Data written" message "Dumping Data:" putblobhex smblob end message "Reading written Data" smblob = hasp.ReadMemory( fileid, 0, 8 ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Dumping Data:" putblobhex smblob end message smblob = nil // free smblob // new smblob for one integer value message "GetFileSize/FilePos Demo" message "Setting file position to last int and reading value" smblob = hasp.ReadMemory( fileid, size-4, 4 ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Reading Data &H" + hex( smblob.Long(0)) end message "Writing to file: &H" + hex( smblob.Long(0) ) smblob.Long(0) = &H7FFF hasp.WriteMemory( fileid, size-4, smblob,0,smblob.Size ) putresult hasp message "Reading written data" smblob = hasp.ReadMemory( fileid, size-4, 4 ) putresult hasp message "Data read: &H" + hex( smblob.Long(0)) // restore original data message "Restore original Data" hasp.WriteMemory( fileid, 0, blob ,0, blob.Size ) putresult hasp smblob = nil blob = nil end // end of ONLY IF FILE IS SUPPORTED message message "Encrypt/Decrypt Demo" cblob = NewMemoryBlock( 16 ) cblob.StringValue(0,16) = "HASP HL is great" putblobhex cblob message "Encrypting: '" + blobtostr( cblob ) + "'" hasp.EncryptMemory( cblob,0,cblob.size ) putresult hasp putblobhex cblob if hasp.Lasterror = HASP_STATUS_OK then message "Encrypted string: '" + blobtostr( cblob ) + "'" message message "Decrypting: '" + blobtostr( cblob ) + "'" hasp.DecryptMemory( cblob,0,cblob.size ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Decrypted string: '" + blobtostr( cblob ) + "'" end end message message "Legacy Encrypt/Decrypt Demo" cblob = nil cblob = NewMemoryBlock( 14 ) cblob.StringValue(0,14) = "This is legacy" message "Encrypting: '" + blobtostr( cblob ) + "'" hasp.LegacyEncryptMemory( cblob,0,cblob.size ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Encrypted string: '" + blobtostr( cblob ) + "'" message message "Decrypting: '" + blobtostr( cblob ) + "'" hasp.LegacyDecryptMemory( cblob,0,cblob.size ) putresult hasp if hasp.Lasterror = HASP_STATUS_OK then message "Decrypted string: '" + blobtostr( cblob ) + "'" end end rtcdatemem = hasp.GetRTC putresult hasp if hasp.Lasterror = HASP_STATUS_OK then // only run this test, if key has a rtc hasp.HaspTimeToDateTime rtcdatemem,day,month,year,hour,minute,second rtcdate=new date rtcdate.Year=year rtcdate.Month=Month rtcdate.day=day rtcdate.Second=Second rtcdate.minute=minute rtcdate.hour=hour // when a date object is instanciated, it contains current time and date message "actual date = " + testdate.LongDate + " time (GMT): " + testdate.LongTime, 1 message "keys date = " + rtcdate.LongDate + " time (GMT): " + rtcdate.LongTime, 1 end message message "Logout Demo" hasp.close // logout putresult hasp hasp = nil App.MouseCursor = nil End Sub
End Class
MenuBar MenuBar1
MenuItem UntitledMenu1 = ""
MenuItem FileMenu = "&File"
MenuItem FileQuit = "Quit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
EventHandler Sub Open() // You get required libraries with HASP HL SDK // Once you created your own libraries, change the names here: dim file as FolderItem #if TargetMacOS then file = FindFile("hasp_darwin_demo.dylib") #elseif TargetWin32 then file = FindFile("hasp_windows_demo.dll") #elseif TargetLinux then file = FindFile("libhasp_linux_demo.so") #endif if HASPHLDMBS.LoadLibrary(file) then // ok else MsgBox "Failed to load library." end if End EventHandler
Function FindFile(name as string) As FolderItem // Look for file in parent folders from executable on dim parent as FolderItem = app.ExecutableFile.Parent while parent<>Nil dim file as FolderItem = parent.Child(name) if file<>Nil and file.Exists then Return file end if parent = parent.Parent wend End Function
End Class
Module HASPHLConstants
Const HASP_FILEID_LICENSE = &HFFF2
Const HASP_FILEID_MAIN = &HFFF0
Const HASP_FILEID_TIME = &HFFF1
Const HASP_KEYINFO = "<haspformat format=""keyinfo""/>"
Const HASP_PROGNUM_FEATURETYPE = &HFFFF0000
Const HASP_PROGNUM_OPT_CLASSIC = &H00001000
Const HASP_PROGNUM_OPT_NO_LOCAL = &H00008000
Const HASP_PROGNUM_OPT_NO_REMOTE = &H00004000
Const HASP_PROGNUM_OPT_PROCESS = &H00002000
Const HASP_PROGNUM_OPT_TS = &H00000800
Const HASP_SESSIONINFO = "<haspformat format=""sessioninfo""/>"
Const HASP_STATUS_OK = 0
Const HASP_UPDATEINFO = "<haspformat format=""updateinfo""/>"
Const vendor_code_DEMOMA = "p0AosKZcgvIqHRZwMAK6MqljLvA8fjsYK92+Z4QMib0WKbM/3ljp/RAHjtNwN4wfy1W8oFXWujbbnEppgxd0vulb/ZTuqIvG5hiAuyjLoDYl49KmvXGoXL1yWEwFBIDoVYEbMy1x1Q9k0XxcRioqIGKs8Q/xX8ZqjvQlQyZi2p27biH4GxKvZew2ctfKKxEK87gHBxEC3Pz40bqUnPUEl5KnjfXwTX674ZG0d8HVNnccAOqdblCHHQN6P5LdRpTOQI6B1W4+cLWOv30i1rsjCv8yWfiqV7k909pVuE8s2YMHGBb14jKOjE4lm1FBQ2j8yr7S/jLFBBy1wbDSpThnwT06uzjGgXRhANPVji7lUYdNNebK/v5daWpZGN/e1x0H5QhnSOiclsxNRKAS9f4fVv3iLNHYZHi41W5S87teNkEDG/jkMQchv/Ub/VJTgW03neH44ZzbaAs2Ox+44ZkxdKtDXQM/e0g2qpafrtfPyu07XaEWifw+IBDq2hCoiyB02OZcHVZXAyPO5sk/5pFXr0J2rNT5tf09rqHuemgZnSbEO1XkhrKTo/XS3i9Jw9ST/UgbpSaO5aeiCsWeQ8X5RJ3CIWVDTKC1G2dpadJftEMR2rFS6N9ixxP/1R7pdT1df79/H/dPTVvzuy76dcpxj0UP7/mF/X6GO8OqUOxKG8DoEPGMiZxHHm3ZgLib6uljbQ2ewZYKFp69QSVVMAHumT+wCgWPKg=="
Function GetHASPErrorMesage(errnum as integer) As string dim msg as String select case errnum case 0 msg = "Success (HASP_STATUS_OK)" case 1 // HASP_MEM_RANGE msg = "Invalid memory address (HASP_MEM_RANGE)" case 2 // HASP_INV_PROGNUM_OPT msg = "Unknown/invalid feature id option (HASP_INV_PROGNUM_OPT)" case 3 // HASP_INSUF_MEM msg = "Memory allocation failed (HASP_INSUF_MEM)" case 4 // HASP_TMOF msg = "Too many open features (HASP_TMOF)" case 5 // HASP_ACCESS_DENIED msg = "Feature access denied (HASP_ACCESS_DENIED)" case 6 // HASP_INCOMPAT_FEATURE msg = "Incompatible feature (HASP_INCOMPAT_FEATURE)" case 7 // HASP_CONTAINER_NOT_FOUND msg = "License Container not found (HASP_CONTAINER_NOT_FOUND)" case 8 // HASP_TOO_SHORT msg = "En-/decryption length too short (HASP_TOO_SHORT)" case 9 // HASP_INV_HND msg = "Invalid handle (HASP_INV_HND)" case 10 // HASP_INV_FILEID msg = "Invalid file id / memory descriptor (HASP_INV_FILEID)" case 11 // HASP_OLD_DRIVER msg = "Driver or support daemon version too old (HASP_OLD_DRIVER)" case 12 // HASP_NO_TIME msg = "Real time support not available (HASP_NO_TIME)" case 13 // HASP_SYS_ERR msg = "Generic error from host system call (HASP_SYS_ERR)" case 14 // HASP_NO_DRIVER msg = "Hardware key driver not found (HASP_NO_DRIVER)" case 15 // HASP_INV_FORMAT msg = "Unrecognized info format (HASP_INV_FORMAT)" case 16 // HASP_REQ_NOT_SUPP msg = "Request not supported (HASP_REQ_NOT_SUPP)" case 17 // HASP_INV_UPDATE_OBJ msg = "Invalid update object (HASP_INV_UPDATE_OBJ)" case 18 // HASP_KEYID_NOT_FOUND msg = "Key with requested id was not found (HASP_KEYID_NOT_FOUND)" case 19 // HASP_INV_UPDATE_DATA msg = "Update data consistency check failed (HASP_INV_UPDATE_DATA)" case 20 // HASP_INV_UPDATE_NOTSUPP msg = "Update not supported by this key (HASP_INV_UPDATE_NOTSUPP)" case 21 // HASP_INV_UPDATE_CNTR msg = "Update counter mismatch (HASP_INV_UPDATE_CNTR)" case 22 // HASP_INV_VCODE msg = "Invalid vendor code (HASP_INV_VCODE)" case 23 // HASP_ENC_NOT_SUPP msg = "Requested encryption algorithm not supported (HASP_ENC_NOT_SUPP)" case 24 // HASP_INV_TIME msg = "Invalid date / time (HASP_INV_TIME)" case 25 // HASP_NO_BATTERY_POWER msg = "Clock has no power (HASP_NO_BATTERY_POWER)" case 26 // HASP_NO_ACK_SPACE msg = "Update requested ack., but no area to return it (HASP_NO_ACK_SPACE)" case 27 // HASP_TS_DETECTED msg = "Terminal services (remote terminal) detected (HASP_TS_DETECTED)" case 28 // HASP_FEATURE_TYPE_NOT_IMPL msg = "Feature type not implemented (HASP_FEATURE_TYPE_NOT_IMPL)" case 29 // HASP_UNKNOWN_ALG msg = "Unknown algorithm (HASP_UNKNOWN_ALG)" case 30 // HASP_INV_SIG msg = "Signature check failed (HASP_INV_SIG)" case 31 // HASP_FEATURE_NOT_FOUND msg = "Feature not found (HASP_FEATURE_NOT_FOUND)" case 600 // HASP_NO_EXTBLOCK msg = "No classic memory extension block available (HASP_NO_EXTBLOCK)" case 698 // HASP_NOT_IMPL msg = "Capability isn't available (HASP_NOT_IMPL)" case 699 // HASP_INT_ERR msg = "Internal API error (HASP_INT_ERR)" else // any other error number msg = "HASP Error: " + str( errnum ) end select return msg End Function
End Module
End Project

See also:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Dongle Plugin.





Links
MBS Xojo Chart Plugins