#副標=使用dotMSN設計MSN自動應答系統
#大標=打造自己的MSN機器人



=-----box程式-----
‘------------------------------------------------------------------------------------
‘DotMSN 元件 
‘------------------------------------------------------------------------------------
    Private WithEvents MsnObj As Messenger
    Private MsnConv As Conversation
‘------------------------------------------------------------------------------------
‘資料庫 元件 
‘------------------------------------------------------------------------------------
    Private cn As OleDb.OleDbConnection
    Private Cmd As OleDb.OleDbCommand
    Private Da As OleDb.OleDbDataAdapter
    Private Ds As DataSet
    Private DrMsg As OleDb.OleDbDataReader
    Private Dt As DataTable

‘------------------------------------------------------------------------------------
‘SetDB 設定資料庫
‘------------------------------------------------------------------------------------
Private Sub SetDB(ByVal FileLocation As String)
Try
  cn = New OleDb.OleDbConnection
  cn.ConnectionString = "Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Registry Path=;" + _
  "Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Database Password=;Data Source='" + FileLocation + "';" + _
  "Password=;Jet OLEDB:Engine Type=5;Jet OLEDB:Global Bulk Transactions=1;Provider='Microsoft.Jet.OLEDB.4.0';" + _
  "Jet OLEDB:System database=;Jet OLEDB:SFP=False;Extended Properties=;Mode=Share Deny None;" + _
  "Jet OLEDB:New Database Password=;Jet OLEDB:Create System Database=False;" + _
  "Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;" + _
  "User ID=Admin;Jet OLEDB:Encrypt Database=False"
  cn.Open()
  Cmd = New OleDb.OleDbCommand("SELECT * From MsgExe", cn)
  Da = New OleDb.OleDbDataAdapter(Cmd)
  Ds = New DataSet
  DataGrid1.DataSource = Ds
  Da.Fill(Ds, "MsgTable")
Catch ex As Exception
  MsgBox(ex.Message)
End Try
End Sub

‘------------------------------------------------------------------------------------
‘查詢資料庫，由接收到的訊息(Msg)查詢要回的話
‘------------------------------------------------------------------------------------
    Private Function SelectAns(ByVal Msg As String) As String
        Try
            Cmd = New OleDb.OleDbCommand("SELECT a From MsgExe where q='" + Msg + "'", cn)
            DrMsg = Cmd.ExecuteReader
            If DrMsg.Read Then
                SelectAns = DrMsg("a")
            Else
                SelectAns = "我聽不懂你再說啥!!"
            End If
            DrMsg.Close()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Function

‘------------------------------------------------------------------------------------
‘UpState 將Data寫到紀錄用的文字盒(TxtLog)
‘------------------------------------------------------------------------------------
    Private Sub UpState(ByVal Data As String)
        TxtLog.Text = Data + vbCrLf + TxtLog.Text
    End Sub

‘------------------------------------------------------------------------------------
‘GetStatus 以狀態碼(ID)查詢狀態
‘------------------------------------------------------------------------------------
    Private Function GetStatus(ByVal ID As MSNStatus) As String
        Select Case ID
            Case MSNStatus.Offline
                GetStatus = "離線"
            Case MSNStatus.Hidden
                GetStatus = "隱藏"
            Case MSNStatus.Online
                GetStatus = "線上"
            Case MSNStatus.Away
                GetStatus = "離開"
            Case MSNStatus.Busy
                GetStatus = "忙碌"
            Case MSNStatus.BRB
                GetStatus = "馬上回來"
            Case MSNStatus.Lunch
                GetStatus = "外出用餐"
            Case MSNStatus.Phone
                GetStatus = "電話中"
            Case MSNStatus.Idle
                GetStatus = "閒置"
            Case Else
                GetStatus = "不明"
        End Select
    End Function

‘------------------------------------------------------------------------------------
‘GetStatusID 以狀態查(States)詢狀態碼
‘------------------------------------------------------------------------------------
    Private Function GetStatusID(ByVal States As String) As MSNStatus
        Select Case States
            Case "離線"
                GetStatusID = MSNStatus.Offline
            Case "隱藏"
                GetStatusID = MSNStatus.Hidden
            Case "線上"
                GetStatusID = MSNStatus.Online
            Case "離開"
                GetStatusID = MSNStatus.Away
            Case "忙碌"
                GetStatusID = MSNStatus.Busy
            Case "馬上回來"
                GetStatusID = MSNStatus.BRB
            Case "外出用餐"
                GetStatusID = MSNStatus.Lunch
            Case "電話中"
                GetStatusID = MSNStatus.Phone
            Case "閒置"
                GetStatusID = MSNStatus.Idle
        End Select
    End Function
‘------------------------------------------------------------------------------------
‘CheckUser 檢查指定的Mail(UserMail)是否在ListBox的List裡
‘------------------------------------------------------------------------------------
    Private Function CheckUser(ByVal UserMail As String) As Boolean
        Dim i As Integer
        UserMail = Trim(UserMail)
        For i = 1 To ListUser.Items.Count
            If ListUser.Items.Item(i - 1) = UserMail Then
                CheckUser = True
                Exit Function
            End If
        Next
        CheckUser = False
    End Function

‘------------------------------------------------------------------------------------
‘ExeMsg 處理傳回來的訊息(Msg)
‘------------------------------------------------------------------------------------
    Private Function ExeMsg(ByVal Msg As String) As String
        ExeMsg = SelectAns(Msg)
    End Function

‘------------------------------------------------------------------------------------
‘Form1_Load 初始設定
‘------------------------------------------------------------------------------------
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim i As Integer
        ComboState.Text = "離線"
        ComboState.Enabled = False
        For i = 2 To 9
            ComboState.Items.Add(GetStatus(i))
        Next i
        GroupBox1.Enabled = ChUserOnly.Checked
        SetDB("G:\MSN機器人\Magazin\exp\msg.mdb")
    End Sub

‘------------------------------------------------------------------------------------
‘BtLogin_Click 登入MSN
‘------------------------------------------------------------------------------------
Private Sub BtLogin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)Handles(BtLogin.Click)
        BtLogin.Enabled = False
    ‘檢查是否在連線狀態
        If BtLogin.Text = "登出" Then
        ‘如果在連線狀態則登出(斷線)
            UpState("登出中...")
            MsnObj.CloseConnection()
            Application.DoEvents()
            BtLogin.Text = "登入"
            ComboState.Text = GetStatus(MSNStatus.Offline)
            ComboState.Enabled = False
            BtLogin.Enabled = True
        Else
        ‘簡單的檢查帳號密碼是否合法
            If TxtAccound.Text = "" Or TxtAccound.Text = "@hotmail.com" Or TxtPasswd.Text = "" Then
                MsgBox("請輸入帳號密碼")
                BtLogin.Enabled = True
                Exit Sub
            End If

            UpState("登入中...")
            Application.DoEvents()
            MsnObj = New Messenger

        ‘開始登入流程
            Try
            ‘連線
                MsnObj.Connect(Trim(TxtAccound.Text), Trim(TxtPasswd.Text))
                UpState("上線中...")
                Application.DoEvents()
            ‘更新資料
                MsnObj.SynchronizeList()
            ‘更新狀態
                MsnObj.SetStatus(MSNStatus.Online)

                BtLogin.Text = "登出"
                ComboState.Text = GetStatus(MSNStatus.Online)
                ComboState.Enabled = True
                UpState(TxtAccound.Text + " Login")
            Catch ex As MSNException
            ‘登入失敗
                MsgBox("連線失敗!!" + vbCrLf + ex.Message)
                UpState("連線失敗!!")
                ComboState.Text = GetStatus(MSNStatus.Offline)
                ComboState.Enabled = False
                BtLogin.Text = "登入"
            Finally
                BtLogin.Enabled = True
            End Try
        End If
    End Sub

‘------------------------------------------------------------------------------------
‘ComboState_SelectedIndexChanged 當使用者變更狀態時
‘------------------------------------------------------------------------------------
    Private Sub ComboState_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboState.SelectedIndexChanged
        UpState("變更狀態: " + ComboState.Text)
    ‘變更狀態
        Try
            MsnObj.SetStatus(GetStatusID(ComboState.Text))
        Catch ex As MSNException
            MsgBox("變更狀態失敗!!" + vbCrLf + ex.Message)
            UpState("變更狀態失敗!!")
        End Try
    End Sub

‘------------------------------------------------------------------------------------
‘MsnObj_ConversationCreated 建立聊天室
‘------------------------------------------------------------------------------------
    Private Sub MsnObj_ConversationCreated(ByVal sender As DotMSN.Messenger, ByVal e As DotMSN.ConversationEventArgs) Handles MsnObj.ConversationCreated
        UpState("建立聊天室")
        MsnConv = e.Conversation
        AddHandler MsnConv.MessageReceived, AddressOf MessageReceived
        AddHandler MsnConv.ContactJoin, AddressOf ContactJoined
        AddHandler MsnConv.ContactLeave, AddressOf ContactLeave
    End Sub

‘------------------------------------------------------------------------------------
‘MessageReceived 接收到使用者傳來的訊息
‘------------------------------------------------------------------------------------
    Private Sub MessageReceived(ByVal sender As Conversation, ByVal e As MessageEventArgs)
        Dim Msg As String
        UpState("[" + e.Sender.Name + "]:" + e.Message.Text)
        If ChUserOnly.Checked Then
            If CheckUser(e.Sender.Mail) Then
                Msg = ExeMsg(e.Message.Text)
            Else
                Msg = "Sorry!! 我不能幫你服務喔"
            End If
        Else
            Msg = ExeMsg(e.Message.Text)
        End If
        sender.SendMessage(Msg)
    End Sub

‘------------------------------------------------------------------------------------
‘ContactLeave 有使用者離開交談時
‘------------------------------------------------------------------------------------
    Private Sub ContactLeave(ByVal sender As Conversation, ByVal e As ContactEventArgs)
        UpState(e.Contact.Name + "離開了!!")
    End Sub
‘------------------------------------------------------------------------------------
‘ContactJoined 有使用者加入交談時
‘------------------------------------------------------------------------------------
    Private Sub ContactJoined(ByVal sender As Conversation, ByVal e As ContactEventArgs)
        UpState(e.Contact.Name + "[" + e.Contact.Mail + "]加入交談!!")
    End Sub
‘------------------------------------------------------------------------------------
‘CntMessageReceived 接收到來自MSN的訊息
‘------------------------------------------------------------------------------------
    Private Sub CntMessageReceived(ByVal sender As Messenger, ByVal Message As String) Handles MsnObj.MessageReceived
    ‘    UpState("來自MSN訊息 >>" + Message)
    End Sub
‘------------------------------------------------------------------------------------
‘ReverseAdded 當被新增到聯絡人裡
‘------------------------------------------------------------------------------------
    Public Sub ReverseAdded(ByVal sender As Messenger, ByVal e As ContactEventArgs) Handles MsnObj.ReverseAdded
        If ChAutoAccept.Checked Then
            Try
                MsnObj.AddContact(e.Contact.Mail)
                UpState("加入聯絡人" + e.Contact.Name + "[" + e.Contact.Mail + "]")
            Catch ex As Exception
                MsgBox("錯誤：無法加入聯絡人" + e.Contact.Name + "[" + e.Contact.Mail + "]" + vbCrLf + ex.Message)
                UpState("錯誤：無法加入聯絡人" + e.Contact.Name + "[" + e.Contact.Mail + "]")
            End Try
        Else
            UpState(e.Contact.Mail + " 要求加入，但未被獲准")
        End If
    End Sub
'------------------------------------------------------------------------------------
'ChUserOnly_CheckedChanged 當"限定使用者"被勾選時，才可以編輯使用者名單
'------------------------------------------------------------------------------------
    Private Sub ChUserOnly_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChUserOnly.CheckedChanged
        GroupBox1.Enabled = ChUserOnly.Checked
    End Sub
'------------------------------------------------------------------------------------
'BtAddUser_Click 將TxtAddUser裡的帳號加入到使用者名單
'------------------------------------------------------------------------------------
    Private Sub BtAddUser_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtAddUser.Click
        ListUser.Items.Add(Trim(TxtAddUser.Text))
        TxtAddUser.Text = "@hotmail.com"
    End Sub
-----end-----