frmmodel.frm

基于VB、Access、研华IO模块、Gprs模块的远程监控系统

InitFail: MsgBox "初始化出错！"
          CmdInit.Enabled = False
          Exit Sub
smscfail: MsgBox "请输入短消息中心号码！"
End Sub

Private Sub CmdopenCOM_Click()
Dim buf$, retbuf$, rate%, ratebuf$

  '判断通信端口是否落在1－16之间
  If CmbCOM.ListIndex >= 0 And CmbCOM.ListIndex <= 16 Then
        MSComm1.CommPort = CmbCOM.ListIndex + 1
    Else
       MsgBox "指定通信口时发生错误！", vbCritical + vbOKOnly, "系统信息"
       Exit Sub
    End If
  '激活错误检测机制
    On Error GoTo comerr
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.PortOpen = True
    CmdOpenCOM.Enabled = False
   ' CmdStart.Enabled = True
    
    lblmsg.Caption = "可单击【开始检测】按钮，执行检测工作"
    buf = Cmb4024.List(Cmb4024.ListIndex)
    
    If Len(buf) = 1 Then
       buf = "0" & buf
    End If
    MSComm1.Output = "#" & buf & Format(0, "00.000") & Chr(13)
    retbuf = waitRS(MSComm1, vbCr, 1000)
  
    Pic1.Cls
    Pic2.Cls
    Pic3.Cls
    Pic4.Cls
    Pic5.Cls
    Pic6.Cls
    n1 = 0
    n2 = 0
    n3 = 0
    n4 = 0
    n5 = 0
    n6 = 0
    Timer3.Interval = 200
    Frame1.Enabled = True
    CmdOpenCOM.Enabled = False
   ' Cmdsetting.Enabled = True
    Frame1.Enabled = False
    'Frame2.Enabled = True
    CmdStart.Enabled = True
    CmdEnd.Enabled = True
    Exit Sub
comerr:
    MsgBox "打开通信端口时发生错误！请确定通信端口是否存在且正常。", vbCritical + vbOKOnly, "系统信息"
    
End Sub


Private Sub Cmdsetting_Click()
    limit1 = Text1.Text
    limit2 = Text2.Text
    limit3 = Text3.Text
    limit4 = Text4.Text
    limit5 = Text5.Text
    limit6 = Text6.Text
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Then
   MsgBox "请输入门限值!"
Else
   ' CmdStart.Enabled = True
    Cmdsetting.Enabled = False
End If
End Sub

Private Sub CmdStart_Click()
      
    Timer1.Enabled = Not Timer1.Enabled
    Timer3.Interval = 100
    
    If Timer1.Enabled Then
      CmdStart.Caption = "停止检测"
    Else
      CmdStart.Caption = "开始检测"
      lblmsg.Caption = "已停止检测"
    End If
    
End Sub

Private Sub Form_Load()
    Dim str As String
    Dim i As Integer
    
    MaxPlotNo = 100
    n1 = 0
    Cmb4017.Clear
    For i = 1 To 255
      Cmb4017.AddItem CStr(Hex(i))
      Cmb4024.AddItem CStr(Hex(i))
    Next i
    Cmb4017.ListIndex = 0
    Cmb4024.ListIndex = 1
    CmbCOM.Clear
    CmbCOM.AddItem "COM1"
    CmbCOM.AddItem "COM2"
    CmbCOM.AddItem "COM3"
    CmbCOM.AddItem "COM4"
    '加一个串口
    CmbCOM.ListIndex = 2
    
      port(0) = "1"
      port(1) = "2"
      port(2) = "3"
      port(3) = "4"
      port(4) = "5"
      For i = 0 To 4
         CmbPort.AddItem port(i)
      Next i
      CmbPort.ListIndex = 0
      sendcmb(0) = "[phone]"
      SendNOCmb.AddItem sendcmb(0)
      smsc(0) = "[phone]"
      smsc(1) = "[phone]"
      For i = 0 To 1
        CmbSMSC.AddItem smsc(i)
      Next i
      CmbSMSC.ListIndex = 0
   ' CmdStart.Enabled = False
    Pic1.Scale (0, 10)-(MaxPlotNo, -10)
    Pic1.DrawWidth = 2
    Pic2.Scale (0, 10)-(MaxPlotNo, -10)
    Pic2.DrawWidth = 2
    Pic3.Scale (0, 10)-(MaxPlotNo, -10)
    Pic3.DrawWidth = 2
    Pic4.Scale (0, 10)-(MaxPlotNo, -10)
    Pic4.DrawWidth = 1
    Pic5.Scale (0, 10)-(MaxPlotNo, -10)
    Pic5.DrawWidth = 1
    Pic6.Scale (0, 10)-(MaxPlotNo, -10)
    Pic6.DrawWidth = 1
  
    Pic2.Visible = False
    Pic3.Visible = False
    Pic4.Visible = False
    Pic5.Visible = False
    Pic6.Visible = False
   
    '动态链接数据库
    str = App.Path
    Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & str & "\db1.mdb;Persist Security Info=False"
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from 钻井数据表"
    Adodc1.Refresh
    Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & str & "\db1.mdb;Persist Security Info=False"
    Adodc2.CommandType = adCmdText
    Adodc2.RecordSource = "select * from 发送人员表"
    Adodc2.Refresh
    Adodc3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & str & "\db1.mdb;Persist Security Info=False"
    Adodc3.CommandType = adCmdText
    Adodc3.RecordSource = "select * from 人员短信回复表"
    Adodc3.Refresh
    
End Sub


Private Sub Slider1_Click()
Dim buf$, valuestr As Single, pos1%, flag As Boolean
  Dim retbuf$
  
    If CmdOpenCOM.Enabled Then
      lblmsg.Caption = "尚未打开通信端口"
      Exit Sub
    End If
    
    buf = Cmb4024.List(Cmb4024.ListIndex)
    
    If Len(buf) = 1 Then
      buf = "0" & buf
    End If
   lblvalue.Caption = Slider1.Value / 10 & "V"
  '发送模拟命令
    MSComm1.Output = "#" & buf & "C0+" & Format(Slider1.Value / 10, "00.000") & Chr(13)
    lblmsg.Caption = "联机" & buf & "中......"
     retbuf = waitRS(MSComm1, vbCr, 1000)
    
    If retbuf = "" Then
      lblmsg.Caption = "输出电压失败"
      Exit Sub
    End If
    
     MSComm1.Output = "$" & buf & "6C0" & Chr(13)
     retbuf = waitRS(MSComm1, vbCr, 1000)
     If retbuf = "" Or Len(retbuf) < 9 Then
        lblmsg.Caption = "读回失败"
        Exit Sub
     End If
  
  lblreadBack.Caption = Val(Mid(retbuf, 4, 6)) & "V"
End Sub

Private Sub Timer1_Timer()
 Dim i1%, s1$, smsc$, sms1$
 Dim c1&, c2&, c3&, c4&, c5&, c6&
 Dim s2$, s3$, sms2$, sendno$
 Dim buf$, sendno1$
 Dim pos1%
 Dim DAValue As Single, retbuf$
 Dim flag As Boolean
 Dim flag1 As Boolean, flag2 As Boolean, flag3 As Boolean, flag4 As Boolean, flag5 As Boolean, flag6 As Boolean
 Dim i&, X!, Y!
 Dim l1&, l2&, l3&, l4&, l5&, l6&
 
 
   buf = Cmb4017.List(Cmb4017.ListIndex) '取得4017+的地址号码
   If Len(buf) = 1 Then
     buf = "0" & buf
   End If
   MSComm1.Output = "#" & buf & Chr(13) '发送采集命令，采集所有通道数据
   lblmsg.Caption = "联机" & buf & "中......"
   buf = waitRS(MSComm1, vbCr, 1000)
  If buf = "" Then
      lblmsg.Caption = "取值失败"
      Exit Sub
  End If
   pos1 = InStr(1, buf, ">")
   
   If pos1 = 0 Then
        lblmsg.Caption = "返回值不正确"
        Exit Sub
   End If
   '进行数据分离，并显示出来
   StandpipeTxt.Text = Mid(buf, pos1 + 1, 7)
   TorqueTxt.Text = Mid(buf, pos1 + 8, 7)
   LevelTxt.Text = Mid(buf, pos1 + 15, 7)
   FlowTxt.Text = Mid(buf, pos1 + 22, 7)
   LoadTxt.Text = Mid(buf, pos1 + 29, 7)
   SpeedTxt.Text = Mid(buf, pos1 + 36, 7)
   
    '画出所有参数实时曲线图
              
         flag1 = plot(StandpipeTxt.Text, Pic1, n1, prevalue1)
         flag2 = plot(TorqueTxt.Text, Pic2, n2, prevalue2)
         flag3 = plot(LevelTxt.Text, Pic3, n3, prevalue3)
         flag4 = plot(FlowTxt.Text, Pic4, n4, prevalue4)
         flag5 = plot(LoadTxt.Text, Pic5, n5, prevalue5)
         flag6 = plot(SpeedTxt.Text, Pic6, n6, prevalue6)
   '显示单个参数实时曲线图
  If OptStandpipe.Value = True Then
      Pic2.Visible = False
      Pic3.Visible = False
      Pic4.Visible = False
      Pic5.Visible = False
      Pic6.Visible = False
      Pic1.Visible = True
  ElseIf OptTorque.Value = True Then
     Pic1.Visible = False
     Pic3.Visible = False
     Pic4.Visible = False
     Pic5.Visible = False
     Pic6.Visible = False
     Pic2.Visible = True
  ElseIf OptLevel.Value = True Then
     Pic1.Visible = False
     Pic2.Visible = False
     Pic4.Visible = False
     Pic5.Visible = False
     Pic6.Visible = False
     Pic3.Visible = True
  ElseIf OptFlow.Value = True Then
     Pic1.Visible = False
     Pic2.Visible = False
     Pic3.Visible = False
     Pic5.Visible = False
     Pic6.Visible = False
     Pic4.Visible = True
  ElseIf OptLoad.Value = True Then
     Pic1.Visible = False
     Pic2.Visible = False
     Pic3.Visible = False
     Pic4.Visible = False
     Pic6.Visible = False
     Pic5.Visible = True
  ElseIf OptSpeed.Value = True Then
     Pic1.Visible = False
     Pic2.Visible = False
     Pic3.Visible = False
     Pic4.Visible = False
     Pic5.Visible = False
     Pic6.Visible = True
  End If
   
    c1 = Val(StandpipeTxt.Text)
    c2 = Val(TorqueTxt.Text)
    c3 = Val(LevelTxt.Text)
    c4 = Val(FlowTxt.Text)
    c5 = Val(LoadTxt.Text)
    c6 = Val(SpeedTxt.Text)
    
    Timer2.Enabled = True
    
   '简单判断是否发生复杂情况
   If c1 > 10 Or c2 > 10 Or c3 > 10 Or c4 > 10 Or c5 > 10 Or c6 > 10 Then
        
        '若发生复杂情况，把钻井数据发送到远程技术人员手机上
        Timer1.Enabled = False
        Timer3.Enabled = False
        send = StandpipeTxt.Text & "；" & TorqueTxt.Text & "；" & LevelTxt.Text & "；" & FlowTxt.Text & "；" & LoadTxt.Text & "；" & LoadTxt.Text & "；" & SpeedTxt.Text
        sendno1 = SendNOCmb.Text
        flag = sendSMS(MSComm2, CmbSMSC.Text, sendno1, send)
        
        If Not flag Then
          GoTo senderr
        Else
          Timer3.Enabled = True
          timedelay (1000)
          
        End If

    End If
    Timer1.Enabled = True
    Exit Sub
    
senderr:   MsgBox "发送失败"
End Sub

Private Sub Timer2_Timer()
'把采集到的钻井数据存入数据库
    Adodc1.Recordset.AddNew
    Adodc1.Recordset("时间") = Now()
    Adodc1.Recordset("立管压力") = StandpipeTxt.Text
    Adodc1.Recordset("转盘扭矩") = TorqueTxt.Text
    Adodc1.Recordset("泥浆池液位") = LevelTxt.Text
    Adodc1.Recordset("泥浆泵流量") = FlowTxt.Text
    Adodc1.Recordset("大钩负荷") = LoadTxt.Text
    Adodc1.Recordset("转盘转速") = SpeedTxt.Text
    Adodc1.Recordset.Update
End Sub


Private Sub Timer3_Timer() '定时查询缓冲区，检查是否收到新的短信息
    Dim buf As String
    Dim dummyar As String, i1 As String, i2 As Integer, i3 As String
    Dim s1 As String, s2 As String, s3 As String
    Dim r1 As String, r2 As String, r3 As String
    Dim year As String, month As String, day As String, time As String
    Dim flag As Boolean
    
    If MSComm2.InBufferCount > 0 Then
       
       buf = buf + MSComm2.Input
       
       If InStr(buf, "+CMTI:") Then
          MsgBox "收到新短信！"
          Timer3.Interval = 0
          Timer1.Enabled = False
          MSComm2.InBufferCount = 0
          i1 = InStr(buf, ",")
          s1 = Mid(buf, i1 + 1, 2)
         MSComm2.Output = "AT+CMGR=" + Trim(s1) + vbCr '发送读短消息命令
         timedelay (200) '延时
         buf = waitRS(MSComm2, "OK", 1000)
     
                i2 = InStr(buf, "0891")
                s2 = Mid(buf, i2)
                i3 = InStr(i2, s2, vbCr)
                s3 = Mid(s2, 1, i3 - 1)
                readSMS (s3)
               
                year = Mid(rTime, 1, 2)
                month = Mid(rTime, 3, 2)
                day = Mid(rTime, 5, 2)
                  r1 = Mid(rTime, 7, 2)
                  r2 = Mid(rTime, 9, 2)
                  r3 = Mid(rTime, 11, 2)
                  time = year & "-" & month & "-" & day & " " & r1 & ":" & r2 & ":" & r3
               
                '把接收到的短消息存入数据库
                Adodc3.Recordset.AddNew
                Adodc3.Recordset("手机号码") = rNo
                Adodc3.Recordset("SMSC号码") = rSMSC
                Adodc3.Recordset("时间") = time
                Adodc3.Recordset("短信内容") = rSMS
                Adodc3.Recordset.Update
          
          If rSMS = "收到" Then
               FrameOutput.Enabled = True
          ElseIf rSMS = "查询" Then
          send = StandpipeTxt.Text & "；" & TorqueTxt.Text & "；" & LevelTxt.Text & "；" & FlowTxt.Text & "；" & LoadTxt.Text & "；" & LoadTxt.Text & "；" & SpeedTxt.Text
               flag = sendSMS(MSComm2, CmbSMSC.Text, rNo, send)
               
              If Not flag Then
                 GoTo senderr
              Else
                 Timer1.Enabled = True
              End If
          End If
          Timer1.Enabled = True
       End If
    End If
   Timer3.Interval = 100
   Exit Sub
senderr: MsgBox "查询信息失败！"
End Sub