globalvar.bas

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

        Case "m45" '断开负荷
            frm_cut.Show 1
            Exit Sub
        Case "m46" '呼叫终端
            frm_call.Show 1
            Exit Sub
        Case "m51" '查询用户资料
            LoadAFormToSplit frm_qurryuserinfo
            Exit Sub
        Case "m52" '查询用户购电信息
            LoadAFormToSplit frm_qurrybuypower
            Exit Sub
        Case "m53" '查询用户报警信息
            LoadAFormToSplit frm_alarm
            Exit Sub
        Case "m61"
            DataReport1.Show 1
            Exit Sub
        Case "m62"
            DataReport2.Show 1
            Exit Sub
        Case "m63"
            DataReport3.Show 1
            Exit Sub
        Case "m7"
            frm_help.Show 1
            Exit Sub
        Case "t1" '主机上网
            If numgprs > 4 Then
                If MsgBox("主机已经试图上网" & numgprs & "次失败，你还要继续使主机上网吗？", vbYesNo + vbQuestion, "提示") <> vbYes Then
                   frm_main.ActiveBar21.Bands("statusbar").Tools("s1").Caption = "现在状态GSM    "
                   frm_main.ActiveBar21.RecalcLayout
                   frm_main.ActiveBar21.Bands("toobar").Tools("t2").Enabled = False
                   frm_main.ActiveBar21.Bands("toobar").Tools("t3").Enabled = False
                   Exit Sub
                End If
            End If
            senddata = StrConv(str, vbFromUnicode)
            comsenddata senddata
            numgprs = numgprs + 1 '//*********************************
            '//清空缓冲区
            ReDim bybuff(0) As Byte
            bybuff(0) = 0
            str = "ATJLWU"
            Exit Sub
         Case "t2" '与数据中心取得联系
            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_senddtaip
            If UBound(tempregdata2) = 0 And tempregdata2(0) = 0 Then Exit Sub
            regdata2 = ip_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
            If numcenter > 3 Then
               MsgBox ("暂时无法于数据中心取得练习，系统将采用GSM方式发送数据！"), vbOKOnly + vbInformation, "提示"
               frm_main.ActiveBar21.Bands("statusbar").Tools("s1").Caption = "现在状态GSM    "
               frm_main.ActiveBar21.RecalcLayout
               frm_main.ActiveBar21.Bands("toobar").Tools("t3").Enabled = False
               Exit Sub
            End If
           comsenddata regdata '发送数据
            '//清空缓冲区
            ReDim bybuff(0) As Byte
            bybuff(0) = 0
            numcenter = numcenter + 1
            Exit Sub
        Case "t3"
            frm_ip.Show 1
            Exit Sub
        Case "miExit"
            Unload frm_main
            Exit Sub
     End Select
    End If
    
End Sub
Private Function dispose_senddtaip() As Byte()
   Dim str1 As String
   Dim str2 As String
   Dim str3 As String
   Dim str4 As String
   Dim strsql As String
   Dim senddata() As Byte
   Dim num As Integer
   Dim i As Integer
   Dim arr() As String
   strsql = "select gongdiansuo_pw,gongdiansuo_regcode from gongdiansuoreg"
   openrs strsql
   str1 = rs.Fields("gongdiansuo_pw").Value
   str2 = rs.Fields("gongdiansuo_regcode").Value
   clors
   str3 = pcip
'   If frm_main.ActiveBar21.Bands("statusbar").Tools("s1").Caption = "现在状态GSM    " Then
'        ReDim senddata(0) As Byte
'        senddata(0) = 0
'        dispose_senddtaip = senddata
'        Exit Function
'   End If
   If Trim(str3) = "" Then
        MsgBox ("你还没有取得主机ＩＰ,请您取得主机ＩＰ!"), vbOKOnly + vbInformation, "提示"
        ReDim senddata(0) As Byte
        senddata(0) = 0
        dispose_senddtaip = senddata
        Exit Function
   End If
   str4 = GetInIKeyValue("pcset", "pcport", App.Path & "\file\gprspcset.ini")
   ReDim senddata(15) As Byte '主机登记IP数据包16字节
   For i = 0 To 5 Step 1 '主机密码
        num = Mid(str1, 2 * (i - 0) + 1, 2)
        senddata(i) = num
   Next i
   
   For i = 6 To 9 Step 1 '主机注册码
        num = Mid(str2, 2 * (i - 6) + 1, 2)
        senddata(i) = num
   Next i
   
   arr = VBA.Split(str3, ".", -1, vbTextCompare)
   For i = 10 To 13 Step 1 '主机IP
        senddata(i) = arr(i - 10)
   Next i
   
   For i = 14 To 15 Step 1 '主机端口
        num = Mid(str4, 2 * (i - 14) + 1, 2)
        senddata(i) = num
   Next i
   dispose_senddtaip = senddata
End Function

'//消息处理函数
Public Function disp_message(ByRef indata() As Byte) As remsg
    Dim i As Integer
    Dim str As String
    Dim myremsg As remsg
    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 str8 As String
    Dim str9 As String
    Dim str10 As String
    Dim str11 As String
    Dim str12 As String
    Dim str13 As String
    Dim str14 As String
    Dim str15 As String
    Dim str16 As String
    Dim str17 As String
    Dim str18 As String
    Dim str19 As String
    Dim str20 As String
    Dim str21 As String
    Dim str22 As String
    Dim num As Long
    Dim iquestion As Integer
    Dim strsql As String
    
    If indata(0) = 77 And indata(1) = 79 And indata(2) = 58 Then '//如果主机自己返回的数据***********
        '//ATJAU58.49.106.170PORT:3000WA:xxxxxxxx发送后返回的数据 (MO: Send Data Ok)
        If UBound(indata) = 17 Then
                str = StrConv(indata, vbUnicode)
                If Mid(str, 1, 16) = "MO: Send Data Ok" Then
                        ReDim myremsg.haltdata(0) As Byte '没有数据返回
                        myremsg.haltdata(0) = 0
                        myremsg.msginfo = str
                        MsgBox (myremsg.msginfo), vbOKOnly + vbInformation, "提示"
                        GoTo exitfunction
                End If
         End If
            
        '//ATJLWU发送后返回的1种数据
        '( MO: It's Online
        '  Local Ip:10.165.194.90.
        '  Local Name:LocalNm_
        '  Host Ip:0.0.0.0.
        '  OK)
        If UBound(indata) = 84 Or UBound(indata) = 85 Or UBound(indata) = 86 Then
                str = StrConv(indata, vbUnicode)
                pcip = Mid(str, 27, UBound(indata) - 71) '取得主机IP
                ReDim myremsg.haltdata(0) As Byte '没有数据返回
                myremsg.haltdata(0) = 0
                myremsg.msginfo = pcip 'str
                frm_main.ActiveBar21.Bands("statusbar").Tools("s1").Caption = "现在状态GPRS    主机IP为:" & pcip
                frm_main.ActiveBar21.RecalcLayout
                frm_main.ActiveBar21.Refresh
                MsgBox myremsg.msginfo
                GoTo exitfunction
        End If
    End If
    
    
    If indata(0) = 87 And indata(1) = 68 And indata(2) = 58 Then '//如果为数据中心或者终端返回的数据包
      If UBound(indata) > 36 Then '//包最短长度**************************
       
       '//注册后数据中心返回的信息(WD:XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX)
       If indata(34) = 67 And indata(35) = &H81 And indata(36) = &H1 And UBound(indata) = 105 Then
            '//处理区域号
                For i = 37 To 39 Step 1
                    num = indata(i)
                    If (indata(i) < 10) Then
                        str1 = str1 & "0" & num '小于10的数前面填0
                    Else
                        str1 = str1 & num
                    End If
                Next i
                
                '//处理区域名称
                ReDim tempdata(29) As Byte
                For i = 40 To 69 Step 1 '
                    tempdata(i - 40) = indata(i)
                Next i
                str2 = StrConv(tempdata, vbUnicode)
                str2 = RTrim(str2)
                
               '//处理区域密码
                For i = 70 To 75 Step 1
                    num = indata(i)
                    If (indata(i) < 10) Then
                        str3 = str3 & "0" & num
                    Else
                        str3 = str3 & num
                    End If
                Next i
                
                '//处理SIM 卡号
                For i = 76 To 80 Step 1
                    num = indata(i)
                    If (indata(i) < 10) Then
                        str4 = str4 & "0" & num
                    Else
                        str4 = str4 & num
                    End If
                Next i
                num = indata(81)
                str4 = str4 & num
                
                '//处理联系电话
                For i = 82 To 86 Step 1
                    num = indata(i)
                    If (indata(i) < 10) Then
                        str5 = str5 & "0" & num
                    Else
                        str5 = str5 & num
                    End If
                Next i
                num = indata(87)
                str5 = str5 & num
                
                '//处理联系手机
                For i = 88 To 92 Step 1
                    num = indata(i)
                    If (indata(i) < 10) Then
                        str6 = str6 & "0" & num
                    Else
                        str6 = str6 & num
                    End If
                Next i
                num = indata(93)
                str6 = str6 & num
                
                '//处理注册人
                ReDim tempdata(5) As Byte
                For i = 94 To 99 Step 1 '
                    tempdata(i - 94) = indata(i)
                Next i
                str7 = StrConv(tempdata, vbUnicode)
                str7 = RTrim(str7)
                
                For i = 100 To 103 Step 1
                    num = indata(i)
                    If (indata(i) < 10) Then
                        str8 = str8 & "0" & num '小于10的数前面填0
                    Else
                        str8 = str8 & num
                    End If
                Next i
                str = str1 & vbCrLf & str2 & vbCrLf & str3 & vbCrLf & str4 & vbCrLf & str5 & vbCrLf & str6 & vbCrLf & str7 & vbCrLf & str8
                ReDim myremsg.haltdata(0) As Byte '没有数据返回
                myremsg.haltdata(0) = 0
                myremsg.msginfo = str
    
               
                iquestion = MsgBox(str, vbYesNo + vbQuestion, "返回信息")
                If iquestion = vbYes Then
                    strsql = "select * from gongdiansuoreg"
                    openrs strsql
                    rs.AddNew
                    rs.Fields("gongdiansuo_id").Value = str1
                    rs.Fields("gongdiansuo_name").Value = str2
                    rs.Fields("gongdiansuo_pw").Value = str3
                    rs.Fields("gongdiansuo_sim").Value = str4
                    rs.Fields("gongdiansuo_tel").Value = str5
                    rs.Fields("gongdiansuo_mobile").Value = str6
                    rs.Fields("gongdiansuo_regman").Value = str7
                    rs.Fields("gongdiansuo_regcode").Value = str8
                    rs.UpdateBatch
                    clors
                End If
                GoTo exitfunction
            End If '//主机注册包结束
            
            '//登记主机ＩＰ后数据中心返回的信息(WD:XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX)
            If indata(34) = 16 And indata(35) = &H81 And indata(36) = &H2 And UBound(indata) = 54 Then
              
                For i = 37 To 42 Step 1
                     num = indata(i)
                     If (indata(i) < 10) Then
                         str1 = str1 & "0" & num
                     Else
                         str1 = str1 & num
                     End If
                Next i
                
                
                For i = 43 To 46 Step 1
                     num = indata(i)
                     If (indata(i) < 10) Then
                         str2 = str2 & "0" & num
                     Else
                         str2 = str2 & num
                     End If
                Next i
                
                
                For i = 47 To 49 Step 1
                     num = indata(i)
                     If (indata(i) < 10) Then
                         str3 = str3 & "0" & num & "."
                     Else
                         str3 = str3 & num & "."
                     End If
                Next i