以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  贴上神思二代身份证阅读器VB代码 求用来做狐表项目的实例,求解!  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=47256)

--  作者:李孝春
--  发布时间:2014/3/6 23:17:00
--  贴上神思二代身份证阅读器VB代码 求用来做狐表项目的实例,求解!

代码1:

Dim nRet As Long
Dim nCom As Integer
Dim bRun As Boolean

Private m_cIni As New cInifile

Private Declare Function UCommand1 Lib "RdCard.dll" (ByRef pCmd As Byte, ByRef para0 As Long, ByRef para1 As Long, ByRef para2 As Long) As Long

 

Function GetFolk(ByVal sIndex As String) As String
    With m_cIni
        .Path = App.Path & "\\Folk.INI"
        .Section = "Folk"
        .Key = sIndex
        .Default = "错误"
        GetFolk = .Value
        If Not (.Success) Then
            MsgBox "Failed to get value.", vbInformation
        End If
    End With
End Function


Private Sub BtExit_Click()
    If Timer1.Enabled Then
        Timer1.Enabled = False
        \'CloseComm
    End If
    End
End Sub

Private Sub BtReadNewAddr_Click()
    Dim sData As String
    Dim byData(256) As Byte
    Dim FileName As String
   
    \'nRet = Read_Content(3)
    If nRet = 1 Then
        \'
        FileName = App.Path & "\\NewAddr.txt"
        Open FileName For Binary Access Read Shared As FileNumber
        Get FileNumber, 1, byData
        sData = byData
        Trim sData
        sLnewaddr.Caption = sData
    Else
        txtMsg.Caption = "读追加信息失败"
    End If
End Sub

Private Sub Command1_Click()
    Dim FileName As String
    Dim FileNumber As Integer
    Dim FileLength As Long
   
    Dim sData As String
   
    Dim sName As String
    Dim byData(256) As Byte
    Dim sSex As String
    Dim sFolk As String
    Dim sBirth As String
    Dim sAddr As String
    Dim sID As String
    Dim sIssue As String
    Dim sBegin As String
    Dim sEnd As String
   
 
    On Error GoTo FileContainsError
    FileName = App.Path & "\\wz.txt"             \' "E:\\VB\\wz.txt"    \'调试时指定路径,因为VB调试是工作路径不是程序路径
    FileNumber = FreeFile
    Open FileName For Binary Access Read Shared As FileNumber
    FileLength = LOF(FileNumber)
    If FileLength = 256 Then
        Get FileNumber, 1, byData
        sData = byData
        FileLength = Len(sData)
        sName = Mid$(sData, 1, 15)
        Trim (sName)
        MsgBox sName, vbOKOnly, "Info", 0, 0
       
        sSex = Mid$(sData, 16, 1)
        MsgBox sSex, vbOKOnly, "Info", 0, 0
       
        sFolk = Mid$(sData, 17, 2)
        MsgBox sFolk, vbOKOnly, "Info", 0, 0
       
        sBirth = Mid$(sData, 19, 8)
        MsgBox sBirth, vbOKOnly, "Info", 0, 0
   
        sAddr = Mid$(sData, 27, 35)
        MsgBox sAddr, vbOKOnly, "Info", 0, 0
   
        sID = Mid$(sData, 62, 18)
        MsgBox sID, vbOKOnly, "Info", 0, 0
   
        sIssue = Mid$(sData, 80, 15)
        MsgBox sIssue, vbOKOnly, "Info", 0, 0
   
        sBegin = Mid$(sData, 95, 8)
        MsgBox sBegin, vbOKOnly, "Info", 0, 0
   
        sEnd = Mid$(sData, 103, 8)
        MsgBox sEnd, vbOKOnly, "Info", 0, 0
   
    End If
   
    Close FileNumber
    Exit Sub
   
FileContainsError:
   
    Select Case Err
        Case Else
                MsgBox Error$ & " on file " & FileName
            End Select
            Exit Sub
   
End Sub

 

 

Private Sub Form_Load()
    \'Exit Sub
    sLname.Caption = ""
    sLsex.Caption = ""
    sLfolk.Caption = ""
    sLbirth.Caption = ""
    sLAddr.Caption = ""
    sLissue.Caption = ""
    sLID.Caption = ""
    sLindate.Caption = ""
    sLnewaddr.Caption = ""
   
    Dim cmd As Byte
    Dim para0 As Long
    Dim para1 As Long
    Dim para2 As Long
   
   
    Picture1.Picture = LoadPicture(App.Path & "\\blank.bmp")
   
    Dim i As Long
   
    bRun = False    \'初始化定时器变量
        cmd = 65 \'0x41
        para0 = 0
        para1 = 8811
        para2 = 9986
       
        nRet = UCommand1(cmd, para0, para1, para2)
        If nRet = 62171 Then
            Timer1.Enabled = True
            txtMsg.Caption = nRet
            txtMsg.Caption = txtMsg.Caption + "连接机具成功"
        Else
            Timer1.Enabled = False
            txtMsg.Caption = nRet
            txtMsg.Caption = txtMsg.Caption + "连接机具失败"
           
        End If

   
End Sub

Private Sub Timer1_Timer()
    Dim cmd As Byte
    Dim para0 As Long
    Dim para1 As Long
    Dim para2 As Long

    Dim FileName As String
    Dim FileNumber As Integer
    Dim FileLength As Long
   
    Dim sData As String
   
    Dim sName As String
    Dim byData(256) As Byte
    Dim sSex As String
    Dim sFolk As String
    Dim sBirth As String
    Dim sAddr As String
    Dim sID As String
    Dim sIssue As String
    Dim sBegin As String
    Dim sEnd As String    \'
    If Not bRun Then
        bRun = True
        \'========================================================
        txtMsg.Caption = "请放卡..."
        cmd = 67 \'0x43
        para0 = 0
        para1 = 8811
        para2 = 9986
       
        nRet = UCommand1(cmd, para0, para1, para2)  \'验证卡
        If nRet = 62171 Then
            txtMsg.Caption = "正在读卡..."
            \'--------------------------------------------
            sLname.Caption = ""
            sLsex.Caption = ""
            sLfolk.Caption = ""
            sLbirth.Caption = ""
            sLAddr.Caption = ""
            sLissue.Caption = ""
            sLID.Caption = ""
            sLindate.Caption = ""
            sLnewaddr.Caption = ""
           
            Picture1.Picture = LoadPicture(App.Path & "\\blank.bmp")
            \'--------------------------------------------
            cmd = 68 \'0x44 读卡内信息
            para0 = 0
            para1 = 8811
            para2 = 9986
       
            nRet = UCommand1(cmd, para0, para1, para2)  \'读卡内信息

            If nRet = 62171 Then
                \'On Error GoTo FileContainsError
                FileName = App.Path & "\\wz.txt"             \' "E:\\VB\\wz.txt"    \'调试时指定路径,因为VB调试是工作路径不是程序路径
                FileNumber = FreeFile
                Open FileName For Binary Access Read Shared As FileNumber
                FileLength = LOF(FileNumber)
                If FileLength = 256 Then
                    Get FileNumber, 1, byData
                    sData = byData
                   
                    sName = Mid$(sData, 1, 15)
                    Trim (sName)
                    sLname.Caption = sName
                    \'MsgBox sName, vbOKOnly, "Info", 0, 0
                   
                    sSex = Mid$(sData, 16, 1)
                    Trim (sSex)
                    If sSex = "1" Then
                        sLsex.Caption = "男"
                    ElseIf sSex = "2" Then
                        sLsex.Caption = "女"
                    Else
                        sLsex.Caption = "非法"
                    End If
                    \'MsgBox sSex, vbOKOnly, "Info", 0, 0
                   
                    sFolk = Mid$(sData, 17, 2)
                    Trim (sFolk)
                    sLfolk.Caption = GetFolk(sFolk)
                    \'MsgBox sFolk, vbOKOnly, "Info", 0, 0
                   
                    sBirth = Mid$(sData, 19, 8)
                    Trim (sBirth)
                    sLbirth.Caption = Mid$(sBirth, 1, 4) + "年" + Mid$(sBirth, 5, 2) + "月" + Mid$(sBirth, 7, 2) + "日"
                    \'MsgBox sBirth, vbOKOnly, "Info", 0, 0
               
                    sAddr = Mid$(sData, 27, 35)
                    Trim (sAddr)
                    sLAddr.Caption = sAddr
                    \'MsgBox sAddr, vbOKOnly, "Info", 0, 0
               
                    sID = Mid$(sData, 62, 18)
                    Trim (sID)
                    sLID.Caption = sID
                    \'MsgBox sID, vbOKOnly, "Info", 0, 0
               
                    sIssue = Mid$(sData, 80, 15)
                    Trim (sIssue)
                    sLissue.Caption = sIssue
                    \'MsgBox sIssue, vbOKOnly, "Info", 0, 0
               
                    sBegin = Mid$(sData, 95, 8)
                    Trim (sBegin)
                    \'MsgBox sBegin, vbOKOnly, "Info", 0, 0
               
                    sEnd = Mid$(sData, 103, 8)
                    Trim (sEnd)
                    \'MsgBox sEnd, vbOKOnly, "Info", 0, 0
                    sLindate.Caption = sBegin + "-" + sEnd
                   
                    Picture1.Picture = LoadPicture(App.Path & "\\zp.bmp")
                   
                End If
               
                Close FileNumber
            ElseIf nRet = -5 Then
                MsgBox "软件未授权!", vbOKOnly, "提示信息", 0, 0
            End If
        End If
        \'========================================================
        bRun = False
    End If
End Sub

 

 

代码二:

Option Explicit
\' =========================================================
\' Class:    cIniFile
\' Author:   Steve McMahon
\' Date  :   21 Feb 1997
\'
\' A nice class wrapper around the INIFile functions
\' Allows searching,deletion,modification and addition
\' of Keys or Values.
\'
\' Updated 10 May 1998 for VB5.
\'   * Added EnumerateAllSections method
\'   * Added Load and Save form position methods
\' =========================================================

Private m_sPath As String
Private m_sKey As String
Private m_sSection As String
Private m_sDefault As String
Private m_lLastReturnCode As Long

#If Win32 Then
    \' Profile String functions:
    Private Declare Function WritePrivateProfileString Lib "KERNEL32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
    Private Declare Function GetPrivateProfileString Lib "KERNEL32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
#Else
    \' Profile String functions:
    Private Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Integer
    Private Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
#End If

Property Get LastReturnCode() As Long
    LastReturnCode = m_lLastReturnCode
End Property
Property Get Success() As Boolean
    Success = (m_lLastReturnCode <> 0)
End Property
Property Let Default(sDefault As String)
    m_sDefault = sDefault
End Property
Property Get Default() As String
    Default = m_sDefault
End Property
Property Let Path(sPath As String)
    m_sPath = sPath
End Property
Property Get Path() As String
    Path = m_sPath
End Property
Property Let Key(sKey As String)
    m_sKey = sKey
End Property
Property Get Key() As String
    Key = m_sKey
End Property
Property Let Section(sSection As String)
    m_sSection = sSection
End Property
Property Get Section() As String
    Section = m_sSection
End Property
Property Get Value() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer

    sBuf = Space$(255)
    iSize = Len(sBuf)
    iRetCode = GetPrivateProfileString(m_sSection, m_sKey, m_sDefault, sBuf, iSize, m_sPath)
    If (iSize > 0) Then
        Value = Left$(sBuf, iRetCode)
        m_lLastReturnCode = 1
    Else
        Value = ""
    End If

End Property
Property Let Value(sValue As String)
Dim iPos As Integer
    \' Strip chr$(0):
    iPos = InStr(sValue, Chr$(0))
    Do While iPos <> 0
        sValue = Left$(sValue, (iPos - 1)) & Mid$(sValue, (iPos + 1))
        iPos = InStr(sValue, Chr$(0))
    Loop
    m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, sValue, m_sPath)
End Property
Public Sub DeleteKey()
    m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, 0&, m_sPath)
End Sub
Public Sub DeleteSection()
    m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, 0&, m_sPath)
End Sub
Property Get INISection() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer

    sBuf = Space$(8192)
    iSize = Len(sBuf)
    iRetCode = GetPrivateProfileString(m_sSection, 0&, m_sDefault, sBuf, iSize, m_sPath)
    If (iSize > 0) Then
        INISection = Left$(sBuf, iRetCode)
    Else
        INISection = ""
    End If

End Property
Property Let INISection(sSection As String)
    m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, sSection, m_sPath)
End Property
Property Get Sections() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer

    sBuf = Space$(8192)
    iSize = Len(sBuf)
    iRetCode = GetPrivateProfileString(0&, 0&, m_sDefault, sBuf, iSize, m_sPath)
    If (iSize > 0) Then
        Sections = Left$(sBuf, iRetCode)
    Else
        SectiMaximised"
        Value = (frmThis.WindowState = vbMaximized) * -1
        If (frmThis.WindowState <> vbMaximized) Then
            Key = "Left"
            Value = frmThis.Left
            Key = "Top"
            Value = frmThis.Top
            Key = "Width"
            Value = frmThis.Width
            Key = "Height"
            Value = frmThis.Height
        End If
    End If
    Key = sSaveKey
    Exit Sub
SaveError:
    Key = sSaveKey
    m_lLastReturnCode = 0
    Exit Sub
End Sub
Public Sub LoadFormPosition(ByRef frmThis As Object, Optional ByRef lMinWidth = 3000, Optional ByRef lMinHeight = 3000)
Dim sSaveKey As String
Dim sSaveDefault As String
Dim lLeft As Long
Dim lTOp As Long
Dim lWidth As Long
Dim lHeight As Long
On Error GoTo LoadError
    sSaveKey = Key
    sSaveDefault = Default
    Default = "FAIL"
    Key = "Left"
    lLeft = CLngDefault(Value, frmThis.Left)
    Key = "Top"
    lTOp = CLngDefault(Value, frmThis.Top)
    Key = "Width"
    lWidth = CLngDefault(Value, frmThis.Width)
    If (lWidth < lMinWidth) Then lWidth = lMinWidth
    Key = "Height"
    lHeight = CLngDefault(Value, frmThis.Height)
    If (lHeight < lMinHeight) Then lHeight = lMinHeight
    If (lLeft < 4 * Screen.TwipsPerPixelX) Then lLeft = 4 * Screen.TwipsPerPixelX
    If (lTOp < 4 * Screen.TwipsPerPixelY) Then lTOp = 4 * Screen.TwipsPerPixelY
    If (lLeft + lWidth > Screen.Width - 4 * Screen.TwipsPerPixelX) Then
        lLeft = Screen.Width - 4 * Screen.TwipsPerPixelX - lWidth
        If (lLeft < 4 * Screen.TwipsPerPixelX) Then lLeft = 4 * Screen.TwipsPerPixelX
        If (lLeft + lWidth > Screen.Width - 4 * Screen.TwipsPerPixelX) Then
            lWidth = Screen.Width - lLeft - 4 * Screen.TwipsPerPixelX
        End If
    End If
    If (lTOp + lHeight > Screen.Height - 4 * Screen.TwipsPerPixelY) Then
        lTOp = Screen.Height - 4 * Screen.TwipsPerPixelY - lHeight
        If (lTOp < 4 * Screen.TwipsPerPixelY) Then lTOp = 4 * Screen.TwipsPerPixelY
        If (lTOp + lHeight > Screen.Height - 4 * Screen.TwipsPerPixelY) Then
            lHeight = Screen.Height - lTOp - 4 * Screen.TwipsPerPixelY
        End If
    End If
    If (lWidth >= lMinWidth) And (lHeight >= lMinHeight) Then
        frmThis.Move lLeft, lTOp, lWidth, lHeight
    End If
    Key = "Maximised"
    If (CLngDefault(Value, 0) <> 0) Then
        frmThis.WindowState = vbMaximized
    End If
    Key = sSaveKey
    Default = sSaveDefault
    Exit Sub
LoadError:
    Key = sSaveKey
    Default = sSaveDefault
    m_lLastReturnCode = 0
    Exit Sub
End Sub
Public Function CLngDefault(ByVal sString As String, Optional ByVal lDefault As Long = 0) As Long
Dim lR As Long
On Error Resume Next
    lR = CLng(sString)
    If (Err.Number <> 0) Then
        CLngDefault = lDefault
    Else
        CLngDefault = lR
    End If
End Function


 


 


图片点击可在新窗口打开查看此主题相关图片如下:qq图片20140306231528.jpg
图片点击可在新窗口打开查看
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:ucmdvb6.rar


--  作者:李孝春
--  发布时间:2014/3/6 23:34:00
--  神思RdCardV2.3.0.0动态库使用说明

神思RdCardV2.3.0.0动态库使用说明

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:神思rdcardv2.3.0.0动态库使用说明.rar

[此贴子已经被作者于2014-3-6 23:34:52编辑过]

--  作者:李孝春
--  发布时间:2014/3/7 0:35:00
--  直接采用官方身份证获取例子,运行图如下!


图片点击可在新窗口打开查看此主题相关图片如下:4.jpg
图片点击可在新窗口打开查看
不能正确生成对应的信息,求解!

经过分析,还是没有正确定义全局代码,没有能够正确分析到打开端口 关闭端口 读卡等代码,求解!


--  作者:李孝春
--  发布时间:2014/3/7 10:17:00
--  求教
求教
--  作者:2
--  发布时间:2014/3/7 10:56:00
--  
沙发
--  作者:gua12gua
--  发布时间:2014/3/7 12:17:00
--  

foxtable帮助里的实例是针对特定型号的读卡器吧,硬件不同,代码可能要修改了,最简单的解决方法是购买实例中提到的指定型号的硬件。