mdumain.bas

磁条读写机

Attribute VB_Name = "mduMain"
Option Explicit
Public hPort As Long
Public DataBuffer(128) As Byte
Sub Main()
hPort = -1
frmMain.Show
End Sub

Sub OpenReader()
hPort = SC_OpenReader("USB", "")
If (hPort < 0) Then
    ReportError
    End
End If
End Sub

Sub ReportError()
    Dim strDesc As String
    strDesc = Space(1001)
    SCHelp_ErrorDesc SC_GetLastError, strDesc, 100
    MsgBox "error code:" & SC_GetLastError & Chr(10) & Chr(13) & strDesc
End Sub

Sub Connect()
    Dim ATR(4) As Byte
    If 0 = SC_Connect(hPort, "AT24", "", ATR(0)) Then
        ReportError
    Else
        Dim strHex As String
        strHex = Space(8)
        SCHelp_BytesToHexString ATR(0), 4, strHex
        MsgBox strHex
    End If
End Sub

Function WriteCard(ByVal lPageList As Long, ByVal stPageAddr As Long, ByVal stOffset As Long, ByVal count As Long) As Boolean
    If 0 = SCAT24_Write(hPort, lPageList * 2 + &HA0, stPageAddr + stOffset, DataBuffer(stOffset), count) Then
        ReportError
        WriteCard = False
    Else
        MsgBox "Write OK"
        WriteCard = True
    End If
End Function

Function ReadCard(ByVal lPageList As Long, ByVal lAddr As Long) As Boolean
If 0 = SCAT24_Read(hPort, lPageList * 2 + &HA0, lAddr, DataBuffer(0), 128) Then
    ReportError
    ReadCard = False
Else
    MsgBox "Read OK!"
    ReadCard = True
End If
End Function

'下面的函数WriteStr直接向卡写入字符串,此处的代码没有实用价值，仅用于提供代码演示
'实际上SCAT24_WriteStr和SCAT24_Write是同一个函数,但使用了不同的声明方式,用户可根据实际需要进行调用
'this function only is a demo how to write a string to card using "SCAT24_WriteStr"
Function WriteStr(ByVal strText As String) As Boolean
strText = strText + Space(128)
If 0 = SCAT24_WriteStr(hPort, &HA0, 0, strText, 128) Then
    ReportError
    WriteStr = False
Else
    MsgBox "Write String is OK!"
    WriteStr = True
End If
End Function

'this function only is a demo how to read a string to card using "SCAT24_ReadStr"
Function ReadStr(strText As String) As Boolean
strText = Space(128)
If 0 = SCAT24_ReadStr(hPort, &HA0, 0, strText, 128) Then
    ReportError
    ReadStr = False
Else
    MsgBox "Read String is OK! "
    strText = Trim(strText)
    ReadStr = True
End If
End Function


Function GetDataBufferString() As String
Dim strHex As String
GetDataBufferString = ""
Dim i As Long
For i = 0 To 127
    strHex = Space(2)
    SCHelp_BytesToHexString DataBuffer(i), 1, strHex
    GetDataBufferString = GetDataBufferString & strHex & " "
Next
End Function

Sub GetBufferData(ByVal strText As String)
    SCHelp_HexStringToBytes strText, DataBuffer(0), 128
End Sub