form2.frm

连动报警录象程序及其说明

      Width           =   345
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义串口中用到的变量
Dim iEverySensorChan(17) As Integer '单个探头对应的录象通道号，数组下标是探头号
Dim iEverySensorChanNum As Integer  '单个探头对应的录象通道总数
Dim iEverySensorOutputK(17) As Integer '单个探头对应的报警输出开关号，数组下标是探头号
Dim iEverySensorOutputKNum As Integer   '单个探头对应的报警输出开关总数
Dim jtemp As Integer
Dim OutNum As Integer
Dim OutTd(16) As Integer
Dim strKey As String
Public pp, sqlstr, DayR, Myday As String

Private Sub Command1_Click()
For i = 1 To 16
Cf (i)
Next
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim j As Integer
j = 300
For i = 1 To 16
 Image1(i).Top = 300
 Image2(i).Top = 300
 Image3(i).Top = 800
 Image4(i).Top = 800
 Image1(i).Left = j
 Image2(i).Left = j
 Image3(i).Left = j
 Image4(i).Left = j
  j = j + 500
Next
Myday = App.Path + "\mydb.mdb"
DayR = App.Path + "\history.mdb"
pp = App.Path + "\config.mdb"
Adodc1.RecordSource = "newcf"
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Password='';Persist Security Info=True;Data Source=" & pp
Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Password='';Persist Security Info=True;Data Source=" & DayR
Adodc3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Password='';Persist Security Info=True;Data Source=" & Myday
'打开串口
MSComm1.CommPort = 1
MSComm1.Settings = "9600,n,8,1"
MSComm1.InputLen = 1
MSComm1.InputMode = comInputModeBinary
MSComm1.RThreshold = 1
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If

End Sub

'根据探头号取得其对应的“常开”的状态
Public Function GetAwaysOn(sensorNo As Integer) As String
strKey = "NONC" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from newcf where StrKey = '" & strKey & "' "
Adodc1.Refresh
 GetAwaysOn = Adodc1.Recordset.Fields(1)
End Function

'根据探头号取得其对应的“全天录象”的状态
Public Function GetWholeDay(sensorNo As Integer) As String
strKey = "WholeDay" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from newcf where StrKey = '" & strKey & "' "
Adodc1.Refresh
 GetWholeDay = Adodc1.Recordset.Fields(1)
End Function
'根据探头号取得其对应的设防的“开始时间”
Public Function GetAlarmTimeStart(sensorNo As Integer) As String
Dim strAlarmStarHour As String
Dim strAlarmStarMinute As String

strKey = "AlarmHourStart" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from newcf where StrKey ='" & strKey & "' "
Adodc1.Refresh
 strAlarmStarHour = Adodc1.Recordset.Fields(1)
 If Len(strAlarmStarHour) = 1 Then strAlarmStarHour = "0" & strAlarmStarHour
 
 Adodc1.RecordSource = "select * from newcf where StrKey = 'AlarmMinuteStart1' "
Adodc1.Refresh
 strAlarmStarMinute = Adodc1.Recordset.Fields(1)
 If Len(strAlarmStarMinute) = 1 Then strAlarmStarMinute = "0" & strAlarmStarMinute
 
 GetAlarmTimeStart = strAlarmStarHour & ":" & strAlarmStarMinute & ":00"
End Function
'根据探头号取得其对应的设防的“结束时间”
Public Function GetAlarmTimeEnd(sensorNo As Integer) As String
Dim strAlarmHourEnd As String
Dim strAlarmMinuteEnd As String

strKey = "AlarmHourEnd" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from newcf where StrKey ='" & strKey & "' "
Adodc1.Refresh
 strAlarmHourEnd = Adodc1.Recordset.Fields(1)
 If Len(strAlarmHourEnd) = 1 Then strAlarmHourEnd = "0" & strAlarmHourEnd
 
 strKey = "AlarmMinuteEnd" + Trim(Str(sensorNo))
 Adodc1.RecordSource = "select * from newcf where StrKey = '" & strKey & "' "
 Adodc1.Refresh
 strAlarmMinuteEnd = Adodc1.Recordset.Fields(1)
 If Len(strAlarmMinuteEnd) = 1 Then strAlarmMinuteEnd = "0" & strAlarmMinuteEnd
 
 GetAlarmTimeEnd = strAlarmHourEnd & ":" & strAlarmMinuteEnd & ":00"
End Function
Private Sub Cf(iNo As Integer)
'Dim iNo As Integer
Dim OutNo As Integer
On Error Resume Next
'Check1(iNo) = GetAwaysOn(iNo)            '常开
'Check2(iNop) = GetWholeDay(iNo)           '全天
'Text1(iNo).Text = GetAlarmTimeStart(iNo) '开始时间
'Text2(iNo).Text = GetAlarmTimeEnd(iNo)   '结束时间
'Text3(iNo) = GetRecChan(iNo)             '录象通道
'Text4(iNo) = GetOutputKNo(iNo)           '报警输出
'iNo = 2
MsgBox "全天" & GetWholeDay(iNo) & "开始时间" & GetAlarmTimeStart(iNo) & "结束时间" & GetAlarmTimeEnd(iNo) & "报警输出" & SendoutAlarmChan(iNo)
'MsgBox Str(iEverySensorOutputK(1)) & " " & Str(iEverySensorOutputK(2)) & " " & Str(iEverySensorOutputK(3))
SetAlarmInImageColor (iNo)
'加入日志
        Adodc2.RecordSource = "select * from alarm"
        Adodc2.Refresh
        Adodc2.Recordset.AddNew
          Adodc2.Recordset.Fields(1) = Date
          Adodc2.Recordset.Fields(2) = Time
          Adodc2.Recordset.Fields(3) = "Administrator"
          Adodc2.Recordset.Fields(4) = "第" & iNo & "通道传感器触发报警"
          Adodc2.Recordset.Fields(5) = "传感器"
        Adodc2.Recordset.Update
'加日志自己
        Adodc3.RecordSource = "select * from alarm"
        Adodc3.Refresh
        Adodc3.Recordset.AddNew
        Adodc3.Recordset.Fields(1) = Date
        Adodc3.Recordset.Fields(2) = Time
        Adodc3.Recordset.Fields(3) = "Administrator"
        Adodc3.Recordset.Fields(4) = "第" & iNo & "通道传感器触发报警"
        Adodc3.Recordset.Fields(5) = "传感器"
        Adodc3.Recordset.Update
If SendoutAlarmChan(iNo) <> "" Then
        For OutNo = 1 To GetOutputKTotal(iNo)
           SetAlarmOutImageColor (iEverySensorOutputK(OutNo))
        Next OutNo
End If
End Sub

'根据探头号取得与之对应的录象通道总数
Public Function GetRecChanNumber(sensorNo As Integer) As Integer
Dim itemp As Integer
strKey = "SensorRecChnSenRecNum" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from security where StrKey = '" & strKey & "' "
Adodc1.Refresh
 GetRecChanNumber = Adodc1.Recordset.Fields(1)

End Function

'根据探头号取得与之对应的录象通道号（有几个录象通道就显示几个，中间用逗号隔开）
'同时，将取得的通道号存入数组iEverySensorChan（）内，数组的下标从1开始,
Public Function GetRecChan(sensorNo As Integer) As String
Dim itemp As Integer
strKey = "SensorRecChnSenRecNum" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from security where StrKey = '" & strKey & "' "
Adodc1.Refresh
 iEverySensorChanNum = Adodc1.Recordset.Fields(1)
 If iEverySensorChanNum > 0 Then 'iEverySensorChanNum=0表示没有设置与该探头联动的录象通道
    
    For itemp = 1 To iEverySensorChanNum
    strKey = "SensorRecChnSenRecSel" + Trim(Str(sensorNo)) + Trim(Str(itemp))
    Adodc1.RecordSource = "select * from security where StrKey = '" & strKey & "'"
    Adodc1.Refresh
    iEverySensorChan(itemp) = Adodc1.Recordset.Fields(1) + 1
    GetRecChan = GetRecChan & Str(Adodc1.Recordset.Fields(1) + 1) & ","
    Next itemp
    GetRecChan = Left(GetRecChan, Len(GetRecChan) - 1)
    
End If
End Function
'根据探头号取得与之对应的报警输出开关总数
Public Function GetOutputKTotal(sensorNo As Integer) As Integer
Dim itemp As Integer
strKey = "SenIOOutSenIOOutNum" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from security where StrKey = '" & strKey & "' "
Adodc1.Refresh
 GetOutputKTotal = Adodc1.Recordset.Fields(1)
 
End Function
'根据探头号取得与之对应的报警输出开关号（有几个输出开关就显示几个，中间用逗号隔开）
'同时，将取得的通道号存入数组iEverySensorOutputK()内，数组的下标从1开始
Public Function GetOutputKNo(sensorNo As Integer) As String
Dim itemp As Integer
On Error Resume Next
For itemp = 1 To 16
iEverySensorOutputK(itemp) = 0
Next itemp

strKey = "SenIOOutSenIOOutNum" + Trim(Str(sensorNo))
Adodc1.RecordSource = "select * from security where StrKey = '" & strKey & "' "
Adodc1.Refresh
 iEverySensorOutputKNum = Adodc1.Recordset.Fields(1)
 If iEverySensorOutputKNum > 0 Then 'iEverySensorOutputKNum=0表示没有设置与该探头联动的报警输出开关
    
    For itemp = 1 To iEverySensorOutputKNum
        strKey = "SenIOOutSenIOOutSel" + Trim(Str(sensorNo)) + Trim(Str(itemp))
        Adodc1.RecordSource = "select * from security where StrKey = '" & strKey & "'"
        Adodc1.Refresh
        iEverySensorOutputK(itemp) = Adodc1.Recordset.Fields(1) + 1
        GetOutputKNo = GetOutputKNo & Str(Adodc1.Recordset.Fields(1) + 1) & ","
        OutNum = OutNum + 1       '输出个数
        OutTd(OutNum) = Str(Adodc1.Recordset.Fields(1) + 1)
    Next itemp
    GetOutputKNo = Left(GetOutputKNo, Len(GetOutputKNo) - 1)

End If
End Function


Public Function SendoutAlarmChan(iNo As Integer) As String
Dim time1 As Integer
Dim time3 As Integer
Dim temp1, temp2, temp3, temp4 As String
Dim Currenttime As Integer
On Error Resume Next
If (GetOutputKTotal(iNo) = 0) Then
    SendoutAlarmChan = ""
    Exit Function
End If
        
If (GetOutputKTotal(iNo) > 0) And CBool(GetWholeDay(iNo)) Then
    SendoutAlarmChan = GetOutputKNo(iNo)
    Exit Function
End If

If (GetOutputKTotal(iNo) > 0) Then
    temp1 = Format(Val(Mid(GetAlarmTimeStart(iNo), 1, 2)), "00")
    temp2 = Format(Val(Mid(GetAlarmTimeStart(iNo), 4, 2)), "00")
    temp3 = Format(Val(Mid(GetAlarmTimeEnd(iNo), 1, 2)), "00")
    temp4 = Format(Val(Mid(GetAlarmTimeEnd(iNo), 4, 2)), "00")
        Currenttime = Format(Time, "hhmm")
        time1 = temp1 & temp2
        time3 = temp3 & temp4
  
    If time1 < time3 Then
        If Currenttime >= time1 And Currenttime <= time3 Then
         SendoutAlarmChan = GetOutputKNo(iNo)
       'MsgBox Str(temp1) & Str(temp2) & " " & Str(Currenttime) & " " & Str(temp3) & Str(temp4)
        End If
    End If
    
    If time1 > time3 Then
        If Currenttime >= time1 Or Currenttime <= time3 Then
        SendoutAlarmChan = GetOutputKNo(iNo)
        'MsgBox Str(temp1) & Str(temp2) & " " & Str(Currenttime) & " " & Str(temp3) & Str(temp4)

         End If
  
    End If
End If
        
End Function


Public Function SetAlarmInImageColor(sensorNo As Integer)
 Image1(sensorNo).Visible = False
 Image2(sensorNo).Visible = True
 
End Function
Public Function SetAlarmOutImageColor(sensorNo As Integer)
 Image4(sensorNo).Visible = False
 Image3(sensorNo).Visible = True
 '输出报警通道
    'Form2.Show 1
    '输出  "A" + 地址 + 70H + 0 + 49H + (效验) + FFH + FFH
    '判断结束，得到输出通道号
    '‘’‘’‘’‘’‘’‘’‘’发送输出通道
    Dim Sensornox As String
    Sensornox = "&H" & sensorNo
         mn$ = "A" + (Chr(Sensornox)) + Trim$(Chr(&H70)) + Trim$(Chr(&H0)) + Trim$(Chr(&H49)) + Trim$(Chr(&H41)) + Trim$(Chr(&HFF)) + Trim$(Chr(&HFF))
         MSComm1.Output = mn$
   
End Function

Private Sub Image2_Click(Index As Integer)
    Image1(Index).Visible = True
    Image2(Index).Visible = False
End Sub

Private Sub Image3_Click(Index As Integer)
    Image4(Index).Visible = True
    Image3(Index).Visible = False
End Sub

Private Sub MSComm1_OnComm()
   '接受报警
   '得到报警输入通道号
   '格式 7EH + 地址 +10H + 数据 +(效验) + FFH
Dim m As String
Dim k0() As Byte
Dim k, total As Byte
Select Case MSComm1.CommEvent
    Case comEventRxOver
      MSComm1.InBufferCount = 0
    Case comEventTxFull
      sendok = 0
    Case comEvReceive
     If MSComm1.InBufferCount > 0 Then
     Do
      MSComm1.InputLen = 1
      m = MSComm1.Input
      k0() = m
      addr = k0(0)
   '   Text1.Text = Text1.Text + " " + Hex(addr)
                Select Case addrc
                          Case 0
                              If addr = &H7E Then
                                  addrc = 1
                              End If
                         Case 1
                              addr1 = addr
                              addrc = addrc + 1
                         Case 2
                              addr2 = addr
                              addrc = addrc + 1
                         Case 3
                              addr3 = addr
                              addrc = addrc + 1
                         Case 4
                              addr4 = addr
                              addrc = 0
                              total = (addr1 + addr2 + addr3) And &HFF
                                      If total = addr4 Then
                                              If addr1 = &H20 Then  'addr1：地址
                                                    Select Case addr2
                                                        Case &H10
                                                           '‘’‘’‘’‘’‘’Addr3为通道号
                                                           'If addr1 > &H19 And addr1 < &H28 Then '地址,现在不知道。2位
                                                           '  mn$ = "A" + (Chr(addr1)) + Trim$(Chr(&H0)) + Trim$(Chr(&H10)) + Trim$(Chr(&H58)) + Trim$(Chr(&H68)) + Trim$(Chr(&HFF)) + Trim$(Chr(&HFF))
                                                           '  MSComm1.Output = mn$
                                                           '  Text1.Text = Text1.Text + " " + Hex(addr1) + "+" + Hex(addr3)
                                                           '  End If
                                                    End Select
                                               End If
                                              
                                              If addr1 = &H21 Then  'addr1：地址
                                                    Select Case addr2
                                                        Case &H10
                                                          '‘’‘’‘’‘’‘’‘’Addr3为通道号
                                                         '  If addr1 > &H19 And addr1 < &H28 Then '地址,现在不知道。2位
                                                         '    mn$ = "A" + (Chr(addr1)) + Trim$(Chr(&H0)) + Trim$(Chr(&H10)) + Trim$(Chr(&H58)) + Trim$(Chr(&H68)) + Trim$(Chr(&HFF)) + Trim$(Chr(&HFF))
                                                         '    MSComm1.Output = mn$
                                                         '  Text1.Text = Text1.Text + " " + Hex(addr1) + "+" + Hex(addr3)
                                                         '  End If
                                                    End Select
                                               End If
                                      End If
                         Case Else
                              addrc = 0
                End Select
     Loop Until MSComm1.InBufferCount = 0
     
    End If
    Case comEvSend
     sendok = 1
 End Select
End Sub