frm_main.frm

提供给入门级别的GPRS编程人员

VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{1F9D5961-AC84-11CF-AB0A-444553540000}#2.0#0"; "split32t.ocx"
Begin VB.Form frm_main 
   Caption         =   "GPRS用电管理系统"
   ClientHeight    =   10680
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   15240
   Icon            =   "frm_main.frx":0000
   LinkTopic       =   "Form1"
   Picture         =   "frm_main.frx":08CA
   ScaleHeight     =   10680
   ScaleWidth      =   15240
   StartUpPosition =   2  '屏幕中心
   WindowState     =   2  'Maximized
   Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21 
      Height          =   10680
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   15240
      _LayoutVersion  =   1
      _ExtentX        =   26882
      _ExtentY        =   18838
      _DataPath       =   ""
      Bands           =   "frm_main.frx":1194
      Begin MSCommLib.MSComm MSComm1 
         Left            =   8400
         Top             =   120
         _ExtentX        =   1005
         _ExtentY        =   1005
         _Version        =   393216
         DTREnable       =   -1  'True
         ParitySetting   =   2
      End
      Begin SPLIT.SplitFrame SplitMain 
         Height          =   5955
         Left            =   960
         OleObjectBlob   =   "frm_main.frx":12106
         TabIndex        =   1
         Top             =   1800
         Width           =   7485
      End
   End
End
Attribute VB_Name = "frm_main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
     managegrade (Tool.Name) '权限设置
End Sub
Private Sub Form_Load()
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
    On Error GoTo errhandle
    With MSComm1
        .RThreshold = 1 '1个字节触发ONCOM事件
        .InputMode = comInputModeBinary
        .CommPort = GetInIKeyValue("com", "comport", App.Path & "\file\gprspcset.ini")
        .Settings = "9600,e,8" & MSComm1.CommPort
        .PortOpen = True
    End With
    MsgBox ("串口已经打开"), vbOKOnly + vbInformation, "提示"
    OpenCn
     '//清空缓冲区
    ReDim bybuff(0) As Byte
    bybuff(0) = 0
    ActiveBar21.ClientAreaControl = SplitMain
    If usergrade = 0 Then Me.ActiveBar21.Bands("statusbar").Tools("s2").Caption = "您的身份是系统配置管理员"
    If usergrade = 1 Then Me.ActiveBar21.Bands("statusbar").Tools("s2").Caption = "您的身份是系统管理员"
    If usergrade = 2 Then Me.ActiveBar21.Bands("statusbar").Tools("s2").Caption = "您的身份是系统操作员"
    Exit Sub
    numgprs = 0
errhandle:
    MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "错误"
    Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If MsgBox("确定退出系统?", vbYesNo + vbQuestion, "提示") <> vbYes Then
        Cancel = True
        Exit Sub
    End If
    clocn
    UnloadAllFroms
End Sub
Private Sub MSComm1_OnComm() '串口接收事件（该算法2006/4/28完成2006/5/12修改/2006/5/25修改）
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer
    Dim indata() As Byte
    Dim sgmsg() As Integer
    Dim tempbuff() As Byte
    Dim mymsg() As msg
    Dim myremsg As remsg
    Dim str As String
    j = 0
    k = 0
    m = 0
    
    Select Case MSComm1.CommEvent
    Case comEvReceive
        indata = MSComm1.Input
        For i = 0 To UBound(indata)
            If UBound(bybuff) = 0 And bybuff(0) = 0 Then
                bybuff(0) = indata(i)
            Else
                ReDim Preserve bybuff(UBound(bybuff) + 1)
                bybuff(UBound(bybuff)) = indata(i)
            End If
            
        Next i
        Debug.Print "*****************************************************************************"
        Debug.Print "本次收到的数据个数为："
        Debug.Print UBound(indata) + 1
        Debug.Print "缓冲区内的数据总个数为："
        Debug.Print UBound(bybuff) + 1
        For i = 0 To UBound(bybuff) Step 1
            str = str & bybuff(i) & " "
        Next i
        Debug.Print "缓冲区内的总数据为："
        Debug.Print str
        
        '//可能存在完整的消息的最小消息长度（消息开始符都为3字节）
        If UBound(bybuff) >= 2 Then
                
                For i = 0 To UBound(bybuff) - 2 Step 1
                    '//MO: Or WD: Or WM: 都有可能是一个完整的消息
                    If (bybuff(i) = 77 And bybuff(i + 1) = 79 And bybuff(i + 2) = 58) Or (bybuff(i) = 87 And bybuff(i + 1) = 68 And bybuff(i + 2) = 58) Or (bybuff(i) = 87 And bybuff(i + 1) = 77 And bybuff(i + 2) = 58) Then ' MO:可能是一个完整的消息
                        ReDim Preserve sgmsg(j) As Integer
                        sgmsg(j) = i
                        j = j + 1
                    End If
                Next i
                '//一个可能的完整消息都找不到则认为是错误数据丢弃（2006/5/11修改）
                If j = 0 Then
                    '//清空缓冲区
                    ReDim bybuff(0) As Byte
                    bybuff(0) = 0
                    Exit Sub
                End If
                
                ReDim mymsg(j - 1) As msg
                
                '//1个完整的消息
                '//(bybuff中所有的数据取出认为是正确的消息此时只存在两种可能这个消息刚好是一个完整正确消息没有返回数据，这个消息不是一个完整的消息返回全部数据等待下次使用，可保证disp_message处理消息的算法正确)
                If j = 1 Then
                    mymsg(0).msginfo = bybuff
                    myremsg = disp_message(mymsg(0).msginfo)
                    tempbuff = myremsg.haltdata
                    
                    ReDim bybuff(UBound(tempbuff)) As Byte
                    For k = 0 To UBound(tempbuff)
                        bybuff(k) = tempbuff(k)
                    Next k
                    Exit Sub
                End If
                    '//多个完整的消息(bybuff中两个开始符之间是一个完整的消息取出调用消息处理函数返回剩余数据存入缓冲区等待下次使用）
                If j >= 2 Then
                    '//前j-1个消息无论是不是正确的消息都没有返回数据
                    '//（每个消息刚好是一个正确的消息无返回数据，如果是一个错误的消息直接丢弃）
                    For m = 0 To j - 2 Step 1 '
                        ReDim mymsg(m).msginfo(sgmsg(m + 1) - sgmsg(m) - 1)
                        For k = 0 To sgmsg(m + 1) - sgmsg(m) - 1
                            mymsg(m).msginfo(k) = bybuff(k)
                        Next k
                        myremsg = disp_message(mymsg(m).msginfo)
                    Next m
                    '//第j个消息 数组下标为j-1 即最后1个消息
                    '//（这个消息刚好是一个完整正确消息没有返回数据，这个消息不是一个完整的消息返回全部数据等待下次使用，可保证disp_message处理消息的算法正确）
                    ReDim mymsg(j - 1).msginfo(UBound(bybuff) - sgmsg(j - 1))
                    For k = 0 To UBound(bybuff) - sgmsg(j - 1) Step 1 '2005/5/12修改(不能用J作循环变量)
                        mymsg(j - 1).msginfo(k) = bybuff(k)
                    Next k
                    myremsg = disp_message(mymsg(j - 1).msginfo)
                    tempbuff = myremsg.haltdata
                    ReDim bybuff(UBound(tempbuff)) As Byte
                    For k = 0 To UBound(tempbuff)
                        bybuff(k) = tempbuff(k)
                    Next k
                    Exit Sub
                End If
                   
        '//缓冲区内只有1个数据（如果是'M' or 'W'） 则保留
       ElseIf UBound(bybuff) = 0 And (bybuff(0) = 77 Or bybuff(0) = 87) Then Exit Sub
       '//冲区内只有2个数据
       ElseIf UBound(bybuff) = 1 Then  '//2006/5/25(防止开机出错)
              '//冲区内只有2个数据（如果第1个是'M' 且第2个是'O' ）则保留
              If bybuff(0) = 77 And bybuff(1) = 79 Then Exit Sub
              '//冲区内只有2个数据（如果第1个是'W' 且第2个是'D' or 'M' ）则保留
              If bybuff(0) = 87 And (bybuff(1) = 68 Or bybuff(1) = 77) Then Exit Sub
       '//其它情况都认为是错误数据丢弃
       Else
            '//清空缓冲区
            ReDim bybuff(0) As Byte
            bybuff(0) = 0
            Exit Sub
       End If
    End Select
End Sub