TC35SChangeStatus 7, Status
End Sub


Private Sub TC35S8_ChangeStatus(ByVal Status As EventStatus)
    TC35SChangeStatus 8, Status
End Sub

Private Sub bntOK_Click()
   Me.WindowState = 1
End Sub

Private Sub bntCancel_Click()
   Unload Me
End Sub

Private Sub bntDelete_Click()
  Dim s As String
  If Not ListView.SelectedItem Is Nothing Then
     If ShowYesNo("您真想刪除你所選擇中的記錄！") Then
        OpenCN
        cn.Execute "delete from School_Tc35 where TC35ID=" & Mid(ListView.SelectedItem.Key, 3)
        CloseCN
        ListView.ListItems.Remove ListView.SelectedItem.Key
     End If
  End If
End Sub

Private Sub bntEdit_Click()
  Dim s As String
  If Not ListView.SelectedItem Is Nothing Then
     ShowTC35 CLng(Mid(ListView.SelectedItem.Key, 3))
  End If
End Sub

Private Sub bntNew_Click()
    ShowTC35
End Sub

Private Sub bntSend_Click()
   OkTC35Number = InitComm()
   
    SetTC35(1).Para1 = 392
    SetTC35(1).Para2 = 62
    SetTC35(1).Para3 = "WebSM"
    SetTC35(1).Telphone = "13480724365"
    SetTC35(1).Msg = "test"
    GroupSendSM SetTC35, 1, bExit
   
   If OkTC35Number > 0 Then
      'bntSend.Enabled = False
      SetSendStatus False
'      Timer.Interval = 5000 'GroupSendSM SetTC35, OkTC35Number, bExit '開始群發
      GroupSendSM SetTC35, OkTC35Number, bExit '開始群發
      setStatus "系統啟動正常,等待調度...."
   End If
End Sub


'群發SM
Public Sub GroupSendSM(SetTC35() As TC35, ByVal nTC35 As Integer, bExit As Boolean)
   Dim i As Integer
   For i = 1 To nTC35
       DoEvents
       SetTC35(i).Send
       If bExit Then Exit For
   Next i
   
   If bExit Then
     For i = 1 To nTC35
            SetTC35(i).Break
     Next i
   End If
   
End Sub

Private Sub Init()
    
    Set TC35S1 = New TC35
    Set SetTC35(1) = TC35S1
    
    Set TC35S2 = New TC35
    Set SetTC35(2) = TC35S2
    
    Set TC35S3 = New TC35
    Set SetTC35(3) = TC35S3
    
    
    Set TC35S4 = New TC35
    Set SetTC35(4) = TC35S4
    
    
    Set TC35S5 = New TC35
    Set SetTC35(5) = TC35S5
    
    Set TC35S6 = New TC35
    Set SetTC35(6) = TC35S6
    
    Set TC35S7 = New TC35
    Set SetTC35(7) = TC35S7
    
    Set TC35S8 = New TC35
    Set SetTC35(8) = TC35S8
    
End Sub


Private Sub Form_Load()
   On Error GoTo laberr
   Dim s As String
   Dim n As Integer
   If Not isDebug Then
      AddToTray Me, menuTray
      SetTrayTip "校園安全管理短信發送服務程序 V1.0"
   End If
   
   Call Init
   
   bExit = True
   bInit = False
   If GetStr() = False Then '取得當前數據庫連接的字符串信息
        setStatus "無法取得數據庫連接信息,請運行連接設置程序，然后再執行本程序"
   Else
        n = LoadTC35()
        If n = 0 Then
            setStatus "系統當前沒加入TC35短信發送終端設備信息"
        ElseIf n > 0 Then
            setStatus "系統初始化成功,請按下“發送”啟動服務"
            bInit = True
        End If
   End If
   SetSendStatus bInit
   Exit Sub
laberr:
   ShowMsg "系統初始化出錯，錯誤信息為 = " & Err.Description
   bInit = False
   SetSendStatus bInit
   bntSTOP.Enabled = False
End Sub


Private Sub Form_Resize()
   If Me.WindowState = 1 Then
        If Not isDebug Then menuTray_Hide_Click
        Exit Sub
    End If
    LastStatus = Me.WindowState
End Sub

Private Sub menuSYS_Set_Click()
   frmSet.Show 1
End Sub



Private Sub ListView_DblClick()
    bntEdit_Click
End Sub

Private Sub menuTC35_Add_Click()
    bntNew_Click
End Sub

Private Sub menuTC35_Delete_Click()
    bntDelete_Click
End Sub

Private Sub menuTC35_Edit_Click()
    If bntEdit.Enabled Then
        bntEdit_Click
    End If
End Sub

Private Sub menuTray_Hide_Click()
   Me.Visible = False
   menuTray_Hide.Enabled = False
   menuTray_Open.Enabled = True
   Me.WindowState = LastStatus
End Sub


'初始化各端口
Private Function InitComm() As Integer
   Dim li As ListItem
   Dim n As Integer
   Dim i As Integer
   Dim s As String
   With ListView.ListItems
      For i = 1 To .Count
          Set li = .Item(i)
          li.Bold = False
          li.SubItems(2) = "正初始化..."
          If SetTC35(i).Init(MSComm(i), li.Text, li.SubItems(1)) = True Then
              SetTC35(i).Key = li.Key
              li.SubItems(2) = "初始化成功"
              'li.SubItems(3) = SetTC35(i).ErrMsg
              li.Bold = True
              n = n + 1
          Else
              li.SubItems(2) = "初始化失敗"
              'li.SubItems(3) = SetTC35(i).ErrMsg
          End If
      Next i
   End With
   If n = 0 Then
        s = "無法從當前的設備當中啟動一個用于發送短信"
        setStatus s
        ShowMsg s
   End If
   InitComm = n
   Exit Function
laberr:
    s = "初始化各通訊端口時出錯,錯誤信息為:" & Err.Description
    setStatus s
    ShowMsg s
    InitComm = -1
End Function

'關閉端口
Private Sub CloseComm()
   Dim li As ListItem
   Dim i As Integer
   With ListView.ListItems
      For i = 1 To .Count
          Set SetTC35(i) = Nothing
      Next i
   End With
End Sub


Private Sub menuTray_Open_Click()
   Me.Visible = True
   menuTray_Hide.Enabled = True
   menuTray_Open.Enabled = False
End Sub


Private Function StrLen(ByVal s As String) As Integer
   Dim i As Integer
   Dim n As Integer
   n = 0
   For i = 1 To Len(s)
      If Asc(Mid(s, i, 1)) < 0 Then
         n = n + 2
      Else
         n = n + 1
      End If
   Next i
   StrLen = n
End Function

Private Sub Form_Unload(Cancel As Integer)
   bExit = ShowYesNo("系統正在發送SM，如果你退出，則內部待處理的SM無法發送學生家長手中，你確認?")
   Cancel = Not bExit
   If Not Cancel Then
      If Not isDebug Then RemoveFromTray
   End If
End Sub


Private Sub menuExit_Click()
    bntCancel_Click
End Sub



Private Sub Timer_Timer()
  'On Error GoTo laberr
  Dim UserID As String
  Dim Mobile As String
  Dim Msg As String
  
  Dim AttendItemID As Long
  Dim ToUserName As String
  Dim ErrMsg As String
  Dim n As Long
  Dim SMID As Long
  Dim SMItemID As Long
  Dim nWebSm As Long
  Dim tn As Integer
  
  If bInit = False Then Timer.Interval = 0: Exit Sub
     
  OpenCN
  Set rs = cn.Execute("select isnull(count(*),0) from VIEW_WaitingSendSM")
  n = rs(0)
  CloseRS rs
  Set rs = cn.Execute("select isnull(count(*),0) from VIEW_SM")
  nWebSm = rs(0)
  CloseRS rs
  setWebSM nWebSm
  setSysSM n
  CloseCN
     
  If n + nWebSm = 0 Then
  
     setStatus "系統暫無待發送的短信內容"
     Exit Sub
  End If
  
 
  
  bExit = False
  If n > 0 And chkSendAttend.Value = 1 Then
        
        setStatus "正在讀取需要發送的考勤短信...."
        OpenCN
        Set rs = cn.Execute("select Top " & OkTC35Number & " * from VIEW_WaitingSendSM order by dtCreate desc")
        tn = 0
        Do While Not bExit And Not rs.EOF
               tn = tn + 1
               SetTC35(tn).Para1 = rs("AttendItemID")
               SetTC35(tn).Para2 = rs("PaterName")
               SetTC35(tn).Para3 = "SysSM"
               SetTC35(tn).Telphone = rs("Mobile")
               SetTC35(tn).Msg = rs("Msg")
               DoEvents
               rs.MoveNext
               If bExit Then Exit Do
        Loop
        CloseRS rs
        CloseCN
        
        If Not bExit And tn > 0 Then
           setStatus "正在發送考勤短信...."
           GroupSendSM SetTC35, tn, bExit
        End If
        
  
  End If
  
  If nWebSm > 0 And chkSendWebSM.Value = 1 And bExit = False Then
        OpenCN
        Set rs = cn.Execute("select Top " & OkTC35Number & " * from VIEW_SM")
        setStatus "正在讀取需要發送的WEB短信..."
        tn = 0
        Do While Not rs.EOF And Not bExit
               tn = tn + 1
               SetTC35(tn).Para1 = rs("SMItemID")   '392
               SetTC35(tn).Para2 = rs("SMID")   '62
               SetTC35(tn).Para3 = "WebSM"
               SetTC35(tn).Telphone = rs("ToMobile")  '13148839934
               SetTC35(tn).Msg = rs("Msg") 'test
               DoEvents
               rs.MoveNext
               If bExit Then Exit Do
        Loop
        CloseRS rs
        CloseCN
        
        If Not bExit And tn > 0 Then
            setStatus "正在發送WEB短信..."
            GroupSendSM SetTC35, tn, bExit
        End If
        
  End If
  
  '當前被中斷
  If bExit = True Then Call SetSendStatus(True)
  Exit Sub

laberr:
  setStatus "出錯:" & Err.Description
  bInit = False
  CloseCN

End Sub


Private Sub setStatus(ByVal s As String)
   StatusBar.Panels(3).Text = "狀態：" & s
End Sub

Private Sub setWebSM(ByVal s As String)
   StatusBar.Panels(1).Text = "網絡短信：" & s
End Sub


Private Sub setSysSM(ByVal s As String)
   StatusBar.Panels(2).Text = "考勤短信：" & s
End Sub

'從系統數據中裝入TC35設備信息
Private Function LoadTC35() As Integer
   Dim rs As ADODB.Recordset
   Dim li As ListItem
   Dim n As Integer
   n = 0
   OpenCN
   Set rs = cn.Execute("select top 8 * from view_TC35")
   With ListView
       .ListItems.Clear
       While Not rs.EOF
             Set li = .ListItems.Add(, "T_" & rs("tc35id"), rs("Port"))
             li.SubItems(1) = rs("ServiceTelphone")
             li.SubItems(3) = rs("SpKind")
             li.SubItems(4) = rs("Prex")
             rs.MoveNext
             n = n + 1
       Wend
   End With
   CloseRS rs
   CloseCN
   LoadTC35 = n
   Exit Function
laberr:
   If Not rs Is Nothing Then CloseRS rs
   CloseCN
   LoadTC35 = -1
   setStatus "裝入TC設備信息出錯," & Err.Description
End Function

Private Sub SetSendStatus(ByVal b As Boolean)
   
   bntSend.Enabled = b
   bntSTOP.Enabled = Not b
   bntNew.Enabled = b
   bntEdit.Enabled = b
   bntDelete.Enabled = b
   
   menuTC35_Add.Enabled = b
   menuTC35_Edit.Enabled = b
   menuTC35_Delete.Enabled = b
End Sub