frmbufpara.frm

智能安防报警系统 建立安防信息数据库 端口设置和定时读取I/O端口数据 判断是否有触发事件 启动并口对应的报警设备 根据设置拨打报警电话 安防日志管理

   Unload Me
End Sub

Private Sub cmdEnter_Click()
   Call getdata              '将数据写入全局变量中
  If Not dataCheck() Then    '数据检查,若数据检查不通过
     MsgBox ("请检查数据")    '则弹出提示对话框，退出目前运行的
     Exit Sub                '程序
  End If
  '根据处警form上的caption判断action
    Select Case Me.Caption
      Case "删除处警"
           If MsgBox("是否确实要删除该条处警参数", vbYesNo, "询问") = vbYes Then
             '将全局变量从listview中和数据库中删除
               Call deleteBf
           End If
      Case "添加处警"
             '将全局变量添加到listview和数据库中
              Call AddNew
      Case "修改处警"
             '将全局变量修改到listview和数据库中
               Call editBf
    End Select
  
  Unload Me
End Sub

Private Sub Form_Load()
   Me.Top = (Screen.Height - Me.Height) / 2
   Me.Left = (Screen.Width - Me.Width) / 2
   
   Call Init   '初始化
End Sub
'从form中的text等控件得到处警参数
Private Sub getdata()
  
    gcjna = Trim$(Text1.Text)    '处警名字
    gcjnu = Trim$(Text2.Text)    '处警编号
    gcjic = Trim$(Text3.Text)    '信息码
    gcjca = Trim$(Text4.Text)    '拨号码
  
    If Option1.Value Then        '端口性质
         gcjpt = "串口"
    Else
         gcjpt = "并口"
    End If
 
    If Option3.Value Then        '处警动作
        gcjta = "发码"
        gcjca = "-"
    Else
        gcjta = "拨号"
        gcjic = "-"
    End If
    
End Sub
'参数初始化
Private Sub Init()
  If chkLine = 0 Then Exit Sub
  
   gcjna = frmSetpara2.lvwPara.ListItems(chkLine).Text
   gcjpt = frmSetpara2.lvwPara.ListItems(chkLine).SubItems(1)
   gcjnu = frmSetpara2.lvwPara.ListItems(chkLine).SubItems(2)
   gcjta = frmSetpara2.lvwPara.ListItems(chkLine).SubItems(3)
   gcjic = frmSetpara2.lvwPara.ListItems(chkLine).SubItems(4)
   gcjca = frmSetpara2.lvwPara.ListItems(chkLine).SubItems(5)
   
   Select Case gcjta
       Case "发码"
             Option3.Value = True
             Call Option3_Click
       Case "拨号"
             Option4.Value = True
             Call Option4_Click
   End Select
   
     Text1.Text = gcjna
     Text2.Text = gcjnu
   
   If gcjpt = "串口" Then
      Option1.Value = True
      Option2.Value = False
   Else
      Option2.Value = True
      Option1.Value = False
   End If
   
End Sub
'新加一条记录
Private Sub AddNew()
  On Error GoTo x
Dim rs As ADODB.Recordset
      Set rs = New ADODB.Recordset
          rs.Open "select * from chujingset;", cn, adOpenDynamic, adLockOptimistic
       rs.AddNew
           rs!cjname = gcjna
           rs!porperty = gcjpt
           rs!Number = gcjnu
           rs!typeact = gcjta
           rs!infocode = gcjic
           rs!telnumber = gcjca
        rs.Update
        rs.Close
      
      '将list更新
Dim mitem As ListItem
        Set mitem = frmSetpara2.lvwPara.ListItems.Add(Text:=gcjna)
            mitem.SubItems(1) = gcjpt
            mitem.SubItems(2) = gcjnu
            mitem.SubItems(3) = gcjta
            mitem.SubItems(4) = gcjic
            mitem.SubItems(5) = gcjca
           
      Exit Sub
x:
   MsgBox ("请再次检查数据")
End Sub
'删除一条记录
Private Sub deleteBf()
  On Error GoTo x
Dim rs As ADODB.Recordset
Dim str As String
      Set rs = New ADODB.Recordset
      str = "select * from chujingset where cjname = '" & gcjna & _
             "'and porperty ='" & gcjpt & "'and number ='" & gcjnu & _
             "'and typeact ='" & gcjta & "'and infocode='" & gcjic & _
             "' and telnumber='" & gcjca & "';"
      rs.Open str, cn, adOpenDynamic, adLockOptimistic
   
   If rs.EOF Or rs.BOF Then
      MsgBox ("数据库中没有这条记录")
      Exit Sub
   Else
      rs.Delete
   End If
   rs.Close
    
   frmSetpara2.lvwPara.ListItems.Remove chkLine
    
    Exit Sub
x:
    MsgBox ("Error # " & CStr(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & Err.Description)
End Sub
'编辑一条纪录
Private Sub editBf()
  On Error GoTo errordo
  
Dim rs As ADODB.Recordset
Dim str As String
Dim tempbfname As String
       Set rs = New ADODB.Recordset
       tempbfname = frmSetpara2.lvwPara.ListItems(chkLine)
       str = "select * from chujingSet where cjname = '" & tempbfname & "';"
      
      rs.Open str, cn, adOpenDynamic, adLockOptimistic
           
           rs!cjname = gcjna
           rs!porperty = gcjpt
           rs!Number = gcjnu
           rs!typeact = gcjta
           rs!infocode = gcjic
           rs!telnumber = gcjca
      
      rs.Update
      
      rs.Close
      
      Dim mitem As ListItem
      
      Set mitem = frmSetpara2.lvwPara.ListItems(chkLine)
          mitem.Text = gcjna
          mitem.SubItems(1) = gcjpt
          mitem.SubItems(2) = gcjnu
          mitem.SubItems(3) = gcjta
          mitem.SubItems(4) = gcjic
          mitem.SubItems(5) = gcjca
     
      Exit Sub
errordo:
     MsgBox ("Error # " & CStr(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & Err.Description)
End Sub

Private Sub Option3_Click()
   Text3.Text = gcjic
   Text3.Enabled = True
   Text3.BackColor = vbWhite
   Text4.Text = ""
   Text4.Enabled = False
   Text4.BackColor = vbScrollBars
End Sub

Private Sub Option4_Click()
   Text4.Text = gcjca
   Text4.Enabled = True
   Text4.BackColor = vbWhite
   Text3.Enabled = False
   Text3.Text = ""
   Text3.BackColor = vbScrollBars
End Sub
'数据检查规则：判断form上是否有text未填入
Private Function dataCheck() As Boolean
   If (gcjna <> "") And (gcjpt <> "") And (gcjnu <> "") And (gcjta <> "") _
       And ((gcjic <> "") Or (gcjca <> "")) Then
       dataCheck = True
   Else
      dataCheck = False
   End If
End Function

Private Sub Text2_Change()
    
'    '判断端口编号是否为数字
'    If Not IsNumeric(Text2.Text) Then
'               If Text2.Text <= 0 Then
'                   Dim n As Integer
'                    n = MsgBox("端口编号应该为十进制数", , 重要提示)
'                    Text2.Text = "0"
'               End If
'    End If
'    '如果端口编号是数字的话
'    '再分别按照端口类型判断
'    'option1:串行端口
'    If Option1.Enabled And Option1.Value Then
'             If CLng(Text2.Text) > 16 Then
'                   MsgBox ("串口编号范围在0-16之间")
'                   Text2.Text = "0"
'             End If
'    End If
'    'option2:并行端口
'    If Option1.Enabled And Option2.Value Then
'             If CLng(Text2.Text) > 65536 Then
'                   MsgBox ("并口编号范围在0-65536之间")
'                   Text2.Text = "0"
'             End If
'     End If
             
End Sub

Private Sub Text2_Validate(Cancel As Boolean)
   '判断端口编号是否为数字
    If Not IsNumeric(Text2.Text) Then
               If Text2.Text <= 0 Then
                   Dim n As Integer
                    n = MsgBox("端口编号应该为十进制数", , 重要提示)
                    Text2.Text = "0"
               End If
    End If
    '如果端口编号是数字的话
    '再分别按照端口类型判断
    'option1:串行端口
    If Option1.Value Then
             If CLng(Text2.Text) > 16 Then
                   MsgBox ("串口编号范围在0-16之间")
                   Text2.Text = "0"
             End If
    End If
    'option2:并行端口
    If Option2.Value Then
             If CLng(Text2.Text) > 65536 Then
                   MsgBox ("并口编号范围在0-65536之间")
                   Text2.Text = "0"
             End If
     End If
     
    Cancel = True
End Sub

Private Sub Text3_Validate(Cancel As Boolean)
   '如果是发码
    If Option3.Value Then
        If Not IsNumeric(Text3.Text) Then
                    Dim n As Integer
                        n = MsgBox("信号码应该为十进制数", , 重要提示)
                        Text3.Text = "0"
        End If
    End If
    
    Cancel = True
End Sub

Private Sub Text4_Validate(Cancel As Boolean)
   '如果是拨号
    If Option4.Value Then
       If Not IsNumeric(Text4.Text) Then
                     Dim n As Integer
                         n = MsgBox("电话号码应该为数字", , 重要提示)
                         Text4.Text = "0"
       End If
    End If
End Sub