Class HASPWindow Inherits Window

EventHandler Sub EnableMenuItems() appleVisitWebsite.enable End EventHandler

Function AppleVisitWebsite() As Boolean showurl "http://www.ealaddin.com/" End Function

Sub decode() dim p1,p2,p3,p4,c as integer dim m as memoryBlock m=newmemoryBlock(256) // should be big enough for this test // getting data for decoding // not using outputblock.text as RB changes text while guessing the encoding c=len(encodedText) m.stringValue(0,c)=encodedText // Calling function for decoding p2=c CallHASPMemMBS LOCALHASP_DECODEDATA, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4, m // Displaying decoded buffer inputblock.text=m.stringValue(0,c) // Displaying the error code: showresult LOCALHASP_DECODEDATA,p1,p2,p3,p4 End Sub

Sub enablebuttons() // Enable all other buttons encodeButton.enabled=True decodeButton.enabled=True readblockbutton.enabled=True writeblockbutton.enabled=True readwordbutton.enabled=True writewordbutton.enabled=True readtimedate.enabled=timehasp writetimedate.enabled=timehasp checkAutoUpdate.enabled=timehasp haspdate.enabled=timehasp hasptime.enabled=timehasp End Sub

Sub encode() dim p1,p2,p3,p4,c as integer dim m as memoryBlock m=newmemoryBlock(256) // should be big enough for this test // getting data for encoding c=len(inputblock.text) m.stringValue(0,c)=inputblock.text // Calling function for encoding p2=c CallHASPMemMBS LOCALHASP_ENCODEDATA, 0, PortNum, Pass1, Pass2, p1,p2,p3,p4, m // Displaying encoded buffer outputblock.text=m.stringValue(0,c) encodedText=m.stringValue(0,c) // Displaying the error code: showresult LOCALHASP_ENCODEDATA,p1,p2,p3,p4 End Sub

Sub readblock() dim p1,p2,p3,p4 as integer dim i as integer dim m as memoryBlock declare sub DebugStr lib "CarbonLib" (s as pstring) m=newmemoryBlock(1024) // should be big enought for this test // getting data p1=val(memoryaddress.text) p2=val(blocklength.text) // Calling function for writing a block CallHASPMemMBS MEMOHASP_READBLOCK, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4, m // Displaying the error code and data showresult MEMOHASP_READBLOCK,p1,p2,p3,p4 blockdataread.text=m.stringValue(0,p2*2) End Sub

Sub readtime() // Read the time and date from the key dim d as date // The Xojo Date object for displaying the time and date dim p1,p2,p3,p4 as integer d=new date CallHASPMBS TIMEHASP_GETDATE,0,portNum,pass1,pass2,p1,p2,p3,p4 d.day=p1 d.month=p2 if p4>=92 then // handle different centuries d.year=p4+1900 else d.year=p4+2000 end if if p3=0 then // if no error p1=0 p2=0 p3=0 p4=0 CallHASPMBS TIMEHASP_GETTIME,0,portNum,pass1,pass2,p1,p2,p3,p4 d.hour=p4 d.minute=p2 d.second=p1 if p3=0 then // Display haspdate.text=d.longdate hasptime.text=d.longtime end if // Displaying Error Code showresult TIMEHASP_GETTIME,p1,p2,p3,p4 else // Displaying Error Code showresult TIMEHASP_GETDATE,p1,p2,p3,p4 end if End Sub

Sub readword() dim p1,p2,p3,p4 as integer // Setting memory address p1=val(memoryaddress.text) // Calling the Readmemo function CallHASPMBS MEMOHASP_READMEMO, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4 // Displaying Error Code showresult MEMOHASP_READMEMO,p1,p2,p3,p4 // Displaying result memoryvalue.text=str(p2) End Sub

Sub searchkey() dim p1,p2,p3,p4 as integer dim s as string dim id as integer dim m as memoryBlock dim haspgeneration as string dim hasptype as string dim haspmemsize as string m=newmemoryBlock(256) // should be big enought for this test m.stringValue(0,8)="12345678" timehasp = false portNumfield.text="" memorysizefield.text="" hasptypefield.text="" idfield.text="" // Disable Auto Time Update checkAutoUpdate.value=false // First we get the passwords from the editfields Pass1 = val(password1field.text) Pass2 = val(password2field.text) // We don't know the portnumber now. So we start at 0 PortNum=0 // Calling the LOCALHASP_ENCODEDATA Function to find out // if specified HASP is connected p1 = 0 p2 = 0 p3 = 0 p4 = 0 haspgeneration="HASP4" // callhaspmem LOCALHASP_ENCODEDATA, 0, PortNum, Pass1, Pass2, p1,p2,p3,p4, m // find out key generation CallHASPMBS 8 ,0,PortNum,Pass1, Pass2, p1,p2,p3,p4 if (p1=0) then haspgeneration="HASP3" end if showresult 8 ,p1,p2,p3,p4 if p3 <> 0 then resultfield.text="No HASP key with specified passwords found." return else // One or more keys were found resultfield.text="HASP key found." // find if we have a net key attached // will fail if driver supports not API 8.0! // for this service, set ALL parameters to 0 ! p1=0 p2=0 p3=0 p4=0 CallHASPMBS 9,0,PortNum,Pass1, Pass2, p1,p2,p3,p4 showresult 9,p1,p2,p3,p4 if (p1<>0) and (p3=0) then if p1=65535 then haspgeneration=haspgeneration+" Net(unlimited)" else haspgeneration=haspgeneration+" Net("+str(p1)+")" end if end if // Calling the status function CallHASPMBS LOCALHASP_HASPSTATUS, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4 // Now we know the number of the portNum=p3 // Displaying Portnumber. If greater than 200 we have USB HASP key if portnum>=200 then s=" (via USB)" else s="" end if portNumfield.text=str(portNum)+s // Displaying memory size select case p2 case 0 hasptype="Std" memoryinfo.text="" case 1 if p1=1 then hasptype="M1" haspmemsize="56 words" memoryinfo.text="This HASP key has 56 words for your data." else hasptype="M4" haspmemsize="248 words" memoryinfo.text="This HASP key has 248 words for your data." end if case 5 hasptype="TimeHASP" haspmemsize="248 words" memoryinfo.text="This HASP key has 248 words for your data." else hasptype="Unknown Keytype" haspmemsize="" memoryinfo.text="This HASP key doesn't support storing data." end select s=haspmemsize memorysizefield.text=str(p1)+" "+s // Check if time features if p2=5 then timestate.text="This HASP key has time features." timehasp=true else timestate.text="This HASP key has no time features." timehasp=false end if // Displaying HASP key type s=haspgeneration+" "+hasptype+", "+haspmemsize hasptypefield.text=str(p2)+" "+s // Calling the ID Function of Memo Hasps p1=0 p2=0 p3=0 p4=0 CallHASPMBS MEMOHASP_HASPID, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4 if p3<>0 then idfield.text="?" else // Displaying ID id=p1+65536*p2 idfield.text=format(id,"0")+" or hex "+hex(id) end if // If Timehasp than get ID for Timehasp if timehasp then p1=0 p2=0 p3=0 p4=0 CallHASPMBS TIMEHASP_GETHASPID, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4 id=p1+65536*p2 timehaspid.text=format(id,"0")+" or hex "+hex(id) else timehaspid.text="" end if // Enable all other buttons enablebuttons end if End Sub

Sub showresult(service as integer,p1 as integer,p2 as integer,p3 as integer,p4 as integer) // Displaying the errorcode and the error message string resultfield.text=GetHASPErrorStrMBS(p3) p1field.text=str(p1) p2field.text=str(p2) p3field.text=str(p3) p4field.text=str(p4) servicefield.text=str(service) End Sub

Sub writeblock() dim p1,p2,p3,p4 as integer dim m as memoryBlock m=newmemoryBlock(1024) // should be big enought for this test // getting data p1=val(memoryaddress.text) p2=len(blockdatawrite.text) m.stringValue(0,p2)=blockdatawrite.text // Calling function for writing a block CallHASPMemMBS MEMOHASP_WRITEBLOCK, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4, m // Displaying the error code showresult MEMOHASP_WRITEBLOCK,p1,p2,p3,p4 End Sub

Sub writetime() // Write time and date to HASP key dim d as date // The RB Date object dim p1,p2,p3,p4 as integer dim second,minute,hour as integer if parseDate(haspdate.text,d) then // calling Xojos parse Date function saves us time p1=d.day p2=d.month p3=0 p4=d.year if p4<2000 then // handle different centuries p4=p4-1900 else p4=p4-2000 end if CallHASPMBS TIMEHASP_SETDATE,0,portNum,pass1,pass2,p1,p2,p3,p4 if p3=0 then // no error so continue // Time must be in 00:00:00 format hour=val(nthField(hasptime.text,":",1)) ' get first field for hour minute=val(nthField(hasptime.text,":",2)) ' get second field for minute second=val(nthField(hasptime.text,":",3)) ' get third field for second p1=second p2=minute p3=0 p4=hour CallHASPMBS TIMEHASP_SETTIME,0,portNum,pass1,pass2,p1,p2,p3,p4 if p3=0 then readtime // Read current time end if showresult TIMEHASP_SETTIME,p1,p2,p3,p4 else showresult TIMEHASP_SETDATE,p1,p2,p3,p4 end if else msgBox "Invalid Date! Please correct." end if End Sub

Sub writeword() dim p1,p2,p3,p4 as integer // Setting memory address p1=val(memoryaddress.text) // Setting memory value p2=val(memoryvalue.text) // Calling the Readmemo function CallHASPMBS MEMOHASP_WRITEMEMO, 0, PortNum, Pass1, Pass2, p1, p2, p3, p4 // Displaying Error Code showresult MEMOHASP_WRITEMEMO,p1,p2,p3,p4 End Sub

Property Pass1 As integer

Property Pass2 As integer

Property PortNum As integer

Property Protected encodedText As string

Property timehasp As boolean

End Class

MenuBar Menü

MenuItem Menu = ""

MenuItem UntitledMenu0 = "File"

MenuItem FileHASPDemo = "HASP4 Standard, Memo, Time"

MenuItem FileNetHASPDemo = "HASP4 Net"

MenuItem UntitledMenu1 = "-"

MenuItem FileQuit = "Quit"

MenuItem AppleVisitWebsite = "Visit website…"

End MenuBar

Class ReadonlyEditfield Inherits TextField

EventHandler Sub Open() me.backColor=fillColor me.readOnly=true End EventHandler

End Class

Module HASPConstants

Const HASPAPI_VERSION = 5

Const LOCALHASP_DECODEDATA = 61

Const LOCALHASP_ENCODEDATA = 60

Const LOCALHASP_HASPSTATUS = 5

Const LOCALHASP_ISHASP = 1

Const MEMOHASP_HASPID = 6

Const MEMOHASP_READBLOCK = 50

Const MEMOHASP_READMEMO = 3

Const MEMOHASP_WRITEBLOCK = 51

Const MEMOHASP_WRITEMEMO = 4

Const NETHASP_DECODEDATA = 89

Const NETHASP_ENCODEDATA = 88

Const NETHASP_HASPID = 46

Const NETHASP_IDLETIME = 48

Const NETHASP_LASTSTATUS = 40

Const NETHASP_LOGIN = 42

Const NETHASP_LOGOUT = 43

Const NETHASP_QUERYLICENCE = 104

Const NETHASP_READBLOCK = 52

Const NETHASP_READWORD = 44

Const NETHASP_SETCONFIGFILENAME = 85

Const NETHASP_SETSERVERBYNAME = 96

Const NETHASP_WRITEBLOCK = 53

Const NETHASP_WRITEWORD = 45

Const TIMEHASP_GETDATE = 73

Const TIMEHASP_GETHASPID = 78

Const TIMEHASP_GETTIME = 71

Const TIMEHASP_READBLOCK = 77

Const TIMEHASP_READBYTE = 75

Const TIMEHASP_SETDATE = 72

Const TIMEHASP_SETTIME = 70

Const TIMEHASP_WRITEBLOCK = 76

Const TIMEHASP_WRITEBYTE = 74

Function remove0(s as string) As string dim i,c as integer dim ch,t as string c=len(s) for i=1 to c ch=mid(s,i,1) if asc(ch)>0 then t=t+ch end if next return t End Function

End Module

Class NetHASPWindow Inherits Window

EventHandler Sub EnableMenuItems() appleVisitWebsite.enable End EventHandler

Function AppleVisitWebsite() As Boolean showurl "http://www.ealaddin.com/" End Function

Sub Login() dim p1,p2,p3,p4 as integer dim s as string dim id as integer dim keytypetext as string idfield.text="" portnumfield.text="" hasptypefield.text="" memorysizefield.text="" licencefield.text="" activationfield.text="" // First we get the passwords from the editfields Pass1 = val(password1field.text) Pass2 = val(password2field.text) // Nethasp login prognum=val(iprognum.text) CallHASPMBS NETHASP_LOGIN,0,prognum,pass1,pass2,p1,p2,p3,p4 logoutbutton.enabled=true if showresult(NETHASP_LOGIN) then // if okay then go on // Calling the ID Function of Memo Hasps p1=0 p2=0 p3=0 p4=0 CallHASPMBS NETHASP_HASPID, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4 // Show result // Displaying ID id=p1+65536*p2 idfield.text=format(id,"0")+" or hex "+hex(id) portnumfield.text=str(prognum) enablebuttons p1=0 p2=0 p3=0 p4=0 CallHASPMBS NETHASP_QUERYLICENCE, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4 if p2=0 then // its unlimited licencefield.text=str(p1)+" of unlimited licenses in use" else licencefield.text=str(p1)+" of "+str(p2)+" licences in use" end if if p4=65535 then // should be -1 as 16bit but we have it as 32bit value activationfield.text="unlimited" else activationfield.text=str(p4) end if if p3=0 then keytypetext="Unlimited" else keytypetext=str(p3) end if hasptypefield.text="HASP4 Net "+keytypetext memorysizefield.text="248 Words" else // clear fields on error idfield.text="" portnumfield.text="" hasptypefield.text="" memorysizefield.text="" licencefield.text="" activationfield.text="" end if End Sub

Sub LoginProcess() dim p1,p2,p3,p4 as integer dim s as string dim id as integer dim keytypetext as string idfield.text="" portnumfield.text="" hasptypefield.text="" memorysizefield.text="" licencefield.text="" activationfield.text="" // First we get the passwords from the editfields Pass1 = val(password1field.text) Pass2 = val(password2field.text) // Nethasp login prognum=val(iprognum.text) CallHASPMBS 110,0,prognum,pass1,pass2,p1,p2,p3,p4 logoutbutton.enabled=true if showresult(NETHASP_LOGIN) then // if okay then go on // Calling the ID Function of Memo Hasps p1=0 p2=0 p3=0 p4=0 CallHASPMBS NETHASP_HASPID, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4 // Show result // Displaying ID id=p1+65536*p2 idfield.text=format(id,"0")+" or hex "+hex(id) portnumfield.text=str(prognum) enablebuttons p1=0 p2=0 p3=0 p4=0 CallHASPMBS NETHASP_QUERYLICENCE, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4 if p2=0 then // its unlimited licencefield.text=str(p1)+" of unlimited licenses in use" else licencefield.text=str(p1)+" of "+str(p2)+" licences in use" end if if p4=65535 then // should be -1 as 16bit but we have it as 32bit value activationfield.text="unlimited" else activationfield.text=str(p4) end if if p3=0 then keytypetext="Unlimited" else keytypetext=str(p3) end if hasptypefield.text="HASP4 Net "+keytypetext memorysizefield.text="248 Words" else // clear fields on error idfield.text="" portnumfield.text="" hasptypefield.text="" memorysizefield.text="" licencefield.text="" activationfield.text="" end if End Sub

Sub Logout() // Nethasp logout dim p1,p2,p3,p4 as integer idfield.text="" portnumfield.text="" hasptypefield.text="" memorysizefield.text="" licencefield.text="" activationfield.text="" CallHASPMBS NETHASP_LOGOUT,0,prognum,pass1,pass2,p1,p2,p3,p4 dummy=showresult(NETHASP_LOGOUT) End Sub

Sub decode() dim p1,p2,p3,p4,c as integer dim m as memoryBlock m=newmemoryBlock(256) // should be big enought for this test // getting data for decoding c=len(outputblock.text) m.stringValue(0,c)=outputblock.text // Calling function for decoding p2=c CallHASPMemMBS NETHASP_DECODEDATA, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4, m // Displaying decoded buffer inputblock.text=m.stringValue(0,c) // Displaying the error code: dummy=showresult(NETHASP_DECODEDATA) End Sub

Sub enablebuttons() // Enable all other buttons encodeButton.enabled=True decodeButton.enabled=True readblockbutton.enabled=True writeblockbutton.enabled=True readwordbutton.enabled=True writewordbutton.enabled=True loginButton.enabled=true End Sub

Sub encode() dim p1,p2,p3,p4,c as integer dim m as memoryBlock m=newmemoryBlock(256) // should be big enought for this test // getting data for encoding c=len(inputblock.text) m.stringValue(0,c)=inputblock.text // Calling function for encoding p2=c CallHASPMemMBS NETHASP_ENCODEDATA, 0, Prognum, Pass1, Pass2, p1,p2,p3,p4, m // Displaying encoded buffer if (p3 = 0) then outputblock.text=m.stringValue(0,c) end if // Displaying the error code: dummy=showresult(NETHASP_ENCODEDATA) End Sub

Sub readblock() dim p1,p2,p3,p4 as integer dim m as memoryBlock // declare sub DebugStr lib "CarbonLib" (s as pstring) m=newmemoryBlock(1024) // should be big enought for this test // getting data p1=val(memoryaddress.text) p2=val(blocklength.text) // Calling function for writing a block CallHASPMemMBS NETHASP_READBLOCK, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4, m // Displaying the error code and data dummy=showresult(NETHASP_READBLOCK) blockdataread.text=m.stringValue(0,p2*2) End Sub

Sub readword() dim p1,p2,p3,p4 as integer // Setting memory address p1=val(memoryaddress.text) // Calling the Readmemo function CallHASPMBS NETHASP_READWORD, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4 // Displaying Error Code dummy=showresult(NETHASP_READWORD) // Displaying result memoryvalue.text=str(p2) End Sub

Sub setconfigfilename() dim p1,p2,p3,p4 as integer dim NewFileName as memoryBlock // getting new value NewFileName=newmemoryBlock(256) p2=lenb(iNewFileName.text) NewFileName.stringValue(0,p2)=iNewFileName.text // You can call that before login so we get the Prognum again from the input field to make sure we have the correct one Prognum=val(iPrognum.text) // Calling the Readmemo function CallHASPMemMBS NETHASP_SETCONFIGFILENAME, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4, NewFileName // Displaying Error Code dummy=showresult(NETHASP_SETCONFIGFILENAME) End Sub

Sub setidletime() dim newidletime,p1,p2,p3,p4 as integer // getting new value newidletime=val(iNewIdleTime.text) // You can call that before login so we get the Prognum again from the input field to make sure we have the correct one Prognum=val(iPrognum.text) // Calling the Readmemo function CallHASPMBS NETHASP_IDLETIME, newidletime, Prognum, Pass1, Pass2, p1, p2, p3, p4 // Displaying Error Code dummy=showresult(NETHASP_IDLETIME) End Sub

Sub setservername() dim p1,p2,p3,p4 as integer dim ServerName as memoryBlock // getting new value ServerName=newmemoryBlock(256) p2=lenb(iServerName.text) ServerName.stringValue(0,p2)=iServerName.text // You can call that before login so we get the Prognum again from the input field to make sure we have the correct one Prognum=val(iPrognum.text) // Calling the Readmemo function CallHASPMemMBS NETHASP_SETSERVERBYNAME, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4, ServerName // Displaying Error Code dummy=showresult(NETHASP_SETSERVERBYNAME) End Sub

Function showresult(service as integer) As boolean dim p1,p2,p3,p4 as integer // For netHASP we need to ask for the error code using the LastStatus Service function CallHASPMBS NETHASP_LASTSTATUS,0,0,0,0,p1,p2,p3,p4 // Displaying the errorcode and the error message string resultfield.text=GetHASPErrorStrMBS(p1) p1field.text=str(p1) p2field.text=str(p2) p3field.text=str(p3) p4field.text=str(p4) servicefield.text=str(service) // return true if there was no error return p1=0 End Function

Sub writeblock() dim p1,p2,p3,p4 as integer dim data as string dim m as memoryBlock m=newmemoryBlock(1024) // should be big enought for this test // getting data p1=val(memoryaddress.text) p2=len(blockdatawrite.text) m.stringValue(0,p2)=blockdatawrite.text // Calling function for writing a block CallHASPMemMBS NETHASP_WRITEBLOCK, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4, m // Displaying the error code dummy=showresult(NETHASP_WRITEBLOCK) End Sub

Sub writeword() dim p1,p2,p3,p4 as integer // Setting memory address p1=val(memoryaddress.text) // Setting memory value p2=val(memoryvalue.text) // Calling the Readmemo function CallHASPMBS NETHASP_WRITEWORD, 0, Prognum, Pass1, Pass2, p1, p2, p3, p4 // Displaying Error Code dummy=showresult(NETHASP_WRITEWORD) End Sub

Property Pass1 As integer

Property Pass2 As integer

Property Prognum As integer

Property dummy As boolean

Property timehasp As boolean

End Class

Class App Inherits Application

EventHandler Sub EnableMenuItems() filehaSPDemo.enable filenetHASPDemo.enable End EventHandler

Function FileHASPDemo() As Boolean haspWindow.show return true End Function

Function FileNetHASPDemo() As Boolean nethaspWindow.show return true End Function

End Class