activex.frm

vb下调用usb 接口smartcard的应用例程

    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Create MF End Err: " & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If Sw1Sw2 <> "9000" Then
            List1.AddItem ("Create MF End Err：" & Sw1Sw2)
        Else
            List1.AddItem ("Create MF End OK")
        End If
    End If
    
End Sub

Private Sub Encrypt_Click()
Dim key As String * 32
Dim keylen As Integer
Dim Esour As String * 128
Dim Dsour As String * 128
Dim sourLen As Long

    key = "5566778888776655"      'Key length 8Byte,input with ASC
    keylen = Len(Trim(key))
    Esour = "a1a2a3a4a5a6a7a8b1b2b3b4b5b6b7b8"
    sourLen = Len(Trim(Esour))
    retStr = MwUsbD1.DesEncrypt(key, keylen, Esour, sourLen)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Encrypt Err: " & Mid(retStr, 1, 1))
    Else
        List1.AddItem ("Encrypt OK: " & Mid(retStr, 6, 32))
    End If
    
    Dsour = Mid(retStr, 6, 32)
    soulen = Len(Trim(Dsour))
    retStr = MwUsbD1.DesDecrypt(key, keylen, Dsour, sourLen)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Encrypt Err: " & Mid(retStr, 1, 1))
    Else
        List1.AddItem ("Decrypt OK: " & Mid(retStr, 6, 32))
    End If

End Sub

Private Sub GenerateKey_Click()
Dim StartTime
Dim CommandTime
Dim GenerateTime As Integer
    
    List1.Clear
    List1.Refresh
    
'Reset
    retStr = MwUsbD1.MwReset(icdev)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Reset Err")
    Else
        AtrLen = Mid(retStr, 2, 4)
        List1.AddItem ("RESET:" & Mid(retStr, 6, AtrLen))
    End If

'Select 2F01
    InsStr = "00a40000022f01"
    InsLen = Len(Trim(InsStr))
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Select DF Err: " & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If Sw1Sw2 <> "9000" Then
            SelectErr = SelectErr + 1
            List1.AddItem ("Select DF Err：" & Sw1Sw2)
        Else
            List1.AddItem ("Select DF OK")
        End If
    End If

'Generate RSA Key
    InsStr = "804600000400020001"
    InsLen = Len(Trim(InsStr))
    StartTime = Time
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    CommandTime = Time
    GenerateTime = Second(CommandTime - StartTime)
    
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Generate PK Err: " & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If Sw1Sw2 <> "9000" Then
            List1.AddItem ("Generate PK Err：" & Sw1Sw2)
        Else
            List1.AddItem ("Generate PK OK")
            List1.AddItem ("Generate PK time:" & GenerateTime & " s")
        End If
    End If
        
End Sub

Private Sub MwUsbD1_MwUsbDEvent(ByVal DevState As String)

shareMode = 1  '共享方式
'shareMode = 0 '独占方式

    For i = 1 To 8
    If Mid(DevState, i, 1) = 1 Then
        If icdev < 0 Then
        USBport = i - 1
        icdev = MwUsbD1.MwInit(USBport, shareMode)
            List1.AddItem "eKey In ! MwInit"
        End If
        Exit Sub
    ElseIf Mid(DevState, i, 1) = 0 Then
        If icdev > 0 Then
        MwUsbD1.MwClose (icdev)
            List1.AddItem "eKey Out ! MwClose"
        icdev = -1
        End If
        Exit Sub
    End If
    Next i

End Sub

Private Sub SignVer_Click()
Dim RSAsour As String * 260
Dim HashData As String * 40
Dim BinStr As String
Dim BinLen As Integer

List1.Clear
List1.Refresh

'Reset
    retStr = MwUsbD1.MwReset(icdev)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Reset Err")
    End If

'Select 2F01
    InsStr = "00a40000022f01"
    InsLen = Len(Trim(InsStr))
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Select DF Err: " & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If Sw1Sw2 <> "9000" Then
            List1.AddItem ("Select DF Err：" & Sw1Sw2)
        Else
            List1.AddItem ("Select DF OK")
        End If
    End If

 'Hash
    InsStr = "80cc010040" & "93A2A3A4A5A6A7A8B1B2B3B4B5B6B7B8A1A2A3A4A5A6A7A8B1B2B3B4B5B6B7B8A1A2A3A4A5A6A7A8B1B2B3B4B5B6B7B8A1A2A3A4A5A6A7A8B1B2B3B4B5B6B7B8"
    InsLen = Len(Trim(InsStr))
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Hash ERR:" & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If (Sw1Sw2 <> "9000") Then
            List1.AddItem ("HasH ERR：" & Sw1Sw2)
        Else
            List1.AddItem ("Hash  OK: " & Mid(retStr, 6, 2 * 22))
        End If
    End If

'Sign Data must be 128B,thus fill "0" in front of HASH Data
    HashData = Mid(retStr, 6, 2 * 20)
    RSAsour = String(2 * (128 - 20), "0") & HashData
    
'Sign
     InsStr = "8086000280" & Mid(RSAsour, 1, 128 * 2)
    InsLen = Len(Trim(InsStr))
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("RSA sign ERR: " & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If (Sw1Sw2 <> "9000") Then
            List1.AddItem ("RSA Sign ERR: " & Sw1Sw2)
        Else
            List1.AddItem ("RSA Sign OK: " & Mid(retStr, 6, Rlen - 4))
        End If
    End If

'Sign Verify
    InsStr = "808a000180" & Mid(retStr, 6, 2 * 128)
    InsLen = Len(Trim(InsStr))
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("SignVerify ERR:" & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If (Sw1Sw2 <> "9000") Then
            List1.AddItem ("SignVerify ERR：" & Sw1Sw2)
        Else
            List1.AddItem ("SignVerify OK: " & Right(Trim(retStr), 44))
        End If
    End If


 'Write Binary    MaxLength 171 Byte
 
    BinLen = 171
    BinStr = String(2 * BinLen, "A")
    InsStr = "00d68300" & CStr(Hex(BinLen)) & Mid(BinStr, 1, 2 * (BinLen))
    InsLen = Len(Trim(InsStr))
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("Update ERR:" & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If (Sw1Sw2 <> "9000") Then
            List1.AddItem ("Update ERR：" & Sw1Sw2)
        Else
             List1.AddItem ("Update Bin OK")
       End If
    End If

'Read Binary    Maxlength 174 Byte

    InsStr = "00b08300" & CStr(Hex(BinLen))
    InsLen = Len(Trim(InsStr))
    retStr = MwUsbD1.MwProtocol(icdev, InsLen, InsStr)
    If (Mid(retStr, 1, 1) <> 0) Then
        List1.AddItem ("ReadBin ERR:" & Mid(retStr, 1, 1))
    Else
        Rlen = Mid(retStr, 2, 4)
        Sw1Sw2 = Mid(retStr, (6 + Rlen - 4), 4)
        If (Sw1Sw2 <> "9000") Then
            List1.AddItem ("ReadBin ERR：" & Sw1Sw2)
        Else
            List1.AddItem ("Read    Bin OK")
        End If
    End If

End Sub


Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Form_Load()

shareMode = 1  '共享方式
'shareMode = 0 '独占方式

retStr = MwUsbD1.MwGetDevState()
If Mid(retStr, 1, 1) = 0 Then
For i = 6 To 14
If Mid(retStr, i, 1) = 1 Then
    USBport = i - 6
    icdev = MwUsbD1.MwInit(USBport, shareMode)
    If (icdev < 0) Then
        List1.AddItem ("MW_init ERR:" & CStr(st))
    Else
        List1.AddItem ("MW_Init OK")
    End If
    Exit Sub
End If
Next i

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
    st = MwUsbD1.MwClose(icdev)
    If (st <> 0) Then
        List1.AddItem ("mw_close ERR")
    End If
End Sub

Private Sub List1_Click()
    List1.Clear
End Sub