frmrealtimecomm.frm

自动回传考勤数据程序,小程序!大作用!可供大家参考一下!

   Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical
Me.Enabled = True
Me.MousePointer = 0


End Sub

Private Sub btnRealTimeStop_Click()
On Error GoTo ErrorHandler
    Dim zif As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim IfSelect As Boolean

    If btnStartRead.Enabled = False Then
        MsgBox "请先停止接收数据！", vbOKOnly + vbExclamation
        Exit Sub
    End If
Dim SetRealTimeModel As New Nanben.SetMachine

Me.Enabled = False
Me.MousePointer = 11


IfSelect = False
RealTimeState = False
With ListMac

        For i = 1 To .ListItems.Count
           For j = 1 To i - 1
                If .ListItems(i).SubItems(1) = .ListItems(j).SubItems(1) Then
                    GoTo labNextComPort
                End If
           Next
            zif = SetRealTimeModel.RealTimeCommStop(.ListItems(i).SubItems(1), .ListItems(i).SubItems(2))
labNextComPort:
        Next
    
    If zif = 8 Then
        Msg.Text = Msg.Text & "    群发设置非实时通讯完毕！" & Chr(13) & Chr(10)
        
    ElseIf zif = 4 Then
        Msg.Text = Msg.Text & "    找不到卡钟！" & Chr(13) & Chr(10)
    Else
       Msg.Text = Msg.Text & "    操作超时！" & Chr(13) & Chr(10)
    End If
    Msg.SelStart = Len(Msg.Text)
End With


Set SetRealTimeModel = Nothing
Me.Enabled = True
Me.MousePointer = 0
btnRealTimeStart.Enabled = True

   Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical
Me.Enabled = True
Me.MousePointer = 0

End Sub

Private Sub btnStartRead_Click()
On Error GoTo ErrorHandler

Dim zif As Integer
Dim outrecord As String
Dim i As Integer, j As Integer, k As Integer
Dim GotStr(0) As String
Dim Char(13) As Byte
Dim CheckCode As Integer
Dim SaveToPathFile As String
Dim EmployeeInf() As String
Dim DevId As Integer

Dim RealTimeGetData As New Nanben.SetMachine

RealTimeSearchState = True
TxtGotData.Text = ""
RecordCount = 0

If btnRealTimeStart.Enabled = True Then
    MsgBox "请先按 ‘开始通讯’ 按钮", vbOKOnly + vbExclamation
    Exit Sub
End If
FramGotData.Caption = "接收数据[0]"
SaveToPathFile = frmMacMain.SaveFilePath("Realtime")

btnStartRead.Enabled = False
ListMac.Enabled = False
frmMacMain.GetEmployee EmployeeInf
    
    With ListMac
        
        For i = 1 To .ListItems.Count
           For j = 1 To i - 1
                If .ListItems(i).SubItems(1) = .ListItems(j).SubItems(1) Then
                    GoTo labNextComPort
                End If
           Next
            zif = RealTimeGetData.RealTimeCommStartSend(.ListItems(i).SubItems(1), .ListItems(i).SubItems(2))
            If zif = 8 Then
                Msg.Text = Msg.Text & "COM" & .ListItems(i).SubItems(1) & "  设置实时通讯成功,端口处于实时通讯状态！" & Chr(13) & Chr(10)
            ElseIf zif = 4 Then
                Msg.Text = Msg.Text & "    找不到卡钟！" & Chr(13) & Chr(10)
            Else
               Msg.Text = Msg.Text & "    操作超时！" & Chr(13) & Chr(10)
            End If
            Msg.SelStart = Len(Msg.Text)
labNextComPort:
        Next
        
    End With
j = 0
Do While True
    If RealTimeSearchState = False Then
      Exit Do
    End If
    If RealTimeGetData.V2RealTimeCommGetRecord(outrecord) = 8 Then
        DevId = Left(outrecord, 3)
        GotStr(0) = outrecord
        GotStr(0) = Mid(GotStr(0), 4)
        frmMacMain.RecSaveToFile GotStr, SaveToPathFile, DevId, EmployeeInf
        If IfFooded(DevId, outrecord, RealTimeGetData) = 1 Then '判断是否可以份饭，并且发份饭信号
            TxtGotData.Text = TxtGotData.Text & GotStr(0) & Chr(13) & Chr(10)
            TxtGotData.SelStart = Len(TxtGotData.Text)
            RecordCount = RecordCount + 1
            FramGotData.Caption = "接收数据[" & RecordCount & "]"
        End If
        If RecordCount >= 1000 Then
            RecordCount = 0
            TxtGotData.Text = ""
        End If
    End If
Loop    'one record end
Set RsFood = Nothing


''循环中断实时通讯方式
''Do While True
''    If RealTimeSearchState = False Then
''      Exit Do
''    End If
''    For i = 1 To ListMac.ListItems.Count
''        If ListMac.ListItems(i).Checked = True Then
''            If RealTimeGetData.RealTimeCommGetRecord(ListMac.ListItems(i).Text, 19200, GotByte) = 8 Then
''
''                    GotStr(0) = GotByte
''                    j = 0
''                    DevId = Left(GotStr(0), 3)
''                    GotStr(0) = Mid(GotStr(0), 4)
''                    frmMacMain.FormatRecord GotStr, DevId, EmployeeInf
''                    TxtGotData.Text = TxtGotData.Text & GotStr(0) & Chr(13) & Chr(10)
''                    GotStr(0) = ""
''                    RecordCount = RecordCount + 1
''                    If RecordCount > 1000 Then
''                        TxtGotData.Text = ""
''                        RecordCount = 0
''                    End If
''
''                TxtGotData.SelLength = Len(TxtGotData.Text)
''            End If
''            DoEvents
''        End If
''    Next
''Loop

Set RealTimeGetData = Nothing

btnStartRead.Enabled = True
ListMac.Enabled = True

   Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical

btnStartRead.Enabled = True
ListMac.Enabled = True
End Sub
Private Function IfFooded(ByVal DevId As Integer, GotStr As String, RealTimeGetData As Nanben.SetMachine) As Integer
On Error GoTo ErrorHandler

Dim CurrentDate As String
Dim CurrentTime As String
Dim CurrentCardNo As String
Dim FoodTimeFrom As String
Dim FoodTimeTo As String
Dim StrSQL As String
Dim k As Integer

With frmMacMain.ListMac
    For k = 1 To .ListItems.Count
        If DevId = .ListItems(k) Then
            Exit For
        End If
    Next
    If k > .ListItems.Count Then
        k = k - 1
    End If
End With
IfFooded = 1    '默认为1，可以显示记录
If frmMacMain.ListMac.ListItems(k).SubItems(3) = "份饭" Then '如果选择份饭才发
    IfFooded = 0    '份饭不可消费,不可显示记录
    CurrentDate = "20" & Mid(GotStr, 14, 2) & "/" & Mid(GotStr, 16, 2) & "/" & Mid(GotStr, 18, 2)
    CurrentTime = Mid(GotStr, 20, 2) & ":" & Mid(GotStr, 22, 2)
    CurrentCardNo = Mid(GotStr, 4, 10)
    
    StrSQL = "select TimeFrom,TimeTo from Mac_BrushTimeLimit where TimeFrom<'" & CurrentTime & "' and TimeTo>'" & CurrentTime & "' and LimitType='Food'"
    RsFood.Open StrSQL, db, adOpenForwardOnly, adLockReadOnly
    If RsFood.RecordCount > 0 Then
        FoodTimeFrom = RsFood.Fields(0)
        FoodTimeTo = RsFood.Fields(1)
        RsFood.MoveNext
        Do While Not RsFood.EOF
            If RsFood.Fields(0) < FoodTimeFrom Then
                FoodTimeFrom = RsFood.Fields(0)
            End If
            If RsFood.Fields(1) > FoodTimeTo Then
                FoodTimeTo = RsFood.Fields(1)
            End If
        Loop
        RsFood.Close
        StrSQL = "SELECT * FROM Mac_FoodBrushCard where Mac_FoodBrushTime between #" & CurrentDate & " " & FoodTimeFrom & "# and #" & CurrentDate & " " & FoodTimeTo & "# and Mac_FoodCardNo='" & CurrentCardNo & "'"
        RsFood.Open StrSQL, db, adOpenForwardOnly, adLockReadOnly
        If RsFood.RecordCount > 0 Then
            RealTimeGetData.V2RealTimeCommSendData 2    '不可消费
        Else
            RealTimeGetData.V2RealTimeCommSendData 1    '可以消费
            db.Execute "insert into Mac_FoodBrushCard (Mac_FoodCardNo,Mac_FoodBrushTime) values('" & CurrentCardNo & "',#" & CurrentDate & " " & CurrentTime & "#)"
            IfFooded = 1    '可消费,可显示记录
        End If
    End If
    RsFood.Close
End If
Exit Function
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical
End Function

Private Sub btnStopRead_Click()
RealTimeSearchState = False
End Sub

Private Sub Form_Activate()
On Error GoTo ErrorHandler

    Dim i As Integer
    Me.ListMac.ListItems.Clear
    With frmMacMain.ListMac
        For i = 1 To .ListItems.Count
            Me.ListMac.ListItems.Add , , .ListItems(i).Text
            Me.ListMac.ListItems(i).SubItems(1) = .ListItems(i).SubItems(1)
            Me.ListMac.ListItems(i).SubItems(2) = .ListItems(i).SubItems(2)
            Me.ListMac.ListItems(i).SubItems(3) = .ListItems(i).SubItems(3)
        Next
    End With
   Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical

End Sub

Private Sub Form_Deactivate()
On Error GoTo ErrorHandler
    btnStopRead_Click
Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error GoTo ErrorHandler
Dim IfExit As Long
    btnStopRead_Click
    If btnStartRead.Enabled = False Then
        MsgBox "请先停止接收数据！", vbOKOnly + vbExclamation
        Cancel = 1
        Exit Sub
    End If
    If btnRealTimeStart.Enabled = False Then
        MsgBox "请先停止实时通讯！", vbOKOnly + vbExclamation
        Cancel = 1
        Exit Sub
    End If

    If RealTimeState = True Then
        IfExit = MsgBox("还有机器处于实时通讯状态，" & Chr(13) & Chr(10) & "请重新设置所有卡钟为非实时通讯状态才离开！" & Chr(13) & Chr(10) & "确实要离开吗?", vbOKCancel + vbQuestion)
        If IfExit = vbOK Then
            Cancel = 0
        Else
            Cancel = 1
        End If
        Exit Sub
    End If
    
   Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical

End Sub