前にも作ったことあるけど、また作る必要が出てきたので覚書。
開発環境はVisualStudio Community 2003
VisualBasic Windowsフォームアプリケーションでプロジェクトを作成
こんな感じでコントロールを配置する。
ContextMenuStripはこんな感じ。
で、コードは次の通り。
Public Class Form1これでタスクトレイに常駐し、XmlSocketでコメント情報を受け取るプログラムができました。
'コントロールを扱うためのデリゲート宣言
Delegate Sub SetLabelNoDelegate(ByVal Value As String)
Delegate Sub SetLabelTimeDelegate(ByVal Value As String)
Delegate Sub SetLabelHandleDelegate(ByVal Value As String)
Delegate Sub SetLabelCommentDelegate(ByVal Value As String)
'デリゲート宣言をデータ型とした変数を作成
Private LabelNoDelegate As _
New SetLabelNoDelegate(AddressOf SetLabelNo)
Private LabelTimeDelegate As _
New SetLabelTimeDelegate(AddressOf SetLabelTime)
Private LabelHandleDelegate As _
New SetLabelHandleDelegate(AddressOf SetLabelHandle)
Private LabelCommentDelegate As _
New SetLabelCommentDelegate(AddressOf SetLabelComment)
Dim enc As System.Text.Encoding = System.Text.Encoding.UTF8
Dim xmlDocument As System.Xml.XmlDocument = New System.Xml.XmlDocument 'XMLドキュメント作成
Dim xmlLog As System.Xml.XmlElement = xmlDocument.CreateElement("log") 'ルート部作成
'ローカルIPアドレスでListen
Dim host As String = "localhost"
Dim port As Integer = 20890
Dim iphe As System.Net.IPHostEntry = System.Net.Dns.GetHostEntry(host)
Dim ipAdd As System.Net.IPAddress() = iphe.AddressList
Dim listener As New System.Net.Sockets.TcpListener(ipAdd(0), port)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
'XML
xmlDocument.AppendChild(xmlLog) 'ドキュメントにルートを追加
'Listenを開始する
Dim ls As New System.Threading.Thread(AddressOf listenerstart)
ls.Start()
End Sub
'フォームのFormClosingイベントハンドラ
Private Sub Form1_FormClosing(ByVal sender As Object, _
ByVal e As FormClosingEventArgs) Handles MyBase.FormClosing
If e.CloseReason = CloseReason.UserClosing Then
Me.ステータスを表示ToolStripMenuItem.Text = "ステータスを表示"
Me.Opacity = 0
e.Cancel = True
End If
End Sub
Private Sub listenerstart()
listener.Start()
Try
Do
Dim tcp As System.Net.Sockets.TcpClient = _
listener.AcceptTcpClient()
'NetworkStreamを取得
Dim ns As System.Net.Sockets.NetworkStream = tcp.GetStream()
'クライアントから送られたデータを受信する
Dim ms As New System.IO.MemoryStream
Dim resBytes(256) As Byte
Dim resSize As Integer
Do
'データの一部を受信する
resSize = ns.Read(resBytes, 0, resBytes.Length)
'Readが0を返した時はクライアントが切断したと判断
If resSize = 0 Then
Console.ReadLine()
Return
End If
'受信したデータを蓄積する
ms.Write(resBytes, 0, resSize)
Loop While ns.DataAvailable
'受信したデータを文字列に変換
Dim resMsg As String = enc.GetString(ms.ToArray())
ms.Close()
Dim xmldoc As New System.Xml.XmlDocument
xmldoc.LoadXml(resMsg)
XmlChatRead(xmldoc)
Loop
Catch ex As Exception
Debug.Print(ex.Message)
End Try
End Sub
'ラベルの値設定(Delegateするメソッド)
Private Sub SetLabelNo(ByVal Value As String)
Label_No.Text = Value
End Sub
Private Sub SetLabelTime(ByVal Value As String)
Label_Time.Text = Value
End Sub
Private Sub SetLabelHandle(ByVal Value As String)
Label_Handle.Text = Value
End Sub
Private Sub SetLabelComment(ByVal Value As String)
Label_Comment.Text = Value
End Sub
Private Sub XmlChatRead(xmldoc As System.Xml.XmlDocument)
Dim node As System.Xml.XmlNode
node = xmldoc.DocumentElement
'記録するためのXML
Dim no As String = ""
Dim time As String = ""
Dim handle As String = ""
Dim comment As String = ""
If node.HasChildNodes Then
'コメント内容
Me.Invoke(LabelCommentDelegate, New Object() {node.FirstChild.Value})
comment = node.FirstChild.Value
Dim root As System.Xml.XmlElement = xmldoc.DocumentElement
If (root.HasAttribute("no")) Then
Me.Invoke(LabelNoDelegate, New Object() {root.GetAttribute("no")})
no = root.GetAttribute("no")
End If
If (root.HasAttribute("date")) Then
Me.Invoke(LabelTimeDelegate, New Object() {root.GetAttribute("date")})
time = root.GetAttribute("date").ToString
End If
If (root.HasAttribute("kotehan")) Then
Me.Invoke(LabelHandleDelegate, New Object() {root.GetAttribute("kotehan")})
handle = root.GetAttribute("kotehan")
Else
Me.Invoke(LabelHandleDelegate, New Object() {""})
End If
End If
End Sub
Private Sub ContextMenuStrip_Nway_Click(sender As Object, e As EventArgs) Handles ContextMenuStrip_Nway.Click
If Me.Opacity = 0 Then
Me.ステータスを表示ToolStripMenuItem.Text = "ステータスを隠す"
Me.Opacity = 1 Me.Activate()
Else
Me.ステータスを表示ToolStripMenuItem.Text = "ステータスを表示"
Me.Opacity = 0
End If
End Sub
Private Sub 終了ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 終了ToolStripMenuItem.Click
listener.Stop()
Application.Exit()
End Sub
End Class