frm_reg.frm

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

        Debug.Print UBound(bybuff) + 1
        For i = 0 To UBound(bybuff) Step 1
            str = str & bybuff(i) & " "
        Next i
        Debug.Print "缓冲区内的总数据为："
        Debug.Print str
        
        If UBound(bybuff) >= 2 Then '可能存在完整的消息的最小消息长度（消息开始符都为3字节）
                
                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
                        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  '//防止开机出错
              '//冲区内只有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

Private Sub txt_id_Change()
    Dim i As Integer
    Dim str As String
    If Trim(txt_id.Text) = "" Then Exit Sub
    For i = 1 To Len(Trim(txt_id.Text))
        If Asc(Mid(Trim(txt_id.Text), i, 1)) >= 48 And Asc(Mid(Trim(txt_id.Text), i, 1)) <= 57 Then
            str = str & Mid(Trim(txt_id.Text), i, 1)
        End If
    Next i
    txt_id.Text = str
End Sub

Private Sub txt_man_Change()
    Dim str As String
    Dim i As Integer
    If Trim(txt_man.Text) = "" Then Exit Sub
    For i = 1 To Len(Trim(txt_man.Text))
        If Asc(Mid(Trim(txt_man.Text), i, 1)) < 0 Then
            str = str & Mid(Trim(txt_man.Text), i, 1)
        End If
    Next i
    txt_man.Text = str
End Sub

Private Sub txt_mobile_Change()
    Dim i As Integer
    Dim str As String
    If Trim(txt_mobile.Text) = "" Then Exit Sub
    For i = 1 To Len(Trim(txt_mobile.Text))
        If Asc(Mid(Trim(txt_mobile.Text), i, 1)) >= 48 And Asc(Mid(Trim(txt_mobile.Text), i, 1)) <= 57 Then
            str = str & Mid(Trim(txt_mobile.Text), i, 1)
        End If
    Next i
    txt_mobile.Text = str
End Sub

Private Sub txt_name_Change()
    Dim str As String
    Dim i As Integer
    If Trim(txt_name.Text) = "" Then Exit Sub
    For i = 1 To Len(Trim(txt_name.Text))
        If Asc(Mid(Trim(txt_name.Text), i, 1)) < 0 Then
            str = str & Mid(Trim(txt_name.Text), i, 1)
        End If
    Next i
    txt_name.Text = str
End Sub

Private Sub txt_pw_Change()
    Dim i As Integer
    Dim str As String
    If Trim(txt_pw.Text) = "" Then Exit Sub
    For i = 1 To Len(Trim(txt_pw.Text))
        If Asc(Mid(Trim(txt_pw.Text), i, 1)) >= 48 And Asc(Mid(Trim(txt_pw.Text), i, 1)) <= 57 Then
            str = str & Mid(Trim(txt_pw.Text), i, 1)
        End If
    Next i
    txt_pw.Text = str
End Sub

Private Sub txt_sim_Change()
    Dim i As Integer
    Dim str As String
    If Trim(txt_sim.Text) = "" Then Exit Sub
    For i = 1 To Len(Trim(txt_sim.Text))
        If Asc(Mid(Trim(txt_sim.Text), i, 1)) >= 48 And Asc(Mid(Trim(txt_sim.Text), i, 1)) <= 57 Then
            str = str & Mid(Trim(txt_sim.Text), i, 1)
        End If
    Next i
    txt_sim.Text = str
End Sub

Private Sub txt_tel_Change()
    Dim i As Integer
    Dim str As String
    If Trim(txt_tel.Text) = "" Then Exit Sub
    For i = 1 To Len(Trim(txt_tel.Text))
        If Asc(Mid(Trim(txt_tel.Text), i, 1)) >= 48 And Asc(Mid(Trim(txt_tel.Text), i, 1)) <= 57 Then
            str = str & Mid(Trim(txt_tel.Text), i, 1)
        End If
    Next i
    txt_tel.Text = str
End Sub

Private Sub xpcmdbutton1_Click() '注册
    Dim strregdata1 As String
    Dim regdata1() As Byte
    Dim regdata2() As Byte
    Dim tempregdata2() As Byte
    Dim regdata() As Byte
    Dim numregdata As Integer
    Dim i As Integer
    Dim centerip As String
    Dim centerport As String
    centerip = GetInIKeyValue("center", "centerip", App.Path & "\file\gprspcset.ini")
    centerport = GetInIKeyValue("center", "centerport", App.Path & "\file\gprspcset.ini")
    strregdata1 = "ATJAU" & centerip & "PORT:" & centerport
    regdata1 = StrConv(strregdata1, vbFromUnicode)
    tempregdata2 = dispose_senddta
    If UBound(tempregdata2) = 0 And tempregdata2(0) = 0 Then Exit Sub '2006-6-5修改防止输入出错
    regdata2 = reg_pctocenter(tempregdata2)
    numregdata = UBound(regdata1) + UBound(regdata2) + 2
    ReDim regdata(numregdata - 1) As Byte
    For i = 0 To UBound(regdata1) Step 1
        regdata(i) = regdata1(i)
    Next i
    For i = UBound(regdata1) + 1 To numregdata - 1
        regdata(i) = regdata2(i - UBound(regdata1) - 1)
    Next i
    comsenddatame regdata '发送数据
    
    '//清空缓冲区
    ReDim bybuff(0) As Byte

End Sub

Private Sub xpcmdbutton2_Click() '退出
   Unload Me
End Sub
Private Function dispose_senddta() As Byte() '注册信息处理函数
    Dim str1 As String
    Dim str2 As String
    Dim str3 As String
    Dim str4 As String
    Dim str5 As String
    Dim str6 As String
    Dim str7 As String
    Dim num As Long
    Dim i As Integer
    Dim senddata() As Byte
    Dim tempname() As Byte
    Dim byname(0 To 29)
    Dim tempman() As Byte
    Dim byman(0 To 5) As Byte
    
    '从输入框中提取输入信息
    str1 = Trim(txt_id.Text)
    str2 = Trim(txt_name.Text)
    str3 = Trim(txt_pw.Text)
    
    str4 = Trim(txt_sim.Text)
    str5 = Trim(txt_tel.Text)
    
    str6 = Trim(txt_mobile.Text)
    str7 = Trim(txt_man.Text)
    If Len(str1) < 6 Then
        MsgBox ("请输入6位数字的区域号！"), vbOKOnly + vbCritical, "错误"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddta = senddata
        Exit Function
    End If
     If str2 = "" Then
        MsgBox ("区域名称不能为空！"), vbOKOnly + vbCritical, "错误"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddta = senddata
        Exit Function
    End If
     If Len(str3) < 12 Then
        MsgBox ("请输入12位数字的区域密码！"), vbOKOnly + vbCritical, "错误"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddta = senddata
        Exit Function
    End If
    If Len(str4) < 11 Then
        MsgBox ("请输入11位数字的SIM卡号！"), vbOKOnly + vbCritical, "错误"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddta = senddata
        Exit Function
    End If
    If Len(str5) < 11 Then
        MsgBox ("请输入11位数字电话号码！"), vbOKOnly + vbCritical, "错误"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddta = senddata
        Exit Function
    End If
    If Len(str6) < 11 Then
        MsgBox ("请输入11位数字联系手机！"), vbOKOnly + vbCritical, "错误"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddta = senddata
        Exit Function
    End If
    If str7 = "" Then
        MsgBox ("联系人不能为空！"), vbOKOnly + vbCritical, "错误"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddta = senddata
        Exit Function
    End If
    
    ReDim senddata(62) As Byte '注册信息共63字节
    For i = 0 To 2 Step 1 '区域号（3字节）
        num = Mid(str1, 2 * i + 1, 2)
        senddata(i) = num
    Next i
    
    tempname = StrConv(str2, vbFromUnicode) '区域名称（汉字30字节）
    If UBound(tempname) < 29 Then '不满30个字节
        For i = 0 To UBound(tempname) Step 1
            byname(i) = tempname(i)
        Next i
        For i = UBound(tempname) + 1 To 29 Step 1 '填空格
            byname(i) = 32
        Next i
    Else '30个字节不填空格
        For i = 0 To 29 Step 1
            byname(i) = tempname(i)
        Next i
    End If
    For i = 3 To 32 Step 1
        senddata(i) = byname(i - 3)
    Next i
    
    For i = 33 To 38 Step 1 '区域密码（6字节）
        num = Mid(str3, 2 * (i - 33) + 1, 2)
        senddata(i) = num
    Next i
    
  
    
    For i = 39 To 43 Step 1 'SIM卡号（前5字节）
        num = Mid(str4, 2 * (i - 39) + 1, 2)
        senddata(i) = num
    Next i
    num = Mid(str4, 11, 1) 'SIM卡号（后1字节）
    senddata(44) = num
     
    For i = 45 To 49 Step 1 '联系电话（前5字节）
        num = Mid(str5, 2 * (i - 45) + 1, 2)
        senddata(i) = num
    Next i
    num = Mid(str5, 11, 1) '联系电话（后1字节）
    senddata(50) = num
    
    For i = 51 To 55 Step 1 '联系手机（前5字节）
        num = Mid(str6, 2 * (i - 51) + 1, 2)
        senddata(i) = num
    Next i
    num = Mid(str6, 11, 1) '联系手机（后1字节）
    senddata(56) = num
    
    tempman = StrConv(str7, vbFromUnicode) '注册人（汉字6字节）
    If UBound(tempman) < 5 Then '不满6个字节
        For i = 0 To UBound(tempman) Step 1
            byman(i) = tempman(i)
        Next i
        For i = UBound(tempman) + 1 To 5 Step 1 '填空格
            byman(i) = 32
        Next i
    Else '6个字节不填空格
        For i = 0 To 5 Step 1
            byman(i) = tempman(i)
        Next i
    End If
    For i = 57 To 62 Step 1
        senddata(i) = byman(i - 57)
    Next i
    
    dispose_senddta = senddata
End Function
Private Function comsenddatame(ByRef indata() As Byte)  '发送数据函数
    Me.MSComm1.Output = indata '发送数据
    Do
        DoEvents '等待发送完毕
    Loop Until Me.MSComm1.OutBufferCount = 0
End Function