gdhweight.frm

齐鲁石化某分公司的数据采集管理系统

      Begin VB.Label Label1 
         Caption         =   "零点1"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   615
      End
   End
End
Attribute VB_Name = "gdhWeight"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim strComBuf(1 To 4) As String
Dim strRcvFrame(1 To 4) As String
Dim intCount As Integer
Dim Vehicle_Direction As String
Dim Goods_Vehicle_Exist As Boolean
Dim count11 As Integer
Dim Col(0 To 15) As Integer
Dim ObjSystem As Object

Dim gdh_Rec_Port As Integer     '接收数据的串口号
Dim gdh_Rec_Inputlen As Integer '串口一次从串口读入的数据长度
Dim gdh_Rec_Inbuff As Integer   '串口接收缓冲区大小
Dim gdh_Rec_Outbuff As Integer  '串口发送缓冲区大小
Dim gdh_Rec_Rth As Integer      '串口接收事件触发与否的标志
Dim gdh_Rec_Sth As Integer      '串口发送事件触发与否的标志
Dim gdh_Rec_Attrib As String    '串口波特率
Dim gdh_Rec_Type As String      '下位机传送的数据编码类型

Dim gdh_Weight_Autosave As Integer      '字段保存标志
Dim gdh_Weight_Autoprint As Integer     '字段打印标志
Dim gdh_Weight_Savetofile As Integer    '保存成文件标志
Public gdh_Weight_Ambit As Single          '轻车重车界限
Dim gdh_Weight_Formats As String        '重量数据小数格式
Dim gdh_Weight_Zerocount As Integer     '零点个数
Dim gdh_Weight_Jinchang As String       '左行方向
Dim gdh_Weight_Chuchang As String       '右行方向
Dim gdh_Weight_Hengqihao As String      '衡器编号
Dim gdh_Weight_Mainpath As String       '保存文件的主路径
Dim gdh_Weight_Secondpath As String     '保存文件的二级路径
Dim gdh_Weight_Savepath As String       '保存文件的路径
Dim gdh_Weight_Dbpath As String         '数据库文件的存放路径

Dim gdh_Print_Pline As Integer          '页式打印,打印横线的行间隔数
Dim gdh_Print_Lline As Integer          '行式打印,打印横线的行间隔数
Dim gdh_Print_Spacecount As Integer     '打印的缩进量
Dim gdh_Print_Mode As String            '打印方式

Dim gdh_GPRS_Path As String     '2007-1-11 //付建明-张金岩
Dim gdh_Gprs_Sdate As Integer    '2007-1-11 //付建明-张金岩
Dim gdh_Gprs_PreviousTime As Integer    '前一次发送零点的时间(分钟)
Dim gdh_Gprs_SendZeroContinue As Boolean '连续发送零点数据
Dim gdh_Gprs_CommandPath As String      '存放操作命令

Dim gdh_Mode_Printmode As Integer       '行打印模式,测试打印与正式打印

Dim PageSize(0 To 9) As Integer

Dim sendCount As Integer

Private Declare Function base64_code Lib "base64.dll" (ByVal strSrc As String, ByVal iLen As Integer, ByRef strDec As Byte) As Byte
Private Declare Function base64_decode Lib "base64.dll" (ByVal strSrc As String, ByVal iLen As Integer, ByRef strDec As Byte) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Function Adddata()
    Dim i As Integer
    
    For i = 1 To 28
        If i = MSHFlexGrid1.Rows - 1 Then
            MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1
        End If
        MSHFlexGrid1.TextMatrix(i, 0) = i
        MSHFlexGrid1.TextMatrix(i, 2) = "230844" & Trim(str(i Mod 13))
        MSHFlexGrid1.TextMatrix(i, 3) = "60" + Format((i / 13), gdh_Weight_Formats)
        MSHFlexGrid1.TextMatrix(i, 4) = "9" + Format((i Mod 17), gdh_Weight_Formats)
    Next i
End Function

Public Sub ComDataDealB464(intComPort As Integer)
    Dim intXPlace As Integer
    Dim intYPlace As Integer
    Dim strtemp As String
    Dim i As Long
    
    On Error GoTo ok
    
    Do While InStr(strComBuf(intComPort), "$") <> 0
        intXPlace = InStr(strComBuf(intComPort), "$")
        strComBuf(intComPort) = Mid(strComBuf(intComPort), intXPlace)

        intYPlace = InStr(strComBuf(intComPort), "#")
        If intYPlace <> 0 Then
            strRcvFrame(intComPort) = Mid(strComBuf(intComPort), 1, intYPlace)
            strComBuf(intComPort) = Mid(strComBuf(intComPort), intYPlace + 1)

            Call Receive_B464(intComPort)

        Else
            If Len(strComBuf(intComPort)) >= 64 Then 'CRC DATA
               strComBuf(intComPort) = ""
               Exit Sub
            Else

                Exit Sub
            End If
        End If
    Loop

    Do While InStr(strComBuf(intComPort), "$") = 0
        strComBuf(intComPort) = ""
        Exit Sub
    Loop
    strComBuf(intComPort) = ""
ok:
End Sub

Public Sub ComDataDealAscii(intComPort As Integer)
    Dim intXPlace As Integer
    Dim intYPlace As Integer
    Dim strtemp As String
    Dim i As Long
    
    On Error GoTo ok
    
    Do While InStr(strComBuf(intComPort), "#") <> 0
        intXPlace = InStr(strComBuf(intComPort), "#")
        strComBuf(intComPort) = Mid(strComBuf(intComPort), intXPlace)

        intYPlace = InStr(strComBuf(intComPort), "=")
        If intYPlace <> 0 Then
            strRcvFrame(intComPort) = Mid(strComBuf(intComPort), 1, intYPlace)
            strComBuf(intComPort) = Mid(strComBuf(intComPort), intYPlace + 1)
            Call Receive_ASCII(intComPort)
        Else
            If Len(strComBuf(intComPort)) >= 44 Then 'CRC DATA
               strComBuf(intComPort) = ""
               Exit Sub
            Else
               Exit Sub
            End If
        End If
    Loop

    Do While InStr(strComBuf(intComPort), "#") <> 0
        strComBuf(intComPort) = ""
        Exit Sub
    Loop
    strComBuf(intComPort) = ""
ok:
End Sub

Public Sub Receive_B464(intComPort As Integer)

    Dim strData As String
    Dim strtemp As String
    Dim strFlag, strin, StrMSFG As String
    Dim i As Integer
    Dim strReturn(400) As Byte
    Dim strCode, strDecode As String
    Dim iLen As Integer
    Dim iRef As Long
    Dim strType As String
    Dim strWeight As String
    Dim Vehicle_Direction As String
    Dim sts As String
    
    On Error GoTo ok
    
    strCode = Mid(strRcvFrame(intComPort), 2, Len(strRcvFrame(intComPort)) - 2)
    
    iLen = base64_decode(strCode, Len(strCode), strReturn(0))
    sts = ""
    For i = 0 To iLen Step 1
        sts = sts + Chr$(strReturn(i))
    Next i
'    Debug.Print sts
    Select Case strReturn(5) 'Mid(strDecode, 3, 1)
        Case 87     'W，重量等
            For i = 6 To iLen Step 1
                strDecode = strDecode & Chr$(strReturn(i))
            Next

'由付建明改写过
            Goods_Vehicle_Exist = True
            
            intCount = intCount + 1
            If intCount = 1 Then
                MSHFlexGrid1.Rows = 2
                For i = 0 To MSHFlexGrid1.Cols - 1
                    MSHFlexGrid1.TextMatrix(1, i) = ""
                Next i
            End If
            MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1

            MSHFlexGrid1.TextMatrix(intCount, Col(0)) = intCount '序号
            strType = Trim(Mid(strDecode, 4, 7))  '车型 由陈辉更改 20060703
            If Mid(strType, 1, 1) = "T" Then
                strType = Mid(strType, 2)
            End If
            strType = myTrim(strType)
            MSHFlexGrid1.TextMatrix(intCount, Col(1)) = strType
            MSHFlexGrid1.TextMatrix(intCount, Col(2)) = Trim(Mid(strDecode, 11, 7))   '车号
            strWeight = Trim(Mid(strDecode, 18, 7)) ' & Int((9 * Rnd) + 1)
            
            If Len(gdh_Weight_Formats) = 6 Then
                strWeight = strWeight & Int((9 * Rnd) + 1)
            End If
            
            MSHFlexGrid1.TextMatrix(intCount, Col(3)) = Format(strWeight, gdh_Weight_Formats) '毛重
            MSHFlexGrid1.TextMatrix(intCount, Col(8)) = Format(Mid(strDecode, 25, 6), "#0.00") '速度
            

        Case 78     'N，车次
            For i = 6 To iLen Step 1
                strDecode = strDecode & Chr$(strReturn(i))
            Next

        Case 83     'S， 开始
'            Timer1.Enabled = False
'            Call Condition_Set
            strtemp = Format(Date, "yyyy-mm-dd") + " " + Format(Time, "hh:mm:ss")
            Label3(0).Caption = strtemp
            
            Timer3.Enabled = False  '2007-1-11 13:00
            
        Case 69     'E, 结束
            Call Weight_Exit
            Timer3.Enabled = True
        Case 67     'C, 数量
            
        Case 68     'D, 方向
            If strReturn(6) = 76 Or strReturn(6) = 108 Then
                intCount = 0 '表格下标初始化
                Vehicle_Direction = "<--"

                Label3(1).Caption = Vehicle_Direction
                count11 = count11 + 1
                count11 = count11 Mod 32
                
            ElseIf strReturn(6) = 82 Or strReturn(6) = 114 Then
                intCount = 0 '表格下标初始化
                Vehicle_Direction = "-->"
        
                Label3(1).Caption = Vehicle_Direction
                count11 = count11 + 1
                count11 = count11 Mod 32
            End If
                
        Case 82     'R, 参考点
        
            For i = 0 To gdh_Weight_Zerocount - 1
                iRef = strReturn(7 + i * 2)
                iRef = iRef * 256
                iRef = iRef + strReturn(7 + i * 2 + 1)
                If iRef > 32767 Then
                    Text1(i).text = iRef - 65535
                Else
                    Text1(i).text = iRef
                End If
            Next i
            
    End Select
ok:
End Sub

Public Sub Receive_ASCII(intComPort As Integer)

    Dim strData As String
    Dim strtemp As String
    Dim strType As String
    Dim strFlag, strin, StrMSFG As Single
    Dim i As Integer, j As Integer
    Dim strReturn(400) As Byte
    Dim strCode, strDecode As String
    Dim iLen As Integer
    Dim iRef As Long
    Dim strWeight As String
    Dim viewCount As Integer
    
    On Error GoTo ok
    
    If InStr(strRcvFrame(intComPort), "DL") <> 0 Then
        
        Timer3.Enabled = False  '2007-1-11 13:00
        
'        Timer1.Enabled = False
        intCount = 0 '表格下标初始化
        Vehicle_Direction = "<--"
        
        Label3(1).Caption = Vehicle_Direction
        strtemp = Format(Date, "yyyy-mm-dd") + " " + Format(Time, "hh:mm:ss")
        Label3(0).Caption = strtemp

        count11 = count11 + 1
        count11 = count11 Mod 32
        
        intCount = 0
        
    ElseIf InStr(strRcvFrame(intComPort), "DR") <> 0 Then
    
        Timer3.Enabled = False  '2007-1-11 13:00
        Timer1.Enabled = False
        
        intCount = 0 '表格下标初始化
        Vehicle_Direction = "-->"
        
        Label3(1).Caption = Vehicle_Direction
        strtemp = Format(Date, "yyyy-mm-dd") + " " + Format(Time, "hh:mm:ss")
        Label3(0).Caption = strtemp

         'XXX 2005-9-2 add listbox control element,qingenjian
'        List1.AddItem strtemp, count11
        count11 = count11 + 1
        count11 = count11 Mod 32
        
        intCount = 0
        
        
    End If
        
    
    If Mid(strRcvFrame(intComPort), 2, 1) = "Z" Then
        strData = Mid(strRcvFrame(intComPort), 3, 40)
'        Text1(0).Text = Mid(strData, 1, 5)
'        Text1(1).Text = Mid(strData, 6, 5)
'        Text1(2).Text = Mid(strData, 11, 5)
'        Text1(3).Text = Mid(strData, 16, 5)
'        Text1(4).Text = Mid(strData, 21, 5)
'        Text1(5).Text = Mid(strData, 26, 5)
'        Text1(6).Text = Mid(strData, 31, 5)
'        Text1(7).Text = Mid(strData, 36, 5)
        For j = 0 To gdh_Weight_Zerocount
            Text1(j) = Mid(strData, 5 * j + 1, 5)
        Next j
    End If
    If Mid(strRcvFrame(intComPort), 2, 1) = "W" Then
    
        Goods_Vehicle_Exist = True  '有货车经过
        strData = Mid(strRcvFrame(intComPort), 3, 26)
        '以下是将报文读入到表格中去的部分
        
        intCount = intCount + 1
        If intCount = 1 Then
            MSHFlexGrid1.Rows = 2
            For j = 0 To MSHFlexGrid1.Cols - 1
                MSHFlexGrid1.TextMatrix(1, j) = ""
            Next j
        End If
        MSHFlexGrid1.Rows = MSHFlexGrid1.Rows + 1
        viewCount = (MSHFlexGrid1.Height - MSHFlexGrid1.CellHeight) \ MSHFlexGrid1.CellHeight
        If MSHFlexGrid1.Rows > viewCount Then
            MSHFlexGrid1.TopRow = MSHFlexGrid1.Rows - viewCount + 1
        End If
        MSHFlexGrid1.TextMatrix(intCount, 0) = intCount '序号
        
        strType = Trim(Mid(strData, 1, 7))  '车型 由陈辉更改 20060703
        If Mid(strType, 1, 1) = "T" Then
            strType = Mid(strType, 2)
        End If
        strType = myTrim(strType)
        
        MSHFlexGrid1.TextMatrix(intCount, 1) = strType  '车型
        MSHFlexGrid1.TextMatrix(intCount, 2) = Trim(Mid(strData, 8, 7))
        
        strWeight = Mid(strData, 15, 6)
        If Len(gdh_Weight_Formats) = 6 Then
            strWeight = strWeight & Int((9 * Rnd) + 1)
        End If
        
        MSHFlexGrid1.TextMatrix(intCount, 3) = Format(Trim(strWeight), gdh_Weight_Formats) '毛重
        MSHFlexGrid1.TextMatrix(intCount, 4) = Format(Mid(strData, 21, 6), "#0.00") '速度
        
        
'        SinMW = SinMW + Val(Me.MSHFlexGrid1.TextMatrix(intCount, 3))