pubfunc.bas

一个功能比较完善的远程抄表软件

                RFlag = False
                Beep
                temVal = chkPort(PortA_2) And &HF       '读数据
'                Debug.Print temVal
'status
'                    AppendStatusInfo "收到数据信号" & temVal, icoBLUE
'                    SaveLog "收到数据信号" & temVal, 0
                If temVal >= 0 And temVal <= 9 Then     '正常数据
                    ReadCount = ReadCount + 1
                    If ReadCount > curBit Then          '丢失同步信号,失步
                        CollectUserData_pul = 2
                        Exit Do
                    End If
                    curGetData = curGetData * 10 + temVal
                ElseIf temVal = 11 Then     '数据同步信号
'status
'                    AppendStatusInfo "收到同步信号", icoBLUE
'                    SaveLog "收到同步信号", 0
                    If ReadCount <> curBit Then         '丢失数据
'status
'                        AppendStatusInfo "丢失一个或多个数据，收到" & ReadCount & "位数据", icoRED
'                        SaveLog "丢失一个或多个数据，收到" & ReadCount & "位数据", 1
                        CollectUserData_pul = 3
                        Exit Do
                    End If
'status
                    AppendStatusInfo "收到数据" & DData(curDevID), icoBLUE
                    SaveLog "收到数据" & DData(curDevID), 0
                    ReadCount = 0
                    If CollectDevID = 0 Then
                        If curGetData <> curCardAddr Then      '比较第一组数据是否与用户地址相同
'status
'                            AppendStatusInfo "收到非当前用户的数据", icoRED
'                            SaveLog "收到非当前用户的数据", 1
                            'CollectUserData_pul = 6
                            'Exit Do
                        End If
                    End If
                    CollectDevID = CollectDevID + 1
                    DData(curDevID) = curGetData
                    curGetData = 0
                ElseIf temVal = 12 Then         '结束信号
'status
                    AppendStatusInfo "收到结束信号,共接收" & CollectDevID & "个设备数据", icoBLUE
                    SaveLog "收到结束信号,共接收" & CollectDevID & "个设备数据", 0
'                    If ReadCount <> curBit Then
'status
'                        AppendStatusInfo "丢失一个或多个数据", icoRED
'                        SaveLog "丢失一个或多个数据", 1
'                        CollectUserData_pul = 3
'                        Exit Do
'                    Else
'                        CollectDevID = CollectDevID + 1
'                    End If
                    CollectUserData_pul = 0             '正常采集完毕
                    Exit Do
                Else                            '其他错误信号
'status
'                    AppendStatusInfo "收到错误信号" & temVal, icoRED
'                    SaveLog "收到错误信号" & temVal, 1
                    CollectUserData_pul = temVal
                    'SendCode 0
                    Exit Do
                End If
            End If
        Else
            If Not RFlag Then
                If chkBit(PortB_2, bRead2, 0, 1000) = 0 Then
                    RFlag = True
                End If
            End If
        End If
        
        DoEvents
    Loop
End Function
Function CollectUserData(curUserID As Integer, UserAddress As Integer, curUserDevSum As Integer) As Integer
'返回值:    0---正常采集
'           1---超时无反应
'           2---丢失换表脉冲
'           3---丢失读脉冲(丢失位)
'           4---丢失一表或多表数据
'           5---采集被终止
'           其他---其他错误
'           >9--收到无效数据
Dim RData(5) As Integer     '保存读脉冲取得的数据
Dim temVal As Integer
Dim RFlag As Boolean        '读脉冲辅助标志,用于防止重复读取同一个脉冲
Dim DFlag As Boolean        '换表脉冲辅助标志,用于防止重复读取同一个脉冲
Dim CollectDevID As Integer
Dim ReadCount As Integer    '有效读脉冲个数,用于在换表脉冲到来时,判断读脉冲是否检取正确
                                '4位表,当换表脉冲到来时,该值应为4
                                '5位表,当换表脉冲到来时,该值应为5

    RFlag = True
    DFlag = True
    ReadCount = 0
    CollectDevID = 0                    '用户设备数
    ReDim DData(1)
    
'status
    AppendStatusInfo "发送用户" & curUserID & "地址" & UserAddress, icoBLUE
    SaveLog "发送用户" & curUserID & "地址" & UserAddress, 0
    OpenUser (UserAddress)        '打开当前用户
    
    pubTimerCount1 = 0              '用公共计时器1来作为超时计时器
    pubTimer1.Enabled = False
    pubTimer1.Interval = 1000
    pubTimer1.Enabled = True

    Do While True                       '进入监控循环
        If CancelCollect Then
            CollectUserData = 5
            'SendCode 0
            Exit Do
        End If
        '超时
        If pubTimerCount1 > 5 Then              '用户超时无反应(>2秒)
'status
'            AppendStatusInfo "超时无反应", icoRED
'            SaveLog "超时无反应", 1
            pubTimer1.Enabled = False
            pubTimer1.Interval = 0
            pubTimerCount1 = 0
            
            CollectUserData = 1                     '超时退出
            Exit Do
        End If
        
        '读脉冲
        If chkBit(PortB_2, bRead2, 1, 1) <> 0 Then
            If RFlag Then
'status
'                AppendStatusInfo "收到读脉冲", icoBLUE
'                SaveLog "收到读脉冲", 0
                pubTimerCount1 = 0
                RFlag = False
                Beep
                For i = 1 To 4
                    RData(i) = RData(i + 1)
                Next i
                RData(5) = chkPort(PortA_2) And &HF
                If RData(5) > 9 Or RData(5) < 0 Then
'status
'                    AppendStatusInfo "收到无效数据" & RData(5), icoRED
'                    SaveLog "收到无效数据" & RData(5), 1
                    CollectUserData = RData(5)
                    Exit Do
                End If
                ReadCount = ReadCount + 1
                If ReadCount > curBit Then
'status
'                    AppendStatusInfo "丢失换表脉冲", icoRED
'                    SaveLog "丢失换表脉冲", 1
                    CollectUserData = 2           '丢失换表脉冲
                    Exit Do
                End If
            End If
        Else
            If Not RFlag Then
                If chkBit(PortB_2, bRead2, 0, 1000) = 0 Then
                    RFlag = True
                End If
            End If
        End If
        
        '换表脉冲
        If chkBit(PortB_2, bDev, 1, 100) <> 0 Then
            If DFlag Then
'status
'                AppendStatusInfo "收到换表脉冲", icoBLUE
'                SaveLog "收到换表脉冲", 0
                pubTimerCount1 = 0
                If ReadCount = 0 Then
                    GoTo DevThen
                End If
                If ReadCount <> curBit Then
'status
'                    AppendStatusInfo "读脉冲丢失位", icoRED
'                    SaveLog "读脉冲丢失位", 1
                    CollectUserData = 3             '读脉冲丢失位
                    Exit Do
                End If
                
                DFlag = False
                CollectDevID = CollectDevID + 1     '设备计数器加一
                ReDim Preserve DData(CollectDevID)
                DData(CollectDevID) = 0
                For j = 1 To 5
                    DData(CollectDevID) = DData(CollectDevID) * 10 + RData(j)
                    RData(j) = 0
                Next j
'status
                AppendStatusInfo "收到表:" + Format(CollectDevID) + "  数据:" + Format(DData(CollectDevID)), icoBLUE
                SaveLog "收到表:" + Format(CollectDevID) + "  数据:" + Format(DData(CollectDevID)), 0
                ReadCount = 0                       '清空读脉冲计数器
            End If
        Else
            If Not DFlag Then
                If chkBit(PortB_2, bDev, 0, 30000) = 0 Then
                    DFlag = True
                End If
            End If
        End If
DevThen:
        '换户脉冲
        If chkBit(PortB_2, bUser, 1, 1000) <> 0 Then
'status
'            AppendStatusInfo "收到换户脉冲", icoBLUE
'            SaveLog "收到换户脉冲", 0
            If ReadCount <> 0 Then
                If ReadCount <> curBit Then
'status
'                    AppendStatusInfo "读脉冲丢失位", icoRED
'                    SaveLog "读脉冲丢失位", 1
                    CollectUserData = 3             '读脉冲丢失位
                    Exit Do
                Else
                    CollectDevID = CollectDevID + 1
                End If
            End If
            If CollectDevID = 0 Then
                GoTo DevThen
            End If
            If CollectDevID <> curUserDevSum Then
'status
'                AppendStatusInfo "丢失一表或多表数据", icoRED
'                SaveLog "丢失一表或多表数据", 1
                CollectUserData = 4
                Exit Do
            End If
            pubTimer1.Enabled = False
            pubTimerCount1 = 0
                '将采集结果存入本次数据库中
            If ReadCount <> 0 Then
                ReDim Preserve DData(CollectDevID)
                DData(CollectDevID) = 0
                For j = 1 To 5
                    DData(CollectDevID) = DData(CollectDevID) * 10 + RData(j)
                    RData(j) = 0
                Next j
'status
                AppendStatusInfo "收到表:" + Format(CollectDevID) + "  数据:" + Format(DData(CollectDevID)), icoBLUE
                SaveLog "收到表:" + Format(CollectDevID) + "  数据:" + Format(DData(CollectDevID)), 0
            End If
'status
            AppendStatusInfo "用户:" & Format(curUserID) + " 采集结束", icoBLUE
            SaveLog "用户:" & Format(curUserID) + " 采集结束", 0
                
Finished:
            CollectUserData = 0                 '正常采集完毕
            'SendCode 0
            Exit Do
        End If
        
        DoEvents
    Loop
End Function
Function CollectUserData_pic(curUserID As Integer, curDevID As Integer, curCardAddr As Integer, curDevAddr As Integer, curJPGDir As String) As Integer
'Function CollectUserData_pic(curUserID As Integer, curCardAddr As Integer, curUserDevSum As Integer, curJPGDir As String) As Integer
'图像表采集函数
'返回值:    0---正常采集
'           1---录像失败
'           2---抓取图像文件失败
'           3---图像识别失败(内存分配失败!)
'           4---图像识别失败(没有找到文件!)
'           5---图像识别失败(文件格式错误!)
'           6---图像识别失败(图象质量差,不能识别,请检查摄像头!)
'           7---采集被终止
'           其他---其他错误
Dim RData(5) As Integer     '保存读脉冲取得的数据
Dim temVal As Long
Dim RFlag As Boolean        '读脉冲辅助标志,用于防止重复读取同一个脉冲
Dim DFlag As Boolean        '换表脉冲辅助标志,用于防止重复读取同一个脉冲
Dim ReadCount As Integer    '有效读脉冲个数,用于在换表脉冲到来时,判断读脉冲是否检取正确
                                '4位表,当换表脉冲到来时,该值应为4
                                '5位表,当换表脉冲到来时,该值应为5
Dim ok As Boolean
Dim sCardaddr As String
Dim sDevaddr As String
Dim sFullDevAddr As String
Dim bJPGCaped As Boolean

beginCap:

    RFlag = True
    DFlag = True
    ReadCount = 0
    'ReDim DData(0)
    
'status
    AppendStatusInfo "发送用户" & curUserID & "地址" & curCardAddr, icoBLUE
    SaveLog "发送用户" & curUserID & "地址" & curCardAddr, 0
    
    'ReDim Preserve DData(UBound(DData) + 1)
    
    openDev curCardAddr, curDevAddr         '打开当前表
    
    'Delay 1, 5
    'closeCard
    
'modified by zx 20060211,由于视频卡对线路上视频信号频率敏感，导致不能成功识别锁定视频信号
'修改为不再判断isVideoSingalLocked返回，直接截图
'    bJPGCaped = False
'    For i = 1 To gVideoCapWait
'        If frmMain.videoMain.IsVideoSignalLocked Then
'            bJPGCaped = True
'            Exit For
'        End If
'        Delay 1, 1
'    Next i
'    If Not bJPGCaped Then
'        CollectUserData_pic = 1
'        closeDev curCardAddr
'        closeCard
'        Exit Function
'    End If
    
    closeCard   '打开表的摄像头后，关掉卡以消除地址线上的地址信号，避免地址信号对数据线上的图象造成干扰
    
    Delay 1, gVideoCapDelay
    sCardaddr = Format(curCardAddr, "00000000")
    sDevaddr = Format(curDevAddr, "00")
    sFullDevAddr = sCardaddr & sDevaddr
    gCurJPGFile = curJPGDir & "\" & curUserID & "-" & curDevID & "_" & sFullDevAddr & ".jpg"
    If Dir(gCurJPGFile, 0) <> "" Then
        Kill gCurJPGFile
    End If
    
    ok = frmMain.videoMain.SaveImageToJpg(gCurJPGFile, 100)     '抓取图像文件
    
    closeDev curCardAddr
    closeCard
    
    If ok = True Then
        'temVal = Translate(gCurJPGFile)      '进行图像识别
        temVal = Recognize(gCurJPGFile, sFullDevAddr)     '进行图像识别
        Select Case (temVal)
            Case -1
                CollectUserData_pic = 3
'status
                AppendStatusInfo "用户" & curUserID & "表[" & curDevID & "]图像识别失败（3）", icoRED
                SaveLog "用户" & curUserID & "表[" & curDevID & "]图像识别失败（3）", 0
            Case -2
                CollectUserData_pic = 4
'status
                AppendStatusInfo "用户" & curUserID & "表[" & curDevID & "]图像识别失败（4：没有找到文件）", icoRED
                SaveLog "用户" & curUserID & "表[" & curDevID & "]图像识别失败（4：没有找到文件）", 0
            Case -3
                'frmMain.videoMain.Disconnect
                'frmMain.videoMain.Connect False
                
                'If frmMain.videoMain.VideoStandard = 1 Then
                ''PAL->NTSC
                 '   frmMain.videoMain.VideoStandard = 0
                  '  frmMain.videoMain.FrameRate = 30
                   ' gVideoStandard = 0
                'ElseIf frmMain.videoMain.VideoStandard = 0 Then
                ''NTSC->PAL
                 '   frmMain.videoMain.VideoStandard = 1
                  '  frmMain.videoMain.FrameRate = 22
                   ' gVideoStandard = 1
                'End If
                
                'GoTo beginCap