form2.frm

停车场收费系统

                Label29.Caption = FKcont0
                
                For i = 0 To 400
                    DoEvents
                Next i
                   readk0
                   Timer2.Enabled = True
                
            End If
            
            If kj0(2) = 0 And kj0(3) = &H82 Then
                FKcont0 = (kj0(4) And &HF) * 100 + ((kj0(5) And &HF0) / 16) * 10 + (kj0(5) And &HF)
                Label29.Caption = FKcont0
            End If
            
            If kj0(2) = 1 And kj0(3) = &H83 Then
               
            End If
            
            If kj0(2) = 1 And kj0(3) = &H8A Then
                FKcont0 = (kj0(4) And &HF) * 100 + ((kj0(5) And &HF0) / 16) * 10 + (kj0(5) And &HF)
                Label29.Caption = FKcont0
                '抬栏杆

                
                If cws0 > 0 Then
                    cws0 = cws0 - 1
                    Label8.Caption = cws0
                    cwxs0
                End If
            End If
            If kj0(2) = 1 And kj0(3) = &H8E Then
                FKcont0 = (kj0(4) And &HF) * 100 + ((kj0(5) And &HF0) / 16) * 10 + (kj0(5) And &HF)
                Label29.Caption = FKcont0
                  '抬栏杆

                
                If cws0 > 0 Then
                    cws0 = cws0 - 1
                    Label8.Caption = cws0 '剩余车位
                    cwxs0
                End If
            End If
            
            
            If kj0(2) = &HE2 And kj0(3) = 0 Then
                Fkrdb = 0
'                INPORT
'                i0 = PortIn And &H1
                i = kj0(4) * 256 + kj0(5) '卡号
                
                If i = kNOb0 Or tkb0 = 55 Or i0 = 1 Then
                    If tkb0 = 55 Or i0 = 1 Then
                        Fkrdb = 5
                    End If
                Else
                    kNOb0 = i '卡号
                    Command10_Click '执行相应的操作
                End If
                Tk00 '发卡机退卡
            End If
            If kj0(2) = &HE2 And kj0(3) = 1 Then
                Fkrdb = 0
            End If
            
            'Tk0
         addrc = 0
        Else
            addr01 = addr01 Xor addr
            addrc = addrc + 1
            If addrc > 40 Then
                addrc = 0
                Tk00
            End If
        End If
        
      End Select
       
       
     Loop Until MSComm1.InBufferCount = 0
    End If
    Case comEvSend
      sendok = 1
 End Select
End Sub

Private Sub MSComm2_OnComm() '收卡机窜口事件
Dim m As String
Dim k0() As Byte
Dim k As Byte
Dim addr As Byte
Select Case MSComm2.CommEvent
    Case comEventRxOver
      MSComm2.InBufferCount = 0
      
    Case comEventTxFull
      sendok1 = 0
    Case comEvReceive
    If MSComm2.InBufferCount > 0 Then
     Do
      MSComm2.InputLen = 1
      m = MSComm2.Input
      k0() = m
      addr = k0(0)
     'Text21.Text = Text21.Text + " " + Hex(addr)
     'skTime = 0
      Select Case addrc1
       
       Case 0
        If addr = &HAA Then
            addr11 = addr
            kj1(0) = 0
            addrc1 = 1
        End If
       Case 1
        If addr = &HBB Then
            addr11 = addr11 Xor addr
            addrc1 = 2
        Else
            If addr = &HDD Then
                SkSend = 1
            End If
            addrc1 = 0
        End If
       Case 2
        kj1(addrc1) = addr
        addr11 = addr11 Xor addr
        addrc1 = addrc1 + 1
       Case Else
        kj1(addrc1) = addr
        If addr11 = addr And kj1(addrc1 - 1) = &HCC And kj1(addrc1 - 2) = &HAA Then
            If kj1(2) = 0 And kj1(3) = &H8B Then
                SKcont0 = (kj1(4) And &HF) * 100 + ((kj1(5) And &HF0) / 16) * 10 + (kj1(5) And &HF)
                Label30.Caption = SKcont0
                
                For i = 0 To 400
                    DoEvents
                Next i
                readk1
                Timer3.Enabled = True
                
            End If
            If kj1(2) = 0 And kj1(3) = &H83 Then
                SKcont0 = (kj1(4) And &HF) * 100 + ((kj1(5) And &HF0) / 16) * 10 + (kj1(5) And &HF)
                Label30.Caption = SKcont0
                For i = 0 To 400
                    DoEvents
                Next i
                readk1
                Timer3.Enabled = True
                'retfk0
            End If
            
            If kj1(2) = 1 And kj1(3) = &H8A Then
                'retck0
                SKcont0 = (kj1(4) And &HF) * 100 + ((kj1(5) And &HF0) / 16) * 10 + (kj1(5) And &HF)
                Label30.Caption = SKcont0 '剩余卡
                'Str(kj1(4))
                'Str(SKcont0)
                
                
            End If
            
            If kj1(2) = &HE2 And kj1(3) = 0 Then
                Skrdb = 0
                i = kj1(4) * 256 + kj1(5) '读取的卡号
                
                If i = kNOb1 Then
                
                Else
                    kNOb1 = i
                    If i = kNOb0 Then
                        kNOb0 = 10000
                    End If
                    Command11_Click '相应的操作
                End If
                
            End If
            
         addrc1 = 0
        Else
            addr11 = addr11 Xor addr
            addrc1 = addrc1 + 1
            If addrc1 > 40 Then
                addrc1 = 0
                Tk1
            End If
        End If
        
      End Select
       
       
     Loop Until MSComm2.InBufferCount = 0
    End If
    Case comEvSend
      sendok1 = 1
 End Select
End Sub
Private Sub readk1() '收卡机读卡
  Dim FK(7) As Byte
  
    FK(0) = &HAA
    FK(1) = &HBB
    FK(2) = &HE2
    FK(3) = &H4
    FK(4) = &H10
    FK(5) = &HAA
    FK(6) = &HCC
    FK(7) = &H81
  
    Skrdb = 5
    MSComm2.Output = FK()
    
End Sub
Private Sub Sk1() '收卡机收卡
    Dim FK(20) As Byte
    FK(0) = &HAA
    FK(1) = &HBB
    FK(2) = &H1
    FK(3) = &HAA
    FK(4) = &HCC
    FK(5) = &H76
    MSComm2.Output = FK()
End Sub
Private Sub Tk1() '收卡机退卡
  Dim FK(20) As Byte
    FK(0) = &HAA
    FK(1) = &HBB
    FK(2) = &H2
    FK(3) = &HAA
    FK(4) = &HCC
    FK(5) = &H75
    SkSend = 0
    MSComm2.Output = FK()
End Sub
Private Sub readk0() '发卡机读卡
  Dim dat(7) As Byte
  'For i0 = 0 To 10
    dat(0) = &HAA
    dat(1) = &HBB
    dat(2) = &HE2
    dat(3) = &H4
    dat(4) = &H10
    dat(5) = &HAA
    dat(6) = &HCC
    dat(7) = &H81
    Fkrdb = 5
    MSComm1.Output = dat()
   
End Sub
Private Sub cwxs0()
  Dim mn As String
  Dim i0, i1, i2 As Byte
  i0 = Int(cws0 / 100)
  i1 = Int((cws0 - i0 * 100) / 10)
  i2 = cws0 - i0 * 100 - i1 * 10
  
  mn = Trim(Chr(&H55)) + Trim(Chr(&H0)) + Trim(Chr(i0)) + Trim(Chr(i0))
  MSComm1.Output = mn
  
End Sub

Private Sub Tk0() '发卡机监测地感退卡
Dim i As Byte
 INPORT
 i = PortIn And &H1
 If i = 0 And tkb0 <> 55 Then
    Tk00
    tkb0 = 55
 End If
End Sub
Private Sub Tk00() '发卡机退卡
  Dim FK(20) As Byte
  
    FK(0) = &HAA
    FK(1) = &HBB
    FK(2) = &H1
    FK(3) = &HAA
    FK(4) = &HCC
    FK(5) = &H76
    FkSend = 0
    MSComm1.Output = FK()
  
End Sub

Private Sub SSCommand2_Click()
Tk1 '出口退卡
End Sub

Private Sub SSCommand3_Click()
Sk1 '出口收卡
End Sub

Private Sub SSCommand4_Click() '免费放行车辆
If icflag = 1 Then '10月14日修改
  icflag = 0
  i = MsgBox("   确认免费放行车辆吗？  ") ', 289, "")
  'i = 0
  If i = 1 Then

    If Name8(4) = "nnnn" Then
          
      Name8(8) = Trim(Text15.Text)
      Name8(2) = Trim(Format(Date, "yyyymmdd")) '出场日期"
      Name8(3) = Trim(Format(Time, "hhmmss"))  '"出场时间"
      Name8(10) = Name8(2) + Name8(3) + ".bmp"    '出场图片
    Else
    
      Name8(8) = Trim(Text15.Text)
    
'      Adodc1.Recordset.MoveFirst
'     Do While Adodc1.Recordset.EOF = False
'      If Trim(Name8(4)) = Trim(Text1(4).Text) Then
'
'      Adodc1.Recordset.Delete
'      Adodc1.Recordset.MoveFirst
'
'       Exit Do
'      Else
'       Adodc1.Recordset.MoveNext
'      End If
'     Loop
    End If
    Text13.Text = ""
    Text14.Text = ""
    Text15.Text = ""
    With MSFlexGrid2
      .Col = 1
      .Row = 0
      .Text = ""
      .Row = 1
      .Text = "" '"入场时间:"
      .Row = 2
      .Text = "" ' "出场时间:"
      .Row = 4
      .Text = "" ' "持卡类型:"
      .Row = 3
      .Text = "" ' "应收金额:"
      .Row = 5
      .Text = "" ' "车主姓名:"
      .Row = 6
      .Text = "" ' "车牌号码:"
      .Row = 7
      .Text = ""   ' "车身颜色:"
      .Row = 8
      .Text = "" ' "证件号码:"
    End With
    Image1.Picture = LoadPicture("")
'    Name8(4) = "nnnn"
'
'    PortOut = PortOut Or &H10
'    OUTPORT
'    For i = 0 To 10000
'        DoEvents
'    Next i
'    PortOut = PortOut And &HEF
'    OUTPORT
  '  play0 "d:\收费声音\mf.wav"
    cws0 = cws0 + 1
    Label8.Caption = cws0
    cwxs0
  End If
Else '10月14日修改
'play0 "d:\收费声音\sk.wav"
icflag = 0
End If '10月14日修改
End Sub

Private Sub SSCommand5_Click()
   Tk00 '入口退卡
End Sub

Private Sub SSCommand6_Click() '免费放行
Dim name1(15) As String
Dim name0(10) As String
    i = MsgBox("   确认放行无卡车辆吗？  ") ', 289, "")
    If i = 1 Then
       
     name1(0) = "无卡"
     name1(1) = Format(Date, "yyyymmdd") '"入场日期"
     name1(2) = Format(Time, "hhmmss")  '"入场时间"
     name1(4) = Str(nobuf)
     name1(5) = CpuName
     name1(3) = "无卡"
        
    With MSFlexGrid1
        
      
      m = 7
      For j = 1 To 7
       .Col = 1
       .Row = m
       For i = 1 To 5
        name0(i) = .Text
        If i >= 5 Then
        Else
        .Col = .Col + 1
        End If
       Next i
       .Row = .Row + 1
       .Col = 1
       For i = 1 To 5
        .Text = name0(i)
        If i >= 5 Then
        Else
        .Col = .Col + 1
        End If
       Next i
       m = m - 1
       If m = 0 Then j = 9
      Next j
       
       .Row = 1
       .Col = 1
       For i = 1 To 5
        .Text = name1(i - 1)