Skype4COMでメッセージを編集したイベントを拾うには...

skype4com_sample1.vb

Option Strict On

'今回は単に編集した情報を拾うだけなので、非常に原始的な方法でやってます...！
'(記事: http://www.bonprosoft.com/modules/blog/?p=282 )

Public Class Form1
    Public WithEvents oSkype As SKYPE4COMLib.Skype

    Public NowReplyStatus As ReplyStatus
    Public TimeStanp As Integer
    Public UserId As String

    Public ChatHashTable As Hashtable

    WithEvents Log_tbx As TextBox

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        oSkype = New SKYPE4COMLib.Skype

        If Not oSkype.Client.IsRunning Then
            ' 起動していない時の場合、Skypeを起動
            oSkype.Client.Start()
        End If
        'SkypeAPIに接続
        oSkype.Attach(7, False)

        Log_tbx = New TextBox With {.Name = "Log_tbx", .Dock = DockStyle.Fill, .ScrollBars = ScrollBars.Both, .Multiline = True, .HideSelection = False}
        Me.Controls.Add(Log_tbx)

        NowReplyStatus = ReplyStatus.NONE
       
        'テスト用に最前面
        Me.TopMost = True

        ChatHashTable = New Hashtable

    End Sub

    Private Sub oSkype_MessageStatus(ByVal pMessage As SKYPE4COMLib.ChatMessage, ByVal Status As SKYPE4COMLib.TChatMessageStatus) Handles oSkype.MessageStatus
        'それぞれ一括管理できるように飛ばしてあげよう！
        Select Case Status
            Case SKYPE4COMLib.TChatMessageStatus.cmsReceived
                Dim item As New SkypeMessage(pMessage.Sender.Handle, pMessage.Timestamp.TimeOfDay.TotalMinutes, pMessage.Body, MessageStatus.RECEIVED)
                SkypeMessageReceived(item)
                Dim editem As New EditStatus(pMessage.Id.ToString)
                editem.RecentMessage = pMessage.Body
                ChatHashTable.Add(pMessage.Id, editem)
            Case SKYPE4COMLib.TChatMessageStatus.cmsRead
                Dim item As New SkypeMessage(pMessage.Sender.Handle, pMessage.Timestamp.TimeOfDay.TotalMinutes, pMessage.Body, MessageStatus.READ)
                SkypeMessageReceived(item)
            Case SKYPE4COMLib.TChatMessageStatus.cmsSent
                Dim item As New SkypeMessage(pMessage.Sender.Handle, pMessage.Timestamp.TimeOfDay.TotalMinutes, pMessage.Body, MessageStatus.SENT)
                SkypeMessageReceived(item)
            Case SKYPE4COMLib.TChatMessageStatus.cmsSending
                Dim item As New SkypeMessage(pMessage.Sender.Handle, pMessage.Timestamp.TimeOfDay.TotalMinutes, pMessage.Body, MessageStatus.SENDING)
                SkypeMessageReceived(item)
                Dim editem As New EditStatus(pMessage.Id.ToString)
                editem.RecentMessage = pMessage.Body
                ChatHashTable.Add(pMessage.Id, editem)
            Case SKYPE4COMLib.TChatMessageStatus.cmsUnknown
                Dim item As New SkypeMessage(pMessage.Sender.Handle, pMessage.Timestamp.TimeOfDay.TotalMinutes, pMessage.Body, MessageStatus.UNKNOWN)
                SkypeMessageReceived(item)
        End Select

    End Sub


    Private Sub oSkype_Reply(ByVal pCommand As SKYPE4COMLib.Command) Handles oSkype.Reply
        Console.WriteLine(pCommand.Reply)

        Dim s() As String = SplitReplyCommand(pCommand.Reply)

        's(0)には処理分類
        's(1)には発言ごとのID
        's(2)には処理
        's(3)には内容

        Select Case NowReplyStatus
            Case ReplyStatus.NONE
                If s(2).Contains("EDITED_TIMESTAMP") = True Then
                    NowReplyStatus = ReplyStatus.EDITED_TIMESTANP
                    TimeStanp = CInt(s(3))
                End If
            Case ReplyStatus.EDITED_TIMESTANP, ReplyStatus.EDITED_BY
                If s(2).Contains("EDITED_BY") = True Then
                    NowReplyStatus = ReplyStatus.EDITED_BY
                    'ここで2度目の編集の時にもユーザーIDを取得できるように、ユーザーIDを登録
                    Dim ID As Integer = CInt(s(1))
                    If ChatHashTable.Contains(ID) = True Then
                        'すでに編集されている
                        '->もしかしたら他の人によって編集されたのかもしれない
                        Dim item As EditStatus = CType(ChatHashTable(ID), EditStatus)
                        item.ID = s(3)
                    Else
                        '新規登録
                        ChatHashTable.Add(ID, New EditStatus(s(3)))
                    End If
                    '処理を抜ける
                    Exit Sub
                End If

                If s(2).Contains("BODY") = True Then
                    NowReplyStatus = ReplyStatus.NONE
                    '新規作成
                    If ChatHashTable.Contains(CInt(s(1))) = False Then
                        'エラー発生！(なお、このアプリケーション起動時より前に送信したメッセージを編集した場合はここで弾かれます。
                        '適宜修正してください。)
                        MsgBox("不明なエラーが発生しました。", MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation, "エラー" + Application.ProductName)
                        End
                    End If
                    Dim editem As EditStatus = DirectCast(ChatHashTable(CInt(s(1))), EditStatus)
                    editem.Use()
                    Dim item As New SkypeMessage(editem.ID, TimeStanp, s(3), MessageStatus.EDITED)
                    SkypeMessageReceived(item, editem.Count, editem.RecentMessage)
                    editem.RecentMessage = s(3)
                End If
        End Select

    End Sub

    Private Function SplitReplyCommand(ByVal Str As String) As String()
        Dim s() As String = Split(Str, " ", 4)
        Return s
    End Function

    Private Overloads Sub SkypeMessageReceived(ByVal Item As SkypeMessage, ByVal EditTimes As Integer, ByVal OldMessage As String)
        '試しに出力
        WriteLog("===New Item Entry===" + vbCrLf + "UserID:" + Item.UserID + vbCrLf + "Time:" + Item.TimeStanp.ToString _
                          + vbCrLf + "Message:" + Item.Message + vbCrLf + "EditTimes:" + EditTimes.ToString + vbCrLf + "OldMessage:" + OldMessage + vbCrLf + "Status:" + Item.MessageStatus.ToString + vbCrLf + "===End Of Item Entry===")

    End Sub

    Private Overloads Sub SkypeMessageReceived(ByVal Item As SkypeMessage)
        '試しに出力
        WriteLog("===New Item Entry===" + vbCrLf + "UserID:" + Item.UserID + vbCrLf + "Time:" + Item.TimeStanp.ToString _
                          + vbCrLf + "Message:" + Item.Message + vbCrLf + "Status:" + Item.MessageStatus.ToString + vbCrLf + "===End Of Item Entry===")

    End Sub

    Private Sub WriteLog(ByVal Str As String)
        Log_tbx.AppendText(Str + vbCrLf)
    End Sub

End Class

Public Structure SkypeMessage
    Public Property UserID As String
    Public Property TimeStanp As Double
    Public Property Message As String
    Public Property MessageStatus As MessageStatus

    Public Sub New(ByVal UserID As String, ByVal TimeStanp As Double, ByVal Message As String, ByVal Status As MessageStatus)
        Me.UserID = UserID
        Me.TimeStanp = TimeStanp
        Me.Message = Message
        Me.MessageStatus = Status
    End Sub

End Structure

Public Enum MessageStatus
    RECEIVED
    READ
    SENT
    SENDING
    EDITED
    UNKNOWN
End Enum

Public Enum ReplyStatus
    EDITED_TIMESTANP
    EDITED_BY
    NONE
End Enum

Public Class EditStatus
    Public Property ID As String
    Private _Count As Integer
    Public Property RecentMessage As String = ""

    Public Sub Use()
        _Count += 1
    End Sub

    Public ReadOnly Property Count As Integer
        Get
            Return _Count
        End Get
    End Property

    Public Sub New(ByVal ID As String)
        _Count = 0
        Me.ID = ID
    End Sub

End Class