form1.frm

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

      Top             =   990
      Width           =   1065
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   315
      Index           =   3
      Left            =   930
      TabIndex        =   2
      Top             =   1830
      Width           =   945
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   315
      Index           =   2
      Left            =   930
      TabIndex        =   1
      Top             =   1440
      Width           =   945
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   315
      Index           =   1
      Left            =   960
      TabIndex        =   0
      Top             =   1050
      Width           =   945
   End
   Begin VB.Label Label7 
      Caption         =   "输出开关"
      Height          =   225
      Left            =   7830
      TabIndex        =   118
      Top             =   630
      Width           =   1245
   End
   Begin VB.Label Label6 
      Caption         =   "录象通道"
      Height          =   285
      Left            =   6420
      TabIndex        =   117
      Top             =   600
      Width           =   1245
   End
   Begin VB.Label Label5 
      Caption         =   "结束时间"
      Height          =   285
      Left            =   4830
      TabIndex        =   116
      Top             =   660
      Width           =   1245
   End
   Begin VB.Label Label4 
      Caption         =   "开始时间"
      Height          =   255
      Left            =   3450
      TabIndex        =   115
      Top             =   690
      Width           =   1125
   End
   Begin VB.Label Label3 
      Caption         =   "全天"
      Height          =   225
      Left            =   2280
      TabIndex        =   114
      Top             =   690
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "常开"
      Height          =   285
      Left            =   1170
      TabIndex        =   113
      Top             =   690
      Width           =   555
   End
   Begin VB.Label Label1 
      Caption         =   "14"
      Height          =   285
      Index           =   15
      Left            =   450
      TabIndex        =   38
      Top             =   6180
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "15"
      Height          =   285
      Index           =   14
      Left            =   450
      TabIndex        =   37
      Top             =   6570
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "16"
      Height          =   285
      Index           =   13
      Left            =   450
      TabIndex        =   36
      Top             =   6930
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "11"
      Height          =   285
      Index           =   12
      Left            =   450
      TabIndex        =   35
      Top             =   5010
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "12"
      Height          =   285
      Index           =   11
      Left            =   450
      TabIndex        =   34
      Top             =   5400
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "13"
      Height          =   285
      Index           =   10
      Left            =   420
      TabIndex        =   33
      Top             =   5760
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "10"
      Height          =   285
      Index           =   9
      Left            =   450
      TabIndex        =   32
      Top             =   4560
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "7"
      Height          =   285
      Index           =   8
      Left            =   450
      TabIndex        =   31
      Top             =   3420
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "8"
      Height          =   285
      Index           =   7
      Left            =   450
      TabIndex        =   30
      Top             =   3810
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "9"
      Height          =   285
      Index           =   6
      Left            =   450
      TabIndex        =   29
      Top             =   4170
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "4"
      Height          =   285
      Index           =   5
      Left            =   450
      TabIndex        =   28
      Top             =   2250
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "5"
      Height          =   285
      Index           =   4
      Left            =   450
      TabIndex        =   27
      Top             =   2640
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "6"
      Height          =   285
      Index           =   3
      Left            =   420
      TabIndex        =   26
      Top             =   3000
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "3"
      Height          =   285
      Index           =   2
      Left            =   480
      TabIndex        =   15
      Top             =   1830
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "2"
      Height          =   285
      Index           =   1
      Left            =   510
      TabIndex        =   14
      Top             =   1470
      Width           =   315
   End
   Begin VB.Label Label1 
      Caption         =   "1"
      Height          =   285
      Index           =   0
      Left            =   510
      TabIndex        =   13
      Top             =   1080
      Width           =   315
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public pp, sqlstr As String

Dim iEverySensorChan(17) As Integer '单个探头对应的录象通道号，数组下标是探头号
Dim iEverySensorChanNum As Integer  '单个探头对应的录象通道总数
Dim iEverySensorOutputK(17) As Integer '单个探头对应的报警输出开关号，数组下标是探头号
Dim iEverySensorOutputKNum As Integer   '单个探头对应的报警输出开关总数
Dim jtemp As Integer
Dim strKey As String
'根据探头号取得其对应的“常开”的状态
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 Command1_Click()

'For jtemp = 1 To 16
'Check1(jtemp) = GetAwaysOn(jtemp)            '常开
'Check2(jtemp) = GetWholeDay(jtemp)           '全天
'Text1(jtemp).Text = GetAlarmTimeStart(jtemp) '开始时间
'Text2(jtemp).Text = GetAlarmTimeEnd(jtemp)   '结束时间
'Text3(jtemp) = GetRecChan(jtemp)             '录象通道
'Text4(jtemp) = GetOutputKNo(jtemp)           '报警输出
'Next jtemp

MsgBox SendoutAlarmChan(6)

'MsgBox Str(iEverySensorChan(1)) & "__" & Str(iEverySensorChan(2))
End Sub

Private Sub Form_Load()
pp = App.Path + "\config.mdb"
Adodc1.RecordSource = "newcf"
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Password='';Persist Security Info=True;Data Source=" & pp
'Adodc1.Refresh

sqlstr = "select * from newcf"
Adodc1.RecordSource = sqlstr
Adodc1.Refresh
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

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) & ","
    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
'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)           '报警输出

If (GetOutputKTotal(iNo) = 0) Then
    SendoutAlarmChan = ""
    MsgBox "1"
    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