Call initcom
    
'    初始化并口
'
'    If InitializeWinIo = False Then
'                MsgBox "Whoops ! There is a problem with InitializeWinIo.", vbOKOnly + vbCritical, frmMain.Caption
'                mAction = False
'    End If
'
   Call getLpt   '從數據庫中得到可以使用的并口編號，并賦予數組lptPort
End Sub
Private Sub getLpt()
Dim r As ADODB.Recordset
Dim s As String

Set r = New ADODB.Recordset
    
    s = "select distinct number from bufangset where porperty='并口' and promote=true"
    r.Open s, cn, adOpenStatic, adLockOptimistic
  '若在布防設置表中select出的并口項數量為零則判斷系統不使用并口，反之使用。
    If r.RecordCount = 0 Then
                   lptInbf = False
    Else
                    lptInbf = True
    '若有并口則開一個并口端口數組
    '并給數組賦值
    ReDim lptPort(1 To r.RecordCount)
    
Dim i As Integer
        i = 0
       While Not r.EOF
              i = i + 1
              lptPort(i) = r!Number
              r.MoveNext
        Wend
     End If
End Sub

'初始化COM口
Private Sub initcom()
'初始化處警撥號使用的com口(控件：mscomm1)
Dim r As ADODB.Recordset
Dim str As String
        Set r = New ADODB.Recordset
        str = "select distinct number from chujingset where porperty='串口'"
        r.Open str, cn, adOpenStatic, adLockOptimistic
Dim commPort As Integer
        commPort = r!Number              '處警表里面使用的com口端口號
        r.Close
Dim commSettings As String
Dim commHandShaking As String

On Error Resume Next
                    
       commSettings = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Settings", "")
       commHandShaking = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Handshaking", "")
       
    Do While commSettings = "" Or commHandShaking = ""
        frmCommProperties.Label2.Caption = commPort
        Load frmCommProperties
        Set frmCommProperties.frmComm = Me
        Call frmCommProperties.LoadPropertySettings
        
        frmCommProperties.Show vbModal
        commSettings = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Settings", "")
        commHandShaking = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Handshaking", "")
    Loop
    
        MSComm1.commPort = commPort
        MSComm1.Settings = commSettings
        MSComm1.handshaking = commHandShaking
        MSComm1.PortOpen = True
        
    Set r = New ADODB.Recordset
    str = "select distinct number from bufangset where porperty='串口'"
    r.Open str, cn, adOpenStatic, adLockOptimistic
'如果布防設置中使用到com口的話,則初始化該com口
'控件:mscomm2
    If r.RecordCount = 1 Then
            comInbf = True
            commPort = r!Number
            
            commSettings = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Settings", "")
            commHandShaking = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Handshaking", "")
       
       Do While commSettings = "" Or commHandShaking = ""
             frmCommProperties.Label2.Caption = commPort
             Load frmCommProperties
             Set frmCommProperties.frmComm = Me
             Call frmCommProperties.LoadPropertySettings
        
             frmCommProperties.Show vbModal
             commSettings = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Settings", "")
             commHandShaking = GetSetting("通訊端口設置", "Com" & CStr(commPort) & "性質", "Handshaking", "")
       Loop
    
          MSComm2.commPort = commPort
          MSComm2.Settings = commSettings
          MSComm2.handshaking = commHandShaking
          MSComm2.PortOpen = True
          MSComm2.InputMode = comInputModeBinary
    Else
          comInbf = False
    End If
    
        
End Sub

Private Sub MSComm2_OnComm()
    Select Case MSComm2.CommEvent
       
           Case comEvReceive
                    Dim buffer As Variant
                    buffer = MSComm2.Input
                    Call processLook(CByte(buffer), True)
                    MSComm2.InBufferCount = 0
            Case Else
           
    End Select
End Sub

Private Sub Timer1_Timer()
   If mAction = True Then
       Call spyOn              '對布防設置進行監控
       Call updateLog          '更新日志
   End If
End Sub
Private Sub updateLog()
'觸發器源+事件+處警動作
'子程序：日志更新
   '打開log記錄集
         Dim str As String
        str = "select * from Log where date >= #" & sysdate & "#;"
         Dim r As ADODB.Recordset
      Set r = New ADODB.Recordset
         r.Open str, cn, adOpenStatic, adLockOptimistic
              
      If r.RecordCount <> cntLog Then
          '如果日志數目有變化則更新lvwlog
            cntLog = r.RecordCount
            lvwLog.ListItems.Clear
            Call showLog(r)
      End If
      
   r.Close
   
End Sub
 '當日紀錄顯示日志表
Private Sub showLog(rs As ADODB.Recordset)
  If rs.EOF Or rs.BOF Then Exit Sub
  
     rs.MoveFirst
     
  While Not rs.EOF And Not rs.BOF
     Dim str1, str2, str3 As String
         str1 = rs!bfname
         str2 = rs!Date & Space(1) & rs!Time
         str3 = rs!cjname
     
'     If IsNull(str1) Then
'           MsgBox ("此紀錄無主鍵")
'           Exit Sub
'     End If
     
     Set mLogItem = lvwLog.ListItems.Add(Text:=str1)
         mLogItem.ListSubItems.Add Text:=str2
         mLogItem.ListSubItems.Add Text:=str3
         rs.MoveNext
  Wend
 End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.index
      Case 1
          Call mnuOperateAct_Click  '與啟動安防檢測子菜單相對應
          If mAction Then
             Call spyOn         '執行監控任務
             Call updateLog     '更新日志
          Else
             'undo
          End If
      Case 3
         Call mnuOperateSetting_Click
      Case 5
         Call mnuOperateMaglog_Click
      Case 7
         Call mnuExit_Click
    End Select
End Sub
'監控子程序:從各監控端口取數據
'判斷觸發事件是否發生，并給以
'處警
Private Sub spyOn()

On Error Resume Next
    
'如果布防設置里面使用了并口，則檢測該端口輸入
    If lptInbf Then

      Dim i As Integer
    
        For i = 1 To UBound(lptPort)
              
              Dim Result As Boolean
              Dim PhysVal As Long
               
               Result = GetPortVal(Val("&H" + lptPort(i)), PhysVal, 1)
               Result = True
              
              If (Result = False) Then
                     MsgBox "Whoops ! There is a proble m with GetPhysLong.", vbOKOnly + vbCritical, "VBDumpPhys32"
              Else
                     Call processLook(CByte(PhysVal), False)
                     'debug
'                    Dim num As String
'                    num = InputBox$("請輸入事件編碼:", "編碼", 0)
'                    Call processLook(CByte(num), False)
              End If
              
         Next i
    
     End If
    
End Sub
'提取端口內容,判斷觸發事件的發生,
'找出對應設置
'響應,并記錄入日志
Private Sub processLook(br As Byte, c As Boolean)
Dim s1 As String
          
          Select Case c
             
             Case True
                  s1 = "select * from bufangset where porperty='串口'"
             Case False
                  s1 = "select * from bufangset where porperty='并口'"
          End Select
          
Dim r, r1 As ADODB.Recordset
    
    Set r = New ADODB.Recordset
                   
               r.Open s1, cn, adOpenStatic, adLockOptimistic
               r.MoveFirst
             
             While Not r.EOF
                 '若有事件發生,則響應該觸發事件
                 If (br And r!bfcode = br) Then
                     
                     '找出對應處警設置
                     Set r1 = New ADODB.Recordset
                     s1 = "select cjname from  bftocj where bfname = '" & r!bfname & "';"
                     r1.Open s1, cn, adOpenStatic, adLockOptimistic
                     
                     Dim x, y As Integer
                     x = analystRs(r1!cjname)
                     
                     '記入日志
                     Dim r2 As ADODB.Recordset
                     Set r2 = New ADODB.Recordset
                     Dim s2 As String
                     s2 = "select * from log"
                     r2.Open s2, cn, adOpenDynamic, adLockOptimistic
                   r2.AddNew
                      r2!bfname = r!bfname
                      r2!Date = FormatDateTime(Now, vbLongDate)
                      r2!Time = FormatDateTime(Now, vbLongTime)
                      r2!cjname = r1!cjname
                   r2.Update
                     r2.Close
                     
                     r1.Close
                                         
                     
                     '予以處警響應
                     For y = 0 To x - 1
                     
                         Set r1 = New ADODB.Recordset
                         s1 = "select * from chujingset where cjname = '" & strcj(y) & "';"
                         r1.Open s1, cn, adOpenStatic, adLockOptimistic
                        
                        While Not r1.EOF
                           
                           Select Case r1!porperty
                              
                                Case "串口"
                                     If MSComm1.PortOpen = True Then
                                           MSComm1.Output = "ATDT" & r1!telnumber & vbCrLf
                                     End If
'                                       MsgBox ("撥號:" & r1!telnumber)
                                Case "并口"
                                       Dim Result As Boolean
                                       
                                       If r1!typeact = "撥號" Then
                                            Result = SetPortVal(Val("&H" + r1!Number), Val("&H" + r1!telnumber), 1)
'                                            MsgBox ("撥號:" & r1!telnumber)
                                       Else
                                            Result = SetPortVal(Val("&H" + r1!Number), Val("&H" + r1!infocode), 1)
'                                            MsgBox ("發碼:" & r1!infocode)
                                       End If
                                       
                                       If Result = False Then
                                              MsgBox "Whoops ! There is a problem with SetPhysLong.", vbOKOnly + vbCritical, "VBDumpPhys32"
                                       End If
                            End Select
                                          
                            r1.MoveNext
                        
                        Wend
                            r1.Close
                            
                     Next y
                                           
                 End If
                 
                  r.MoveNext
                  
             Wend
            r.Close
            
   Dim m As Integer
   For m = 0 To 99
     strcj(m) = ""
   Next m
End Sub
'cjname分析
Private Function analystRs(s As String) As Integer
   Dim i As Integer
   Dim count As Integer '紀錄獲取的字符串個數
   count = 0
   For i = 1 To Len(s)
      If Mid(s, i, 1) = "@" Then
                count = count + 1
      Else
                strcj(count) = strcj(count) & Mid(s, i, 1)
      End If
   Next i
   analystRs = count
End Function