skqswjrj.txt

此为刷卡器充值上位机软件

Public QJBL As String
Public XSD As String

Private Sub COM1_Click()
On Error GoTo A:
COM1.Checked = True
COM2.Checked = False
COM3.Checked = False
COM4.Checked = False
COM5.Checked = False
COM6.Checked = False
If MSComm1.PortOpen = False Then
'MSComm1.PortOpen = False
MSComm1.CommPort = 1
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
MSComm1.CommPort = 1
MSComm1.PortOpen = True
End If
On Error GoTo A:
  Exit Sub              '注意语句
A:                      '这个也是
  MsgBox "      端口不可用      ", vbOKOnly, "端口错误"    '这个也是 一共4句代码
 'Command2.Enabled = False
End Sub

Private Sub COM2_Click()
Dim A As String
On Error GoTo A:      '错误处理，如果出错弹出窗口
COM2.Checked = True
COM1.Checked = False
COM3.Checked = False
COM4.Checked = False
COM5.Checked = False
COM6.Checked = False
If MSComm1.PortOpen = False Then
'MSComm1.PortOpen = False
MSComm1.CommPort = 2
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
MSComm1.CommPort = 2
MSComm1.PortOpen = True
End If
 Exit Sub '注意语句
 COM1_Click
  'a = 1
A:                      '这个也是
  MsgBox "      端口不可用      ", vbOKOnly, "端口错误"   '这个也是 一共4句代码
  COM1_Click
End Sub

Private Sub COM3_Click()
Dim A As String
On Error GoTo A:
COM3.Checked = True
COM2.Checked = False
COM1.Checked = False
COM4.Checked = False
COM5.Checked = False
COM6.Checked = False
If MSComm1.PortOpen = False Then
'MSComm1.PortOpen = False
MSComm1.CommPort = 3
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
MSComm1.CommPort = 3
MSComm1.PortOpen = True
End If
  Exit Sub              '注意语句
A:                      '这个也是
  MsgBox "      端口不可用      ", vbOKOnly, "端口错误"    '这个也是 一共4句代码
COM1_Click
End Sub

Private Sub COM4_Click()
Dim A As String
On Error GoTo A:
COM4.Checked = True
COM2.Checked = False
COM3.Checked = False
COM1.Checked = False
COM5.Checked = False
COM6.Checked = False
If MSComm1.PortOpen = False Then
'MSComm1.PortOpen = False
MSComm1.CommPort = 4
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
MSComm1.CommPort = 4
MSComm1.PortOpen = True
End If
  Exit Sub              '注意语句
A:                      '这个也是
  MsgBox "      端口不可用      ", vbOKOnly, "端口错误"
  COM1_Click
End Sub

Private Sub COM5_Click()
Dim A As String
On Error GoTo A:
COM5.Checked = True
COM2.Checked = False
COM3.Checked = False
COM4.Checked = False
COM1.Checked = False
COM6.Checked = False
If MSComm1.PortOpen = False Then
'MSComm1.PortOpen = False
MSComm1.CommPort = 5
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
MSComm1.CommPort = 5
MSComm1.PortOpen = True
End If
On Error GoTo A:
  Exit Sub              '注意语句
A:                      '这个也是
 MsgBox "      端口不可用      ", vbOKOnly, "端口错误"
 COM1_Click
End Sub

Private Sub COM6_Click()
Dim A As String
On Error GoTo A:
COM6.Checked = True
COM2.Checked = False
COM3.Checked = False
COM4.Checked = False
COM5.Checked = False
COM1.Checked = False
If MSComm1.PortOpen = False Then
'MSComm1.PortOpen = False
MSComm1.CommPort = 6
MSComm1.PortOpen = True
Else
MSComm1.PortOpen = False
MSComm1.CommPort = 6
MSComm1.PortOpen = True
End If
  Exit Sub              '注意语句
A:                      '这个也是
 MsgBox "      端口不可用      ", vbOKOnly, "端口错误"
 COM1_Click
End Sub

Public Sub Command1_Click()
'ICKCZ.Show
Dim maxx As Integer
Dim OT(0) As Byte
Dim X As String
Dim zz As Integer
Dim i As Integer
LJ = False
TT = False
'TMD = False
Text2.Text = "55D200D2"     '设置传送单片机的数据
Open "c:\ggz.txt" For Output As #1
Write #1, Text2.Text
Close #1
Open "c:\ggz.txt" For Input As #2
maxx = LOF(2)
For zz = 2 To maxx - 3 Step 2
Seek #2, zz
X = Input(2, #2)
OT(0) = Val("&H" & X)
MSComm1.Output = OT
'Text2.Text = Text2.Text & X
Next zz
Close #2
End Sub

Public Sub Command2_Click()
Dim maxx As Integer
Dim OT(0) As Byte
Dim X As String
Dim zz As Integer
Dim i As Integer
TT = False
LJ = False
QZ = QZ - 1
'Text8.Text = QZ
'TMD = False
Text2.Text = "55D2C89A"     '设置传送单片机的数据
Open "c:\ggz.txt" For Output As #1
Write #1, Text2.Text
Close #1
Open "c:\ggz.txt" For Input As #2
maxx = LOF(2)
For zz = 2 To maxx - 3 Step 2
Seek #2, zz
X = Input(2, #2)
OT(0) = Val("&H" & X)
MSComm1.Output = OT
Text2.Text = Text2.Text & X
Next zz
Close #2
End Sub

Private Sub Command3_Click()
ICKCZ.Show 1
'Form1.Show
End Sub

Private Sub Command4_Click()
SJK.Show 1
End Sub

Private Sub Command5_Click()
CW.Show 1
End Sub

Private Sub Command6_Click()
 Dim aaa As Form
 ' MsgBox "是否退出程序", vbYesNo, "退出程序"
 If MsgBox("是否退出程序", 32 & vbYesNo, "退出程序？") = vbYes Then '此为判断MSGBOX的响应
 For Each aaa In Forms
 Unload aaa
 Next
 End If
End Sub

Private Sub Command7_Click()
Dim maxx As Integer
Dim OT(0) As Byte
Dim SZ(1 To 9) As String
Dim X As String
Dim zz As Integer
Dim i As Integer
Dim J As Integer
Dim ICKH As String
LJ = False
TT = False
Text8.Text = QS & "." & Hex(QS)
If Len(Hex(QS)) < 2 Then
 Text6.Text = "55D2" & "0" & Hex(QS)
 Text7.Text = "0" & Hex(QS)
Else
 Text6.Text = "55D2" & Hex(QS)
 Text7.Text = Hex(QS)
End If

ICKH = Hex(Val("&H" & "D2") + Val("&H" & Text7.Text))
For J = 1 To Len(ICKH) Step 1
SZ(J) = Mid(ICKH, J, 1)
Next J

  Text2.Text = Text6.Text & SZ(Len(ICKH) - 1) & SZ(Len(ICKH)) '设置传送单片机的数据

Open "c:\ggz.txt" For Output As #1
Write #1, Text2.Text
Close #1
Open "c:\ggz.txt" For Input As #2
maxx = LOF(2)
For zz = 2 To maxx - 3 Step 2
Seek #2, zz
X = Input(2, #2)
OT(0) = Val("&H" & X)
MSComm1.Output = OT
Text2.Text = Text2.Text & X
Next zz
Close #2
QZ = 0
End Sub

Private Sub Command8_Click()
Form2.Show 1
End Sub

Private Sub CX_Click()
SJK.Show 1
End Sub

Private Sub DHK_Click()
Form2.Show 1
End Sub

Private Sub DIC_Click()
ICKCZ.Show 1
End Sub

Private Sub EER_Click()
Form2.Show
End Sub

Private Sub EXC_Click()
 Dim aaa As Form
 ' MsgBox "是否退出程序", vbYesNo, "退出程序"
 If MsgBox("是否退出程序", 32 & vbYesNo, "退出程序？") = vbYes Then '此为判断MSGBOX的响应
 For Each aaa In Forms
 Unload aaa
 Next
 End If
End Sub

Private Sub Form_Load()
On Error GoTo A:
MSComm1.RThreshold = 1 '接收二进制数据时一定要先设此项
MSComm1.PortOpen = True
MSComm1.OutBufferCount = 0
MSComm1.InBufferCount = 0
COM1.Checked = True
QQA = True
TT = False
 Exit Sub              '注意语句
A:                      '这个也是
  MsgBox "      找不到端口 请到通讯设置项选择端口      ", vbOKOnly, "端口错误"
End Sub



Private Sub GY_Click()
CW.Show 1
End Sub



Public Sub KCZ_Click()
ICKCZ.Show
End Sub

Private Sub MSComm1_OnComm()
Dim temp As Variant
Dim b As Long
Dim c As Long
Dim i As Integer
Dim IC(1 To 100) As String
Dim WR(1 To 9) As String
Dim WS As Integer
Dim GP As Integer
intinputlen = MSComm1.InBufferCount
Select Case MSComm1.CommEvent
Case comEvReceive
ReDim buff(1 To intinputlen) As Byte
buff = MSComm1.Input
For i = LBound(buff) To UBound(buff) Step 1
If Len(Hex(buff(i))) = 1 Then
                        Text1.Text = Text1.Text & "0" & Hex(buff(i))
                Else
                        Text1.Text = Text1.Text & Hex(buff(i))
                End If
Next i

M = Len(Text1.Text)
For i = 1 To M Step 2
IC(i) = Mid(Text1.Text, i, 2)
Next i
On Error GoTo A:
'If LJ = False Then
Form1.Text3.Text = Form1.Text3.Text & IC(1) & " " & IC(3) & " " & IC(5) & " " & IC(7) & " " & IC(9) & " " & IC(11) & " " & IC(13) & " "
'Text1.Text = ""
'Else
Select Case IC(3)
Case "C3"

If TT = True Then
Form2.Label3.Caption = IC(11) & IC(9) & IC(7) & IC(5)
Else
ICKCZ.Label9 = IC(11) & IC(9) & IC(7) & IC(5)
End If
Case "D2"
 Select Case IC(5)
 Case "01"
 MsgBox "此软件不能为空卡充值确", vbOKOnly, "空卡"
 Case "02"
 MsgBox "              客户码不对            ", vbOKOnly, "无效卡"
 Case "03"
 Form2.Label3.Caption = ""
 Form2.Label4.Caption = ""
 TT = False
 JE = False
 ICKCZ.Label6 = ""
 ICKCZ.Label9 = ""
 ICKCZ.Label10 = ""
' ICKCZ.Command1.Enabled = True
  Command1_Click
  Case "04"
  Form2.Label5.Caption = "卡已拔出"
  XS = "卡已拔出                                                                 "
  XQ = ""
  Text1.Text = ""
  Case "06"
  TT = True
  Form2.Label3.Caption = ""
 Form2.Label4.Caption = ""
  ICKCZ.Label6 = ""
 ICKCZ.Label9 = ""
 ICKCZ.Label10 = ""
  ICKCZ.Command1.Enabled = False
  Form2.Command1.Enabled = True
  Form2.Label5.Caption = "有坏卡插入"
  XQ = ""
  XS = "卡已锁定，请到读坏卡项查询余额                                            "

  'ICKCZ.Label8.Caption = "卡已锁定，请到读坏卡项查询余额                            "
  
  'MsgBox "              卡已锁定            ", vbOKOnly, "无效卡"
  End Select
Case "E1"

  If IC(11) = 0 Then
  If IC(9) = 0 Then
   If TT = True Then
   Form2.Label4 = Val(IC(7)) & "." & Val("&H" & IC(5))
   Form2.Label5.Caption = "读卡完毕"
   Else
  If JE = False Then
   ICKCZ.Label10.Caption = Val(IC(7)) & "." & Val("&H" & IC(5))
   Text3.Text = Val(IC(7))
   XSD = Val(IC(5))
   YE = Text3.Text
   XQ = ""
   'Form2.Label4.Caption = Val(IC(7)) & "." & IC(5) & "元"
  ' Form2.Label5.Caption = "读卡完毕"
XS = "有效卡插入，请充值                                                      "
ICKCZ.Command1.Enabled = True
   
  Else
  
   If Val("&H" & IC(5)) < 10 Then
   Text6.Text = Val(IC(7)) & "." & "0" & Val("&H" & IC(5))
   Text7.Text = Val(IC(7))
   Else
   Text6.Text = Val(IC(7)) & "." & Val("&H" & IC(5))
     ' MB = MB + Val(IC(7))
     End If
     End If
  End If
 Else
    If TT = True Then
   Form2.Label4 = Val(IC(9)) & Val(IC(7)) & "." & Val("&H" & IC(5))
   Form2.Label5.Caption = "读卡完毕"
    Else
  If JE = False Then
   ICKCZ.Label10.Caption = Val(IC(9)) & Val(IC(7)) & "." & Val("&H" & IC(5))
      Text3.Text = Val(IC(9)) & Val(IC(7))
   XSD = Val(IC(5))
   YE = Text3.Text
   XQ = ""
   'Form2.Label4.Caption = Val(IC(7)) & "." & IC(5) & "元"
   'Form2.Label5.Caption = "读卡完毕"
XS = "有效卡插入，请充值                                                      "
ICKCZ.Command1.Enabled = True

  Else
   If Val("&H" & IC(5)) < 10 Then
   'ICKCZ.Label6.Caption = Val(IC(9)) & Val(IC(7)) & "." & IC(5)
   Text6.Text = Val(IC(9)) & Val(IC(7)) & "." & "0" & Val("&H" & IC(5))
   Text7.Text = Val(IC(9)) & Val(IC(7))
   Else
   Text6.Text = Val(IC(9)) & Val(IC(7)) & "." & Val("&H" & IC(5))
   End If
     ' MB = MB + Val(IC(9)) & Val(IC(7))
  End If
  End If
 End If
Else

   If TT = True Then
   Form2.Label4 = Val(IC(11)) & Val(IC(9)) & Val(IC(7)) & "." & Val("&H" & IC(5))
   Form2.Label5.Caption = "读卡完毕"
   Else

 If JE = False Then
  ICKCZ.Label10.Caption = Val(IC(11)) & Val(IC(9)) & Val(IC(7)) & "." & Val("&H" & IC(5))
  Text3.Text = Val(IC(11)) & Val(IC(9)) & Val(IC(7))
  XSD = Val(IC(5))
  YE = Text3.Text
  XQ = ""
  'Form2.Label4.Caption = Val(IC(7)) & "." & IC(5) & "元"
 ' Form2.Label5.Caption = "读卡完毕"
  XS = "有效卡插入，请充值                                                       "
  ICKCZ.Command1.Enabled = True
 
 Else
  'ICKCZ.Label6.Caption = Val(IC(11)) & Val(IC(9)) & Val(IC(7)) & "." & Val(IC(5))
   'If Val(IC(5)) = 0 Then
    'Text6.Text = Val(IC(11)) & Val(IC(9)) & Val(IC(7))
  ' Else
  If Val("&H" & IC(5)) < 10 Then
    Text6.Text = Val(IC(11)) & Val(IC(9)) & Val(IC(7)) & "." & "0" & Val("&H" & IC(5))
    'Text7.Text = Val(IC(11)) & Val(IC(9)) & Val(IC(7))
     Else
     Text6.Text = Val(IC(11)) & Val(IC(9)) & Val(IC(7)) & "." & Val("&H" & IC(5))
     End If
      End If
  End If
End If
Text8.Text = QZ
If WC = True Then
 ICKCZ.Command3_Click
Else

WS = InStr(1, ICKCZ.Combo1.Text, ".", 1)
For i = 1 To Len(ICKCZ.Combo1.Text) Step 1
WR(i) = Mid(ICKCZ.Combo1.Text, i, 1)
Next i
If WS = 0 Then
Text5.Text = ICKCZ.Combo1.Text & "." & "00"
Else
 If WR(WS + 2) = "" Then
 Text5.Text = ICKCZ.Combo1.Text & "0"
 Else
 Text5.Text = ICKCZ.Combo1.Text
 End If
 End If
If Text6.Text = Text5.Text Then
ICKCZ.Label6.Caption = Text6.Text
SJK.Text8.Text = ICKCZ.Label6.Caption
Text6.Text = ""
Text7.Text = " "
XQ = ""
XS = "充值成功                                                                    "
ICKCZ.Command1.Enabled = False
SJK.Command2_Click
Timer1.Enabled = False
End If


If QZ > 1 Then
Command2_Click
Else
If QZ = 1 Then
Command7_Click
End If
End If
End If
'WS = InStr(1, ICKCZ.Combo1.Text, ".", 1)
'For i = 1 To Len(ICKCZ.Combo1.Text) Step 1
'WR(i) = Mid(ICKCZ.Combo1.Text, i, 1)
'Next i
'If WS = 0 Then
'Text5.Text = ICKCZ.Combo1.Text
'Else
'Select Case WS
'Case 2
'Text5.Text = WR(1)
'Case 3
'Text5.Text = WR(1) & WR(2)
'Case 4
'Text5.Text = WR(1) & WR(2) & WR(3)
'End Select
'End If
'If Text6.Text = ICKCZ.Combo1.Text Then
'ICKCZ.Label6.Caption = Text6.Text
'SJK.Text8.Text = ICKCZ.Label6.Caption
'Text6.Text = ""
'Text7.Text = " "
'XQ = ""
'XS = "充值成功                                                                    "
'ICKCZ.Command1.Enabled = False
'SJK.Command2_Click
'Timer1.Enabled = False
'End If
End Select
Text1.Text = ""
'End If
  Exit Sub              '注意语句
A:                      '这个也是
  MsgBox "      卡余额无法读取      ", vbOKOnly, "余额错误"
End Select
Text1.Text = ""
End Sub
Private Sub Form_Resize()
If Me.Height < 1000 Then
Image1.Height = Me.Height
Image1.Width = Me.Width
Label3.Top = Me.Height
Label3.Width = Me.Width
Frame1.Width = Me.Width
Else
Image1.Height = (Me.Height - 1630) '设置image的大小随窗口的变化而变化
Image1.Width = Me.Width
Label3.Top = (Me.Height - 1020)
Label3.Width = (Me.Width - 60)
Frame1.Width = (Me.Width - 60)
End If
End Sub

Private Sub Timer1_Timer()
XS = ""
XQ = "操作超时"
ICKCZ.Command1.Enabled = True
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then
'Unload Form6

 Dim aaa As Form
 ' MsgBox "是否退出程序", vbYesNo, "退出程序"
 If MsgBox("是否退出程序", 32 & vbYesNo, "退出程序？") = vbYes Then '此为判断MSGBOX的响应
 For Each aaa In Forms
 Unload aaa
 Next
 End If
End If
End Sub