frmcardmk.frm

用MSCOMM控件作的刷卡程序

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   360
      TabIndex        =   43
      Top             =   6840
      Width           =   2655
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      X1              =   0
      X2              =   9960
      Y1              =   990
      Y2              =   990
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   0
      X2              =   9840
      Y1              =   990
      Y2              =   990
   End
End
Attribute VB_Name = "frmCardmk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim CardType As Integer
Dim Cardkind As Integer
Dim NewCard As Boolean

Dim mKeyword As String
Dim mCardID As String
Dim mAmount As String
Dim mArea As String
Dim mCardCon As String
Dim RF32Type As Integer
Dim j As Integer
Dim iCommPort As Integer
Dim KeyPressed As Boolean
Dim mPassWord As String

Private Sub Check1_Click()
If Check1.Value = 1 Then
    Text4.Visible = True
Else
    Text4.Visible = False
End If

End Sub

Private Sub Command1_Click()
'写入数据
'先测试卡是否能写
Dim mTemp As String

Timer1.Enabled = False
Command1.Enabled = False
Label5.Visible = True
KeyPressed = False

Select Case Cardkind
Case 0      '用户卡
    If Len(Trim(Text2(0).Text)) < 8 Then Text2(0).Text = Trim(Text1(0).Text)
    
    If Len(Trim(Text2(2).Text)) < 4 Then
        MsgBox "区位码不够四位", vbOKOnly, "错误"
        Text2(2).SetFocu s
        Exit Sub
    End If
    Do While Len(Trim(Text2(1).Text)) < 4
        Text2(1).Text = "0" & Trim(Text2(1).Text)
    Loop
    
    mCardID = Trim(Text2(0).Text)
    mKeyword = Keyword(mCardID)
    mArea = Trim(Text2(2).Text) & "0000"
    mAmount = Trim(Text2(1).Text) & Trim(Text2(1).Text)
    mCardCon = "00088098"
    

Case 1  '脱机式授权卡
    If Len(Trim(Text2(0).Text)) < 4 Then
        MsgBox "区位码不够四位", vbOKOnly, "错误"
        Text2(0).SetFocus
        Exit Sub
    End If
    If Len(Trim(Text2(1).Text)) < 4 Then
        MsgBox "金额不够四位", vbOKOnly, "错误"
        Text2(1).SetFocus
        Exit Sub
    End If
    mCardID = "53475A01"
    If CardType = 0 Then
        mKeyword = "9A3AD03A"
    Else
        mKeyword = "4D1D6825"
    End If
    mArea = Trim(Text2(0).Text) & Trim(Text2(1).Text)      '区码+金额
  
    mCardCon = "00148078"
    

Case 2  '管理卡 （衣）
    If Len(Trim(Text2(0).Text)) < 4 Then
        MsgBox "区位码不够四位", vbOKOnly, "错误"
        Text2(0).SetFocus
        Exit Sub
    End If
    If Trim(Text2(1).Text) = "" Then Text2(1).Text = "1"
    If Trim(Text2(2).Text) = "" Then Text2(2).Text = "1"
    
    If CardType = 1 Then        '计次式
        mCardID = "00000000"
        mKeyword = "00000003"
        mArea = Trim(Text2(0).Text) & "0" & Trim(Text2(1).Text) & "0" & Trim(Text2(2).Text)      '区码+费率+时间
    Else                '一卡通
        
        mCardID = "FFFFFF01"
        mKeyword = "FFFFFC09"
        mTemp = Hex(Trim(Text2(1).Text))
        Do While (Len(mTemp) < 4)
        mTemp = "0" & mTemp
        
        Loop
        mArea = Trim(Text2(0).Text) & mTemp    '区码+费率+时间
    End If
    
    mCardCon = "00088098"

Case 3      '管理卡（浴）
    If Len(Trim(Text2(0).Text)) < 4 Then
        MsgBox "区位码不够四位", vbOKOnly, "错误"
        Text2(0).SetFocus
        Exit Sub
    End If
    If Trim(Text2(1).Text) = "" Then Text2(1).Text = "1"
    If Trim(Text2(2).Text) = "" Then Text2(1).Text = "1"

    mCardID = "00000000"
    mKeyword = "00000002"
    mArea = Trim(Text2(0).Text) & "0" & Trim(Text2(1).Text) & "0" & Trim(Text2(2).Text)    '区码+费率+时间
        
    mCardCon = "00088098"


Case Else   '清除卡
    If Len(Trim(Text2(0).Text)) < 4 Then
        MsgBox "区位码不足四位", vbOKOnly, "错误"
        Timer1.Enabled = True
        Text2(0).SetFocus
        Exit Sub
    End If
    
    If Cardkind = 4 Then        '清除卡（衣）
        mCardID = "FFFFFF0A"
        mKeyword = "FFFFFC2D"
        mArea = Trim(Text2(0).Text) & "0000"
    
    End If
    
    If Cardkind = 5 Then        '清除卡（浴）
        mCardID = "FFFFFFFF"
        mKeyword = "FFFFFF01"
        mArea = Trim(Text2(0).Text) & "0000"
    
    End If
    mCardCon = "00088098"


End Select

'写卡号
If Trim(Text1(6).Text) <> "" Then '全开模式则写
    If Trim(Text1(0).Text) <> mCardID Then WriteCard 1, mCardID
    If Trim(Text1(2).Text) <> mArea Then WriteCard 3, mArea
    If Trim(Text1(6).Text) <> mKeyword Then WriteCard 7, mKeyword
    If Cardkind = 0 Then
        If Trim(Text1(1).Text) <> mAmount Then WriteCard 2, mAmount
        If Trim(Text1(3).Text) <> mAmount Then WriteCard 4, mAmount
    End If
    mPassWord = ""
    WriteMode
Else
    mPassWord = mKeyword
    'mPassWord = ""
    If Cardkind = 0 Then        '用户卡
        If mArea <> Mid(Trim(Text1(2).Text), 1, 4) Then WriteCard 3, mArea
        If mAmount <> Trim(Text1(1).Text) Then
            WriteCard 2, mAmount
            WriteCard 4, mAmount
        End If
    Else   '其他卡
        If mArea <> Trim(Text1(2).Text) Then WriteCard 3, mArea
    End If
        
End If

Timer1.Enabled = True
Command1.Enabled = True
Label5.Visible = False

End Sub

Private Sub Command2_Click()
Unload Me

End Sub

Private Sub Command3_Click()
For j = 0 To 2
    Text2(j).Text = 0
Next j

End Sub

Private Sub Command4_Click()
If Len(Trim(Text3.Text)) < 8 Then
    MsgBox "不够八位", vbOKOnly, "错误"
    Text3.SetFocus
    Exit Sub
End If

If Check1.Value = 1 Then
    If Len(Trim(Text3.Text)) < 8 Then
        MsgBox "密码不够八位", vbOKOnly, "错误"
        Text4.SetFocus
        Exit Sub
    End If
    Open "bzero.000" For Output As #1 ' 打开输出文件。
    Print #1, Now; " "; Trim(Text3.Text); " "; Trim(Text4.Text)    ' 以空格隔开两个字符串。
    Close #1 ' 关闭文件。
End If
Timer1.Enabled = False
mCardCon = Trim(Text3.Text)
If Check1.Value = 1 Then
    mPassWord = Trim(Text4.Text)
Else
    mPassWord = ""
End If

WriteMode

Timer1.Enabled = True

End Sub

Private Sub Command5_Click()

Dim tCardtype As Integer
Dim ReBlank As Boolean

If Trim(Text1(0).Text) = "" Then
    MsgBox "没卡你恢复什么！！！", vbOKOnly, "胡闹"
    Exit Sub
End If

Timer1.Enabled = False

mCardCon = "000880E8"
mPassWord = ""
WriteMode
ReBlank = ReadCd
If ReBlank = True Then
    Timer1.Enabled = True
    Exit Sub
End If

If mCardID = "FFFFFF01" Then
    mPassWord = "FFFFFC09"
    WriteMode
    ReBlank = ReadCd
    If ReBlank = True Then
        Timer1.Enabled = True
        Exit Sub
    End If
End If

If mCardID = "53475A01" Then
    mPassWord = "9A3AD03A"
    WriteMode
    ReBlank = ReadCd
    If ReBlank = True Then
        Timer1.Enabled = True
        Exit Sub
    End If
    mPassWord = "4D1D6825"
    WriteMode
    ReBlank = ReadCd
    If ReBlank = True Then
        Timer1.Enabled = True
        Exit Sub
    End If
End If

If mCardID = "FFFFFFFA" Then
    mPassWord = "FFFFFFED"
    WriteMode
    ReBlank = ReadCd
    If ReBlank = True Then
        Timer1.Enabled = True
        Exit Sub
    End If
End If

If mCardID = "FFFFFFFF" Then
    mPassWord = "FFFFFF01"
    WriteMode
    ReBlank = ReadCd
    If ReBlank = True Then
        Timer1.Enabled = True
        Exit Sub
    End If
End If

tCardtype = CardType
CardType = 0
mPassWord = Keyword(mCardID)
WriteMode
ReBlank = ReadCd
If ReBlank = True Then
    CardType = tCardtype
    Timer1.Enabled = True
    Exit Sub
End If

CardType = 1
mPassWord = Keyword(mCardID)
WriteMode
CardType = tCardtype
ReBlank = ReadCd
If ReBlank = True Then MsgBox "这是来历不明的卡，无法恢复", vbOKOnly, "很遗憾"

Timer1.Enabled = True

End Sub

Private Sub Form_Activate()
Dim i As Integer

Timer1.Interval = 500
'Timer1.Enabled = False

'On Error GoTo NoCharger


End Sub


Private Sub Form_Load()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2 - 1000

Dim i As Integer
Text4.Visible = False
Label5.Visible = False
KeyPressed = False

Option1(0).Value = True     '默认为一卡通
Option1(1).Value = False

Option2(0).Value = True     '默认为用户卡
For i = 1 To 5
    Option2(i).Value = False
Next i

Dim Sbuf(7) As Byte
Dim Vsend As Variant
Dim Vgot As Variant
Dim ltime As Integer

Sbuf(0) = 126
Sbuf(1) = 245
Sbuf(2) = 1
Sbuf(3) = 1
Sbuf(4) = 1
Sbuf(5) = 1
Sbuf(6) = 245
Sbuf(7) = 13
Vsend = Sbuf

NewCard = True

iCommPort = 1
On Error GoTo NoCharger
FindPort:
MSComm1.CommPort = iCommPort
MSComm1.Settings = "9600,n,8,1"
MSComm1.InputMode = comInputModeBinary
MSComm1.InputLen = 8
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
MSComm1.PortOpen = True
MSComm1.Output = Vsend

ltime = 0
Do While MSComm1.InBufferCount = 0
ltime = ltime + 1
If ltime > 10000 Then Exit Do
Loop

For i = 0 To 4

    Vgot = MSComm1.Input
    If InStrB(Vgot, ChrB(13)) Then Exit For
Next i

If (MidB(Vgot, 1, 1) = ChrB(126)) And (MidB(Vgot, 2, 1) = ChrB(245)) Then Exit Sub

MSComm1.PortOpen = False
iCommPort = iCommPort + 1
If iCommPort < 5 Then GoTo FindPort

NoCharger:
    MsgBox "没有发现充值机，您不能进入软件", vbExclamation + vbOKOnly, "提示"

Unload Me

End Sub

Private Sub Option1_Click(Index As Integer)
CardType = Index
If Index = 1 Then
    Option2(5).Visible = False
    Option2(4).Visible = False
    Option2(3).Visible = False
    If Cardkind > 3 Then Option2(0).Value = True
Else
    Option2(3).Visible = True
    Option2(4).Visible = True
    Option2(5).Visible = True
End If

End Sub

Private Sub Option2_Click(Index As Integer)
Cardkind = Index

Text2(0).Text = ""
Text2(1).Text = ""
Text2(2).Text = ""

If Index = 0 Then       '用户卡
    For j = 1 To 2
        Label3(j).Visible = True
        Text2(j).Visible = True
        Text2(j).MaxLength = 4
    Next j
    
    Text2(0).MaxLength = 8
    Text2(0).Text = mCardID
    KeyPressed = False
    Label3(0).Caption = "卡号"
    Label3(1).Caption = "金额"
    Label3(2).Caption = "区号"
End If

If Index = 2 Then   '管理卡（衣）
    Label3(1).Visible = True
    Text2(1).Visible = True
    Label3(2).Visible = False
    Text2(2).Visible = False
    
    Text2(1).MaxLength = 3
    Text2(0).MaxLength = 4
    Label3(0).Caption = "区码"
    Label3(1).Caption = "费率"

End If

If Index = 3 Then     '管理卡
    For j = 1 To 2
        Label3(j).Visible = True
        Text2(j).Visible = True
        Text2(j).MaxLength = 1
    Next j
    Text2(0).MaxLength = 4
    
    Label3(0).Caption = "区码"
    Label3(1).Caption = "费率"
    Label3(2).Caption = "时间"

End If

If Index = 1 Then       '脱机式授权卡
    For j = 1 To 2
        Label3(j).Visible = True
        Text2(j).Visible = True
        Text2(j - 1).MaxLength = 4
    Next j

    Label3(0).Caption = "区号"
    Label3(1).Caption = "金额"
    Label3(2).Visible = False
    Text2(2).Visible = False
End If

If Index = 5 Or Index = 4 Then
    For j = 1 To 2
        Label3(j).Visible = False
        Text2(j).Visible = False
    Next j
    Text2(0).MaxLength = 4
    Label3(0).Caption = "区码"
    
End If





End Sub


Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    KeyAscii = 0
End Sub


Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8 Or KeyAscii = 45 Or KeyAscii > 64 And KeyAscii < 71 Or KeyAscii > 96 And KeyAscii < 103 Then
    If KeyAscii > 96 Then KeyAscii = KeyAscii - 32
    If Option2(0).Value = True Then KeyPressed = True
Else
  KeyAscii = 0
  Exit Sub
End If
If KeyAscii = 13 Then
    
        Command1.SetFocus
End If

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8 Or KeyAscii = 45 Or KeyAscii > 64 And KeyAscii < 71 Or KeyAscii > 96 And KeyAscii < 103 Then
    If KeyAscii > 96 Then KeyAscii = KeyAscii - 32
Else
  KeyAscii = 0
  Exit Sub
End If
If KeyAscii = 13 Then
    
        Command4.SetFocus
End If

End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8 Or KeyAscii = 45 Or KeyAscii > 64 And KeyAscii < 71 Or KeyAscii > 96 And KeyAscii < 103 Then
    If KeyAscii > 96 Then KeyAscii = KeyAscii - 32
Else
  KeyAscii = 0
  Exit Sub
End If
If KeyAscii = 13 Then
    
        Command4.SetFocus
End If
End Sub

Private Sub Timer1_Timer()

Dim GetData As Variant
Dim getText(7) As String
Dim Blocknum As Integer

On Error Resume Next
GetData = ReadCard(1)
Blocknum = AscB(MidB(GetData, 4, 1)) \ 4
If Blocknum = 0 Then
    GetData = ReadCard(0)
    Blocknum = AscB(MidB(GetData, 4, 1)) \ 4
    If Blocknum = 0 Then