mdb.frm

一种用于 MDB 介面的主机通讯程序. MDB 是一种国际标准的自动售货机内部通讯协议

Private Sub Form_Load()
    Dim ii As Integer
    Do
    comm2
    ReadBytes (4)
    Loop
    
   ' If blnPortBusy = False Then Timer1.Enabled = True
    change_set = True
    NAK_cnt = 10
    comport = 1
    
    For ii = 0 To 15
        billEnable(ii) = True
    Next ii
    Reset
End Sub

Private Sub comm1()
On Error GoTo commerror
    With MDB.MSComm
        If .PortOpen = True Then .PortOpen = False
        .CommPort = comport
        .Settings = "9600, m, 8, 1" ' bit9=1"
        .InputLen = 1
        .InputMode = comInputModeBinary
        .RThreshold = 0
        .SThreshold = 0
        '.ParityReplace = ""
        .PortOpen = True
    End With
    blnPortBusy = False
    Exit Sub
    
commerror:
    MsgBox "RS232 Port is in using!"
    blnPortBusy = True
End Sub

Private Sub comm2()
On Error GoTo commerror
    With MDB.MSComm
        If .PortOpen = True Then .PortOpen = False
        .CommPort = 1 'comport
        .Settings = "9600, s, 8, 1"  ' bit9=0"
        .InputLen = 1
        .InputMode = comInputModeBinary
        .RThreshold = 0
        .SThreshold = 0
  '      .ParityReplace = ""
        .PortOpen = True
    End With
    blnPortBusy = False
    Exit Sub
    
commerror:
    MsgBox "RS232 Port is in using!"
    blnPortBusy = True
End Sub

Private Sub ReadBytes(inCnt As Integer)
'received a byte, then stored into bytBuffer(1)
'10ms timeout = NAK (FFH)
    Dim intLength As Integer
    Dim varMessage As Variant
    Dim ss As String
    Dim ii As Integer
    Dim inbytesCnt As Integer
    
    inbytesCnt = 0
    timeOver1 = 0

    bytin(0) = &HFF    'default NAK
    Do
        MSComm.InBufferCount = 0
        MSComm.InputLen = 1
        timeOver2 = 0

        Do
             VBA.DoEvents
             intLength = MSComm.InBufferCount
        Loop Until intLength = 1 Or timeOver2 > 1

        timeOver2 = 0

        
         If intLength > 0 Then
             varMessage = MSComm.Input  ' read in bytes from input buffer
             For ii = LBound(varMessage) To UBound(varMessage)
                bytin(inbytesCnt + ii) = varMessage(ii)
                ss = Hex(bytin(inbytesCnt + ii))
                txt_BVsay = txt_BVsay + ss + " "
             Next ii
         End If
         
         inbytesCnt = inbytesCnt + intLength
    Loop Until inbytesCnt >= inCnt Or timeOver1 > 10
    
End Sub


Private Sub status()
 Dim ss As String
 Dim ii As Integer
 Dim chksum As Integer
        
        comm1
        send1byte &H31     'status
        
        comm2
        send1byte &H31    'chksum
        
        txt_hostSay = txt_hostSay + "Status31/31 "
        lbl_status = ""
        
        ReadBytes (28)

        chksum = 0
        For ii = 0 To 26
            ss = Hex(bytin(ii))
            If bytin(ii) < 16 Then ss = "0" + ss
            lbl_status = lbl_status + ss + " "
            
            chksum = chksum + bytin(ii)
        Next ii
        
        If chksum Mod 256 = bytin(27) Then
            ACK
            For ii = 0 To 15
                 If bytin(ii + 11) <> 0 Then txt_vend(ii) = bytin(ii + 11)
            Next ii
        End If

End Sub

Private Sub expansion()
 Dim ss As String
 Dim ii As Integer
 Dim chksum As Integer

        comm1
        send1byte &H37     'expansion
        
        comm2
        send1byte &H0     'sub
        
        send1byte &H37     'checksum
        
        txt_hostSay = txt_hostSay + "expan37/0/37 "
        lbl_expansion = ""
        ReadBytes (30)
        For ii = 0 To 28
            ss = Hex(bytin(ii))
            If bytin(ii) < 16 Then ss = "0" + ss
            lbl_expansion = lbl_expansion + ss + " "
            chksum = chksum + bytin(ii)
        Next ii
        
        If chksum Mod 256 = bytin(29) Then ACK
    
End Sub

Private Sub send1byte(byt As Byte)
    With MSComm
         .OutBufferCount = 0
        
        bytBuffer(0) = byt     'expansion
        MSComm.Output = bytBuffer
        
        Do
            VBA.DoEvents
        Loop Until .OutBufferCount = 0
    End With
    
End Sub

Private Sub mnubill_Click(Index As Integer)
    mnubill(Index).Checked = Not (mnubill(Index).Checked)
    billEnable(Index) = mnubill(Index).Checked
    lal_type(Index).Enabled = mnubill(Index).Checked
End Sub

Private Sub MnuBillType_Click()
    BillType (255)
End Sub

Private Sub mnuclear_Click()
    Dim ii As Integer
    For ii = 0 To 15
        txt_noteCount(ii) = ""
        billCnt(ii) = 0
    Next ii
End Sub

Private Sub mnucom1_Click()
    comport = 1
    mnucom1.Checked = True
    mnucom2.Checked = False
End Sub
Private Sub mnucom2_Click()
    comport = 2
    mnucom2.Checked = True
    mnucom1.Checked = False
End Sub


Private Sub mnuDisall_Click()
    Dim ii As Integer
    For ii = 0 To 15
         mnubill(ii).Checked = False
         billEnable(ii) = False
         lal_type(ii).Enabled = False
    Next ii
    BillType (0)
End Sub

Private Sub mnuenall_Click()
    Dim ii As Integer
    For ii = 0 To 15
         mnubill(ii).Checked = True
         billEnable(ii) = True
         lal_type(ii).Enabled = True
    Next ii
    BillType (255)
End Sub

Private Sub mnuExpansion_Click()
    expansion
End Sub

Private Sub mnuoff_Click()
    Timer2.Enabled = False
    mnuoff.Checked = True
    mnuOn.Checked = False
End Sub

Private Sub mnuOn_Click()
  '  Timer2.Enabled = True
    mnuoff.Checked = False
    mnuOn.Checked = True
End Sub



Private Sub mnureset_Click()
    Reset
End Sub

Private Sub mnustatus_Click()
    status
End Sub

Private Sub Timer1_Timer()

    timeOver1 = timeOver1 + 1
    If timeOver1 > 20 Then timeOver1 = 0
    
    timeOver2 = timeOver2 + 1
    If timeOver2 > 20 Then timeOver2 = 0
    
    If Len(txt_hostSay.Text) > 220 Then txt_hostSay = ""

End Sub
Private Sub Timer2_Timer()
    Poll
    status  '
End Sub

Private Sub Poll()
    
    Dim ii As Integer
    Dim ss As String
    Dim byt2 As Byte
    
        If Len(txt_BVsay.Text) > 150 Then txt_BVsay = ""
        txt_hostSay = txt_hostSay + "Poll33/33 "
        comm1
        send1byte &H33  'poll
        
        comm2
        send1byte &H33   'chksum

        send1byte &H0
     
        ReadBytes (1)
        
        If bytin(0) = &HFF Then
            NAK_cnt = NAK_cnt + 1
            If NAK_cnt > 5 Then NAK_cnt = 5
            Exit Sub
        Else
            If NAK_cnt > 4 Then Reset
        End If
        
        If bytin(0) >= &H80 Then
            If bytin(0) <> bytin(1) Then Exit Sub   'checksum
        End If
        
        If bytin(0) >= &H80 And bytin(0) < &H90 Then    'stked
            ii = bytin(0) - &H80
            ACK
        End If
        
        If bytin(0) >= &H90 And bytin(0) < &HA0 Then    'escrow
            ii = bytin(0) - &H90
            billCnt(ii) = billCnt(ii) + 1
            txt_noteCount(ii).Text = billCnt(ii)
            If billEnable(ii) = True Then escrow (1)
            If billEnable(ii) = False Then escrow (0)
        End If
        
        If bytin(0) >= &HA0 And bytin(0) < &HB0 Then    'returned
            ii = bytin(0) - &HA0
            billCnt(ii) = billCnt(ii) - 1
            txt_noteCount(ii).Text = billCnt(ii)
            ACK
        End If
        
End Sub
Private Sub escrow(stk_rej As Byte)
        Dim ss As String
        
        comm1
        send1byte &H35  'poll
        comm2
        send1byte stk_rej
        send1byte &H35 + stk_rej
        
        ss = stk_rej
        txt_hostSay = txt_hostSay + "Escrow 35/" + ss
        ss = &H35 + stk_rej
        txt_hostSay = txt_hostSay + ss
End Sub
Private Sub ACK()
        comm2
        send1byte 0
End Sub

Private Sub Reset()
 Dim ss As String
 Dim ii As Integer

        comm1
        send1byte &H30     'bill type
        
        comm2
        send1byte &H30    'setting all bill enable
        
        txt_hostSay = txt_hostSay + "reset33/30 "
        
        status
        BillType (255)
        expansion
        
        status
        BillType (255)
        expansion
        mnuclear_Click
        NAK_cnt = 0
        
End Sub
Private Sub BillType(billEnByt As Byte)
 Dim ss As String
 Dim ii As Integer
        comm1
        send1byte &H34     'bill type
        
        comm2
        For ii = 0 To 3
            send1byte billEnByt    'setting all bill enable
        Next ii
        
        send1byte (&H34 + billEnByt + billEnByt + billEnByt + billEnByt) Mod 256

        ReadBytes (1)
        
        txt_hostSay = txt_hostSay + "billtype 34/FF/FF/FF/FF/30"
End Sub