Foxtable(狐表)用户栏目专家坐堂 → vb代码在ft怎么用


  共有2254人关注过本帖平板打印复制链接

主题:vb代码在ft怎么用

帅哥哟,离线,有人找我吗?
jaegea
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:480 积分:3832 威望:0 精华:0 注册:2011/5/31 15:45:00
vb代码在ft怎么用  发帖心情 Post By:2018/11/16 9:04:00 [只看该作者]

请问以下vb代码如何修改可以在ft中使用
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:mi.zip



'''全局引用dll,引用的dll在附件中
   Declare Function API_PCDRead Lib "mi.dll" (ByVal handle As Integer, ByVal deviceAddr As Integer, ByVal mode As Byte, ByVal blk_Addr As Byte, ByVal Num_blk As Byte, ByRef snr As Byte, ByRef Buffer As Byte) As Integer

'''读卡代码
Private Sub cmdRead_Click()
    Dim ret As Integer
    Dim blk_Addr, devAddr As Integer
    Dim mode, Num_blk As Byte
    
    'Dim aKeyA(20) As Byte
    Dim asnr(20) As Byte
    Dim aRecvBuffer(2048) As Byte
    
    Dim strRet As String
      

    mode = &O0
    '设备地址,如果只有一个
    devAddr = myVal(cboAddress.Text)
     '读取开始地址
    blk_Addr = Val(cboStartReadAdress.Text)
    '读取模式
  If Option1.Value = True And opReadKeyA.Value = True Then mode = &O0
  If Option1.Value = True And opReadKeyB.Value = True Then mode = &O2
  If opReadAll.Value = True And opReadKeyA.Value = True Then mode = &O1
  If opReadAll.Value = True And opReadKeyB.Value = True Then mode = &O3
  
    '读取块数
    Num_blk = Val(cboStartReadNumber.Text)
    '一个指针,传递的是六个字节的密钥
    ret = hexToBin(cboReadKey.Text, asnr)
    
    ret = API_PCDRead(hComm, devAddr, mode, blk_Addr, Num_blk, asnr(0), aRecvBuffer(0))
    
    If ret = 0 Then
       lstEvents.AddItem ("读卡成功..")
       lstEvents.AddItem ("卡的序列号为: " + strByHex(asnr, 4))
       lstEvents.AddItem (CStr(Now) + " 读卡数据为:")
       lstEvents.AddItem (strByHex(aRecvBuffer, Num_blk * 16))
       Else
             If ret = Null Then
             lstEvents.AddItem (CStr(Now) + "  读卡出错,无数据接收...:")
             'End If
             'If ret = 1 Then
             'lstEvents.AddItem (CStr(Now) + "  false..")
             Else
             strRet = strByHex(aRecvBuffer, 1)
             lstEvents.AddItem (CStr(Now) + " 操作失败原因为:  " + falsereason(strByHex(aRecvBuffer, 1)))
             strRet = falsereason(strByHex(aRecvBuffer, 1))
             End If
       End If
    
End Sub

Function myVal(ByVal str As String)
    Dim retVal As Integer
    
    retVal = 0
    If Len(str) = 1 Then
        If str >= "0" And str <= "9" Then
            retVal = Val(str)
        ElseIf str >= "a" And str <= "z" Then
            retVal = Asc(str) - Asc("a") + 10
        ElseIf str >= "A" And str <= "Z" Then
            retVal = Asc(str) - Asc("A") + 10
        End If
    End If
        
    myVal = retVal

End Function

Function hexToBin(ByVal str As String, ByRef Buffer() As Byte)
    Dim strRemain As String
    Dim firstChar As Boolean
    Dim i, count, inputLen, remainLen As Integer
    
    i = 0
    count = 0
    firstChar = True
    strRemain = str
    
    While Len(strRemain) > 0
        If Mid(strRemain, 1, 1) = " " Then
            firstChar = True
            strRemain = Mid(strRemain, 2)
        ElseIf firstChar = True Then
            If Len(strRemain) = 1 Then
                Buffer(count) = myVal(strRemain)
            ElseIf Len(strRemain) >= 2 Then
                Buffer(count) = myVal(Mid(strRemain, 1, 1)) * 16 + myVal(Mid(strRemain, 2, 1))
                
                strRemain = Mid(strRemain, 3)
            End If
            
            count = count + 1
            firstChar = False
        Else
            strRemain = Mid(strRemain, 2)
        End If
    Wend
    
    hexToBin = count
End Function

'从数组中取多少为
Function strByHex(ByRef Buffer() As Byte, ByVal bufferSize As Integer)
        Dim i As Integer
        Dim strRet, strSingle As String
        
        strRet = ""
        For i = 0 To bufferSize - 1
            strSingle = Hex$(Buffer(i))
            If Len(strSingle) = 1 Then
              strSingle = "0" & strSingle
            End If
            
            If bufferSize = 1 Then
            strRet = strSingle
            Else
            strRet = strRet + strSingle + " "
            End If
            
        Next
        
        strByHex = strRet
End Function

[此贴子已经被作者于2018/11/16 9:16:22编辑过]

 回到顶部
总数 15 1 2 下一页