frm_collect.frm

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

   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "有功总电量："
      Height          =   255
      Left            =   120
      TabIndex        =   45
      Top             =   2160
      Width           =   1095
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "无功总电量："
      Height          =   255
      Left            =   3720
      TabIndex        =   44
      Top             =   2160
      Width           =   1095
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "有功峰电量："
      Height          =   255
      Left            =   120
      TabIndex        =   43
      Top             =   2520
      Width           =   1095
   End
   Begin VB.Label Label8 
      BackStyle       =   0  'Transparent
      Caption         =   "有功谷电量："
      Height          =   255
      Left            =   120
      TabIndex        =   42
      Top             =   3240
      Width           =   1215
   End
   Begin VB.Label Label9 
      BackStyle       =   0  'Transparent
      Caption         =   $"frm_collect.frx":5F95
      Height          =   375
      Left            =   3720
      TabIndex        =   41
      Top             =   3000
      Width           =   1215
   End
   Begin VB.Label Label18 
      BackStyle       =   0  'Transparent
      Caption         =   "有功平电量："
      Height          =   255
      Left            =   120
      TabIndex        =   40
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label20 
      BackStyle       =   0  'Transparent
      Caption         =   "无功峰电量："
      Height          =   255
      Left            =   3720
      TabIndex        =   39
      Top             =   2520
      Width           =   1215
   End
   Begin VB.Label Label22 
      BackStyle       =   0  'Transparent
      Caption         =   "无功谷电量："
      Height          =   255
      Left            =   3720
      TabIndex        =   38
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label23 
      BackStyle       =   0  'Transparent
      Caption         =   "用户姓名："
      Height          =   255
      Left            =   3960
      TabIndex        =   37
      Top             =   840
      Width           =   975
   End
   Begin VB.Label Label25 
      BackStyle       =   0  'Transparent
      Caption         =   "请输入要采集的客户信息："
      Height          =   255
      Left            =   120
      TabIndex        =   36
      Top             =   360
      Width           =   2175
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "A相电压："
      Height          =   255
      Left            =   240
      TabIndex        =   35
      Top             =   4200
      Width           =   855
   End
   Begin VB.Label Label10 
      BackStyle       =   0  'Transparent
      Caption         =   "B相电压："
      Height          =   255
      Left            =   240
      TabIndex        =   34
      Top             =   4680
      Width           =   855
   End
   Begin VB.Label Label11 
      BackStyle       =   0  'Transparent
      Caption         =   "C相电压："
      Height          =   255
      Left            =   240
      TabIndex        =   33
      Top             =   5160
      Width           =   975
   End
   Begin VB.Label Label12 
      BackStyle       =   0  'Transparent
      Caption         =   "A相电流："
      Height          =   255
      Left            =   5760
      TabIndex        =   32
      Top             =   4200
      Width           =   1095
   End
   Begin VB.Label Label13 
      BackStyle       =   0  'Transparent
      Caption         =   "B相电流："
      Height          =   255
      Left            =   5760
      TabIndex        =   31
      Top             =   4680
      Width           =   975
   End
   Begin VB.Label Label14 
      BackStyle       =   0  'Transparent
      Caption         =   "C相电流："
      Height          =   255
      Left            =   5760
      TabIndex        =   30
      Top             =   5160
      Width           =   855
   End
   Begin VB.Label Label15 
      BackStyle       =   0  'Transparent
      Caption         =   "剩余电量："
      Height          =   255
      Left            =   7320
      TabIndex        =   29
      Top             =   2160
      Width           =   975
   End
   Begin VB.Label Label16 
      BackStyle       =   0  'Transparent
      Caption         =   "累计购电量："
      Height          =   255
      Left            =   7320
      TabIndex        =   28
      Top             =   2520
      Width           =   1215
   End
   Begin VB.Label Label17 
      BackStyle       =   0  'Transparent
      Caption         =   "功率因素："
      Height          =   255
      Left            =   7320
      TabIndex        =   27
      Top             =   2760
      Width           =   1095
   End
   Begin VB.Label Label19 
      BackStyle       =   0  'Transparent
      Caption         =   "变压器温度："
      Height          =   255
      Left            =   11040
      TabIndex        =   26
      Top             =   4440
      Width           =   1335
   End
   Begin VB.Label Label21 
      BackStyle       =   0  'Transparent
      Caption         =   "运行情况："
      Height          =   255
      Left            =   7320
      TabIndex        =   25
      Top             =   3120
      Width           =   975
   End
   Begin VB.Label Label24 
      BackStyle       =   0  'Transparent
      Caption         =   "采集时间："
      Height          =   255
      Left            =   11040
      TabIndex        =   24
      Top             =   2160
      Width           =   1095
   End
End
Attribute VB_Name = "frm_collect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private arrValues1(1 To 3, 1 To 2)
Private arrValues2(1 To 3, 1 To 2)
Private arrValues3(1 To 3, 1 To 2)
Private Sub Form_Load()
    arrValues1(1, 1) = "A相电流"
    arrValues1(2, 1) = "B相电流"
    arrValues1(3, 1) = "C相电流"
    arrValues1(1, 2) = 4  ' Series 1 values.
    arrValues1(2, 2) = 1  ' Series 1 values.
    arrValues1(3, 2) = 0.5  ' Series 1 values.
    MSChart1.ChartData = arrValues1
    
    arrValues2(1, 1) = "A相电压"
    arrValues2(2, 1) = "B相电压"
    arrValues2(3, 1) = "C相电压"
    arrValues2(1, 2) = 220  ' Series 1 values.
    arrValues2(2, 2) = 380  ' Series 1 values.
    arrValues2(3, 2) = 220  ' Series 1 values.
    MSChart2.ChartData = arrValues2
    
    
    arrValues3(1, 1) = "最高温度"
    arrValues3(2, 1) = "正常温度"
    arrValues3(3, 1) = "当前温度"
    arrValues3(1, 2) = 80  ' Series 1 values.
    arrValues3(2, 2) = 40  ' Series 1 values.
    arrValues3(3, 2) = 41  ' Series 1 values.
    MSChart3.ChartData = arrValues3
End Sub

Private Sub Timer1_Timer()
    arrValues1(1, 2) = txt_currenta.Text ' Series 1 values.
    arrValues1(2, 2) = txt_currentb.Text   ' Series 1 values.
    arrValues1(3, 2) = txt_currentc.Text  ' Series 1 values.
    MSChart1.ChartData = arrValues1
    arrValues2(1, 2) = txt_pressurea.Text ' Series 1 values.
    arrValues2(2, 2) = txt_pressureb.Text   ' Series 1 values.
    arrValues2(3, 2) = txt_pressurec.Text  ' Series 1 values.
    MSChart2.ChartData = arrValues2
    arrValues3(3, 2) = txt_temprature.Text  ' Series 1 values.
    MSChart3.ChartData = arrValues3
End Sub

'测试
Private Sub xpcmdbutton1_Click() '采集
    Dim i As Integer
    Dim senddata() As Byte
    Dim num As Long
    Dim str1 As String
    Dim str2 As String
    Dim strsql As String
    Dim pw As String
    Dim sum As Long
    If Trim(txt_ip.Text) = "" Then
        MsgBox ("终端ＩＰ：不能为空！"), vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    If Trim(txt_id.Text) = "" Then
        MsgBox ("请您先查询！"), vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    
    strsql = "select user_dtupw from userbasic where user_id='" & txt_id.Text & "'"
    openrs strsql
    pw = rs.Fields("user_dtupw").Value
    clors
    
    ReDim senddata(23) As Byte '//采集数据包长度24
    
    '//处理SIM卡号
    For i = 0 To 4
        num = Mid(Trim(txt_sim.Text), 2 * (i - 0) + 1, 2)
        senddata(i) = num
    Next i
    num = Mid(Trim(txt_sim.Text), 11, 1)
    senddata(5) = num
    
    '//处理表号（６）txt_biaohao.Text
    For i = 6 To 11 Step 1
        num = Mid(Trim(txt_biaohao.Text), 2 * (i - 6) + 1, 2)
        senddata(i) = num
    Next i

    '//处理用户密码（６）pw
    For i = 12 To 17 Step 1
        num = Mid(pw, 2 * (i - 12) + 1, 2)
        senddata(i) = num
    Next i
    
    '//密码取反（６）（12-17字节取反）
    For i = 18 To 23
         senddata(i) = Not senddata(i - 6)
    Next i

    '//累加和（１）
    For i = 0 To 23 Step 1
        num = senddata(i)
        sum = sum + num
        sum = sum Mod 256
    Next i
    senddata(23) = sum
    
    Dim strregdata1 As String
    Dim regdata1() As Byte
    Dim regdata2() As Byte
    Dim regdata() As Byte
    Dim numregdata As Integer
    Dim dtuip As String
    Dim dtuport As String
    
    
    dtuip = Trim(txt_ip.Text)
    dtuport = "80"
    If frm_main.ActiveBar21.Bands("statusbar").Tools("s1").Caption = "现在状态GSM    " Then
          strregdata1 = "ATJSS" & txt_sim.Text & "FDGJ000000:"
    Else
          strregdata1 = "ATJAU" & dtuip & "PORT:" & dtuport
    End If
    regdata1 = StrConv(strregdata1, vbFromUnicode)
    regdata2 = collect_pctodtu(senddata)
    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
    comsenddata regdata '发送数据
    '//清空缓冲区
    ReDim bybuff(0) As Byte
    bybuff(0) = 0
End Sub

Private Sub xpcmdbutton2_Click() '查询
    Dim strsql
    If Option1.Value = False And Option2.Value = False Then
        MsgBox ("您没有选择查询条件！"), vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    If Trim(txt_qurry.Text) = "" Then
        MsgBox ("查询值不能为空！"), vbOKOnly + vbInformation, "提示"
        Exit Sub
    End If
    If Option1.Value = True Then
        strsql = "select * from userbasic where user_id='" & Trim(txt_qurry.Text) & "'"
        openrs strsql
        If rs.EOF Then
            MsgBox ("该用户还没有开户！"), vbOKOnly + vbInformation, "提示"
            clors
            Exit Sub
        End If
    End If
    If Option2.Value = True Then
        strsql = "select * from userbasic where user_sim='" & Trim(txt_qurry.Text) & "'"
        openrs strsql
        If rs.EOF Then
            MsgBox ("该用户还没有开户！"), vbOKOnly + vbInformation, "提示"
            clors
            Exit Sub
        End If
    End If
    txt_id.Text = rs.Fields("user_id").Value
    txt_name.Text = rs.Fields("user_name").Value
    txt_sim.Text = rs.Fields("user_sim").Value
    txt_biaohao.Text = rs.Fields("user_biaohao").Value
    clors
    
End Sub