VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H80000001&
   Caption         =   "Test SenseLock EL API"
   ClientHeight    =   6345
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7395
   LinkTopic       =   "Form1"
   ScaleHeight     =   6345
   ScaleWidth      =   7395
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Exit 
      Appearance      =   0  'Flat
      BackColor       =   &H0000FFFF&
      Caption         =   "Exit"
      Height          =   375
      Left            =   3600
      TabIndex        =   2
      Top             =   5760
      Width           =   2055
   End
   Begin VB.CommandButton Test 
      Appearance      =   0  'Flat
      BackColor       =   &H0080FFFF&
      Caption         =   "Test"
      Height          =   375
      Left            =   1200
      MaskColor       =   &H0080C0FF&
      TabIndex        =   1
      Top             =   5760
      Width           =   1815
   End
   Begin VB.ListBox List1 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0FF&
      Columns         =   1
      Height          =   5295
      ItemData        =   "sense4_demo.frx":0000
      Left            =   240
      List            =   "sense4_demo.frx":0002
      TabIndex        =   0
      Top             =   240
      Width           =   6975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Exit_Click()
    DestroyWindow Form1.hwnd
   ' SendMessage Form1.hwnd, WM_QUIT, 0, 0
    End
End Sub
Private Sub ReadFrmFile(strFileName As String, outBuffer() As Byte, bytesReturn As Integer)

    Const CHUNK_LENGTH As Long = 2000   'the length of the block which be read each time, in bytes
    
    Dim whole As Long                   'filelength / CHUNK_LENGTH
    Dim part As Long                    'filelength % CHUNK_LENGTH
    Dim buffer() As Byte
    Dim start As Long                   'starting offset
    
    Dim i As Long

    Open strFileName For Binary As #1

    whole = LOF(1) \ CHUNK_LENGTH
    part = LOF(1) Mod CHUNK_LENGTH
    start = 1
    
    bytesReturn = LOF(1)
    ReDim outBuffer(bytesReturn)
    
    'ReDim buffer(CHUNK_LENGTH - 1)
    
    For x = 1 To whole
        
        Get #1, start, outBuffer
                        
        start = start + CHUNK_LENGTH
    Next
        
    'ReDim buffer(part - 1)
    Get #1, start, outBuffer
                   
    Close #1
       
End Sub

Private Sub Test_Click()
' ---------------------------------------------------------
' (C) Copyright 2003 SenseLock Info & Secu Inc.
'
' Brief£ºthis example demostrate the mothod to call Elite API in VB
'
' Author£º chency
'
' Date£º03/2004
'
' -------------------------------------------------------
Test.Caption = "Please waiting ....."

Dim s4CtxList(0 To MAX_DEVICE_NUMBER - 1) As SENSE4_CONTEXT
Dim rv As Long
Dim inBuff() As Byte
Dim outBuff() As Byte
Dim listSize As Long
Dim ctxnumber As Integer
Dim bytesReturn As Long

Dim i As Integer

Const FILE_SHARE_READ = 1
Const OPEN_EXISTING = 3
Const FILE_ATTRIBUTE_NORMAL = 128
Const FILE_ALL_ACCESS = 2032639

Dim devPinOrigin(0 To 23) As Byte            ' Defualt DEV PIN
For i = 0 To UBound(devPinOrigin)
    devPinOrigin(i) = Asc(Mid("123456781234567812345678", i + 1, 1))
Next

Dim devPinNew(0 To 23) As Byte                 ' New DEV PIN
For i = 0 To UBound(devPinNew)
    devPinNew(i) = Asc(Mid("876543214321876513572468", i + 1, 1))
Next

Dim userPinOrigin(0 To 7) As Byte             ' Default user PIN
For i = 0 To UBound(userPinOrigin)
    userPinOrigin(i) = Asc(Mid("12345678", i + 1, 1))
Next

Dim userPinNew(0 To 7) As Byte                ' New user PIN
For i = 0 To UBound(userPinNew)
    userPinNew(i) = Asc(Mid("13572468", i + 1, 1))
Next


Dim authPinNew(0 To 15) As Byte                 ' New authenticate key
For i = 0 To UBound(authPinNew)
    authPinNew(i) = Asc(Mid("1058862794428571", i + 1, 1))
Next

Dim str1 As String

Dim sBin   As String
Dim sBin1  As String



Const BIN_LENGTH = 472
Dim bin_data() As Byte

Dim isnetver As Boolean                       'net device if TRUE, otherwise local device


List1.Columns = 1


rv = S4Enum(s4CtxList(0), listSize)

ctxnumber = listSize / ctxsize
str1 = "Find" + Str(ctxnumber) + "device(s)"
List1.AddItem str1


rv = S4Enum(s4CtxList(0), listSize)

Dim openInfo As S4OPENINFO
openInfo.dwS4OpenInfoSize = 8
openInfo.dwShareMode = S4_EXCLUSIZE_MODE

rv = S4OpenEx(s4CtxList(0), openInfo)
If rv = S4_SUCCESS Then
    str1 = "Succeed to open the first device!"
Else
    str1 = "Failed to open the first device, the return value is " + Str(Hex(rv))
End If
List1.AddItem str1

ReDim outBuff(7)
    
' LED UP
str1 = ""
rv = S4Control(s4CtxList(0), S4_LED_UP, Null, 0, outBuff(0), 0, bytesReturn)
If rv = S4_SUCCESS Then
    str1 = "LED up.....succeed£¡"
Else
    str1 = "Failed to have LED up£¡the return value is" + Str(rv)
End If
List1.AddItem str1

' LED down
str1 = ""
rv = S4Control(s4CtxList(0), S4_LED_DOWN, Null, 0, outBuff(0), 0, bytesReturn)
If rv = S4_SUCCESS Then
    str1 = "LED down.....succeed£¡"
Else
    str1 = "Failed to have LED down£¡The return value is " + Str(rv)
End If
List1.AddItem str1

' LED wink
ReDim inBuff(1)
ReDim outBuff(8)
inBuff(0) = 5       'the frequency of winking
str1 = ""
rv = S4Control(s4CtxList(0), S4_LED_WINK, inBuff(0), 1, outBuff(0), 0, bytesReturn)
If rv = S4_SUCCESS Then
    str1 = "LED winking.....succeed£¡"
Else
    str1 = "Failed to have LED wink£¡The return value is " + Str(rv)
End If
List1.AddItem str1


' get device type
str1 = ""
rv = S4Control(s4CtxList(0), S4_GET_DEVICE_TYPE, Null, 0, outBuff(0), 1, bytesReturn)
If rv = S4_SUCCESS Then
    Select Case outBuff(0)
    Case 0
        str1 = "device type:  local device"
        isnetver = False
    Case 128
        str1 = "device type: net master device"
        isnetver = True
    Case 192
        str1 = "device type: net slave device"
        isnetver = True
    End Select
Else
    str1 = "Failed to get device type£¡The return vlaue is " + Str(Hex(rv))
End If
List1.AddItem str1


' get serial number
str1 = ""
rv = S4Control(s4CtxList(0), S4_GET_SERIAL_NUMBER, Null, 0, outBuff(0), 8, bytesReturn)
If rv = S4_SUCCESS Then
    str1 = "Serial Number: "
    For i = 0 To 7
        str1 = str1 + Str(outBuff(i))
    Next
Else
    str1 = "Failed to get serial number£¡The return value is " + Str(rv)
End If
List1.AddItem str1


' get VM type
str1 = ""
rv = S4Control(s4CtxList(0), S4_GET_VM_TYPE, Null, 0, outBuff(0), 1, bytesReturn)
If rv = S4_SUCCESS Then
    Select Case outBuff(0)
    Case 0
        str1 = "VM type:  VM51"
    Case 1
        str1 = "VM type:  VM251Binary"
    Case 2
        str1 = "VM type:  VM251Source"
    End Select
Else
    str1 = "Failed to get VM type£¡The return value is " + Str(rv)
End If
List1.AddItem str1



str1 = ""
If Not isnetver Then
    'get totoal space of the device
    rv = S4Control(s4CtxList(0), S4_GET_DEVICE_USABLE_SPACE, Null, 0, outBuff(0), 2, bytesReturn)
    If rv = S4_SUCCESS Then
        str1 = "Total Device Space: "
        For i = 0 To 1
            str1 = str1 + Str(outBuff(i))
        Next
    Else
        str1 = "Failed to get total device space£¡The return value is " + Str(rv)
    End If
    List1.AddItem str1

End If

' create root directory
Dim crtInfo As S4CREATEDIRINFO
crtInfo.dwS4CreateDirInfoSize = 12

str1 = ""
rv = S4CreateDirEx(s4CtxList(0), "\", 0, S4_CREATE_ROOT_DIR, crtInfo)
If rv = S4_SUCCESS Then
    str1 = "Creating root directory....succeed!"
    List1.AddItem str1
Else
    str1 = ""
    If rv = S4_DIRECTORY_EXIST Then
        str1 = "the root directory exists!"
        List1.AddItem str1
        
        ' change current directory to root directory
        str1 = ""
        rv = S4ChangeDir(s4CtxList(0), "\")
        
        'if the device is not empty, verify DEV PIN to get privilege, then erase root directory
        rv = S4VerifyPin(s4CtxList(0), devPinOrigin(0), 24, S4_DEV_PIN)
        If rv <> S4_SUCCESS Then
            str1 = "Failed to verify PIN before erasing root directory, the return value is " + Str(rv)
            List1.AddItem str1
            S4Close s4CtxList(0)
            Exit Sub
        End If
        
        rv = S4EraseDir(s4CtxList(0), 0)
        If rv <> S4_SUCCESS Then
            str1 = "Failed to erase root directory, the return value is " + Str(rv)
        Else
            str1 = "Erasing root directory....succeed!"
        End If
        List1.AddItem str1
        
        rv = S4CreateDirEx(s4CtxList(0), "\", 0, S4_CREATE_ROOT_DIR, crtInfo)
        If rv <> S4_SUCCESS Then
            str1 = "Failed to recreate root directory£¬the return value is " + Str(rv)
            List1.AddItem str1
            S4Close s4CtxList(0)
            Exit Sub
        Else
            str1 = "Recreate root directory...succeed!"
        End If
    Else
        str1 = "Failed to create root directory£¡The return value is " + Str(rv)
    End If
        
    List1.AddItem str1
End If

' Verify DEV PIN
str1 = ""
rv = S4VerifyPin(s4CtxList(0), devPinOrigin(0), 24, S4_DEV_PIN)
If rv <> S4_SUCCESS Then
    str1 = "Failed to verify DEV PIN, the return value is " + Str(rv)
    List1.AddItem str1
    S4Close s4CtxList(0)
    Exit Sub
End If

' Net device, modify authenticate key
If isnetver Then
    str1 = ""
    rv = S4ChangePin1(s4CtxList(0), 0, 0, authPinNew(0), 16, S4_AUTHEN_PIN)
    If rv <> S4_SUCCESS Then
        str1 = "Failed to modify authenticate key, the return value is " + Str(rv)
        List1.AddItem str1
        S4Close s4CtxList(0)
        Exit Sub
    Else
        str1 = "Modifying authenticate key... succeed!"
    End If
List1.AddItem str1
End If


' Create child directory 0001
str1 = ""
If isnetver Then
    rv = S4CreateDir(s4CtxList(0), "0001", 1000, S4_CREATE_MODULE)
Else
    rv = S4CreateDir(s4CtxList(0), "0001", 1000, S4_CREATE_SUB_DIR)
End If
If rv <> S4_SUCCESS Then
    str1 = "Failed to create child directory 0001, the return value is " + Str(rv)
Else
    str1 = "Creating child directory.....succeed!"
End If
List1.AddItem str1

' choose child directory 0001
str1 = ""
rv = S4ChangeDir(s4CtxList(0), "0001")
If rv <> S4_SUCCESS Then
    str1 = "Failed to choose child directory 0001,the return value is " + Str(rv)
Else
    str1 = "Choosing child directory 0001.....succeed!"
End If
List1.AddItem str1

' modify DEV PIN
str1 = ""
rv = S4ChangePin(s4CtxList(0), devPinOrigin(0), 24, devPinNew(0), 24, S4_DEV_PIN)
If rv <> S4_SUCCESS Then
    str1 = "Failed to modify DEV PIN, the return value is " + Str(rv)
    List1.AddItem str1
    S4Close s4CtxList(0)
    Exit Sub
Else
    str1 = "Modifying DEV PIN.....succeed!"
End If
List1.AddItem str1

' modify user PIN
str1 = ""
rv = S4ChangePin(s4CtxList(0), userPinOrigin(0), 8, userPinNew(0), 8, S4_USER_PIN)
If rv <> S4_SUCCESS Then
   str1 = "Failed to modify user PIN£¬the return value is " + Str(rv)
   List1.AddItem str1
   S4Close s4CtxList(0)
   Exit Sub
Else
   str1 = "Modifying user PIN.....succeed!"
End If
List1.AddItem str1

' change current directory to root directory
str1 = ""
rv = S4ChangeDir(s4CtxList(0), "\")
If rv <> S4_SUCCESS Then
    str1 = "Failed to change current directory to root directory£¬the return value is " + Str(rv)
Else
    str1 = "Changing current directory.....succeed!"
End If
List1.AddItem str1

' verify DEV PIN
str1 = ""
rv = S4VerifyPin(s4CtxList(0), devPinOrigin(0), 24, S4_DEV_PIN)
If rv <> S4_SUCCESS Then
    str1 = "Failed to verify DEV PIN£¬the return value is " + Str(rv)
    List1.AddItem str1
    S4Close s4CtxList(0)
    Exit Sub
End If

' create child directory 0002
str1 = ""
If isnetver Then
    rv = S4CreateDir(s4CtxList(0), "0002", 1000, S4_CREATE_MODULE)
Else
    rv = S4CreateDir(s4CtxList(0), "0002", 1000, S4_CREATE_SUB_DIR)
End If
If rv <> S4_SUCCESS Then
    str1 = "Failed to create child directory 0002, the return value is " + Str(rv)
    List1.AddItem str1
    S4Close s4CtxList(0)
    Exit Sub
Else
    str1 = "Creating child directory 0002....succeed!"
    List1.AddItem str1
End If


' change current directory to root directory
str1 = ""
rv = S4ChangeDir(s4CtxList(0), "\")
If rv <> S4_SUCCESS Then
    str1 = "Failed to change current directory to root directory, the return value is " + Str(rv)
Else
    str1 = "Changing current directory.....succeed!"
End If
List1.AddItem str1


' create VM file 1001 as readable writeable file
str1 = "'"
rv = S4WriteFile(s4CtxList(0), "1001", 0, "aaaaaaaaaaaaaaaaaaaaaaaa", 24, 100, bytesReturn, S4_CREATE_NEW, S4_EXE_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to create VM file 1001£¬the return value is " + Str(rv)
Else
    str1 = "Creating VM file 1001....succeed!"
End If
List1.AddItem str1


' create VM file 1002 as readable-only  file
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1002", 0, "123456789abcdef0", 16, 50, bytesReturn, S4_CREATE_NEW_FILE_EXECUTE_ONLY, S4_EXE_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to create VM file 1002,the return value is " + Str(rv)
Else
    str1 = "Creating VM file 1002....succeed!"
End If
List1.AddItem str1


' create data file 1003
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1003", 0, "123456789abcdef0", 16, 50, bytesReturn, S4_CREATE_NEW, S4_DATA_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to create data file 1003£¬the return value is£º" + Str(rv)
Else
    str1 = "Creating data file 1003....succeed!"
End If
List1.AddItem str1


' producing RSA key pair by hardware
str1 = ""
rv = S4WriteFile1(s4CtxList(0), "20012002", 0, 0, 0, 0, bytesReturn, S4_KEY_GEN_RSA_FILE, 0)
If rv <> S4_SUCCESS Then
    str1 = "Failed to produce RSA key pair, the return value is " + Str(rv)
Else
    str1 = "Producing RSA key pair....succeed!"
End If
List1.AddItem str1


' create rsa public file 1004
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1004", 0, pubkey, 256, 136, bytesReturn, S4_CREATE_NEW, S4_RSA_PUBLIC_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to create RSA public file 1004,the return value is " + Str(rv)
Else
    str1 = "Creating RSA public file 1004....succeed!"
End If
List1.AddItem str1


' create RSA private file 1005
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1005", 0, prikey, 704, 330, bytesReturn, S4_CREATE_NEW, S4_RSA_PRIVATE_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to create RSA private key file, the return value is " + Str(rv)
Else
    str1 = "Creating RSA private key file 1005....succeed!"
End If
List1.AddItem str1


' update VM file 1001
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1001", 0, "bbbbbbbb", 8, 0, bytesReturn, S4_UPDATE_FILE, S4_EXE_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to update VM file 1001,the return value is £º" + Str(rv)
Else
    str1 = "Updating VM file 1001....succeed!"
End If
List1.AddItem str1


' update data file 1003
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1003", 0, "aaaabbbb", 8, 0, bytesReturn, S4_UPDATE_FILE, S4_DATA_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to update data file 1003,the return value is " + Str(rv)
Else
    str1 = "Updating data file 1003....succeed!"
End If
List1.AddItem str1

' net device£¬set license number
If isnetver Then
    str1 = ""
    rv = S4WriteFile2(s4CtxList(0), 0, 0, 0, 0, 18, bytesReturn, S4_SET_LICENCES, 0)
    If rv <> S4_SUCCESS Then
        str1 = "Failed to set license number for net device,the return value is " + Str(rv)
    Else
        str1 = "Setting license number....succeed!"
    End If
    List1.AddItem str1
End If

' read BIN file
Dim bin_len As Integer

sBin = Space(256)
rv = GetCurrentDirectory(256, sBin)
sBin = Trim(sBin)
sBin = Left(sBin, Len(sBin) - 1)
sBin = sBin + "\demo_v20.bin"

Call ReadFrmFile(sBin, bin_data, bin_len)

' create VM file 1006 as readable writeable file, write the content of the specified BIn file
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1006", 0, bin_data(0), bin_len, bin_len, bytesReturn, S4_CREATE_NEW, S4_EXE_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to create VM file 1006, the return value is £º" + Str(rv)
Else
    str1 = "Creating VM file 1006....succeed!"
End If
List1.AddItem str1

sBin1 = Space(256)
rv = GetCurrentDirectory(256, sBin1)
sBin1 = Trim(sBin1)
sBin1 = Left(sBin1, Len(sBin1) - 1)
sBin1 = sBin1 + "\demo_v30.bin"

bin_len = 0
Call ReadFrmFile(sBin1, bin_data, bin_len)

' create VM file 1007 as readable writeable file, write the content of the specified BIN file
str1 = ""
rv = S4WriteFile(s4CtxList(0), "1007", 0, bin_data(0), bin_len, 1000, bytesReturn, S4_CREATE_NEW, S4_XA_EXE_FILE)
If rv <> S4_SUCCESS Then
    str1 = "Failed to create VM file 1007, the return value is " + Str(rv)
Else
    str1 = "Creating VM file 1007....succeed!"
End If
List1.AddItem str1

If Not isnetver Then
    ' verify user PIN to get executive privilege
    str1 = ""
    rv = S4VerifyPin(s4CtxList(0), userPinOrigin(0), 8, S4_USER_PIN)
    If rv <> S4_SUCCESS Then
        str1 = "Failed to verify user PIN,the return value is " + Str(rv)
    Else
        str1 = "Verifying user PIN....succeed!"
    End If
    List1.AddItem str1
    
    ReDim inBuff(4)
    inBuff(0) = Asc("1")
    inBuff(1) = Asc("2")
    inBuff(2) = Asc("3")
    inBuff(3) = Asc("4")
    
    ReDim outBuff(64)
    str1 = ""
    rv = S4ExecuteEx(s4CtxList(0), "1006", S4_VM_EXE, inBuff(0), 4, outBuff(0), 64, bytesReturn)
    If rv <> S4_SUCCESS Then
        str1 = "Failed to execute VM file 1006,the return value is " + Str(rv)
    Else
        str1 = "Executing VM file 1006....succeed!"
    End If
    List1.AddItem str1
    
    str1 = ""
    rv = S4ExecuteEx(s4CtxList(0), "1007", S4_XA_EXE, inBuff(0), 4, outBuff(0), 64, bytesReturn)
    If rv <> S4_SUCCESS Then
        str1 = "Failed to execute XA file 1007£¬the return value is " + Str(rv)
    Else
        str1 = "Executing XA file 1007....succeed!"
    End If
    List1.AddItem str1
End If

str1 = ""
rv = S4ChangeDir(s4CtxList(0), "\")
If rv <> S4_SUCCESS Then
    str1 = "Failed to change current directory to root directory£¬the return value is " + Str(rv)
Else
    str1 = "Creating current directory to root directory....succeed!"
End If
List1.AddItem str1

str1 = "'"
rv = S4VerifyPin(s4CtxList(0), devPinOrigin(0), 24, S4_DEV_PIN)
If rv <> S4_SUCCESS Then
    str1 = "Failed to verify DEV PIN,the return value is " + Str(rv)
Else
    str1 = "Verifying DEV PIN....succeed!"
End If
List1.AddItem str1


' erase the root directory to make the device emtpy
str1 = ""
rv = S4EraseDir(s4CtxList(0), 0)
If rv <> S4_SUCCESS Then
    str1 = "Failed to erase root directory,the return value is " + Str(rv)
Else
    str1 = "Erasing root directory....succeed!"
End If
List1.AddItem str1

' LED down
str1 = ""
rv = S4Control(s4CtxList(0), S4_LED_DOWN, Null, 0, outBuff(0), 0, bytesReturn)
If rv = S4_SUCCESS Then
    str1 = "having LED down.....succeed£¡"
Else
    str1 = "Failed to have LED down,the return value is " + Str(rv)
End If
List1.AddItem str1


' close device
rv = S4Close(s4CtxList(0))
If rv <> S4_SUCCESS Then
    str1 = "Failed to close the device,the return value is " + Str(rv)
Else
    str1 = "Closing device....succeed!"
End If
List1.AddItem str1

Test.Caption = "Test"

End Sub


