KURO-RS Monitor source
ソース(vb.net は数回しか書いたことが在りませんので至らない部分は多いかと思いますが。。。)

Form1.vb
Public Class Form1
  Delegate Sub SetTextCallback(ByVal [text] As String)
  Private Clib As ClassLib = New ClassLib
  Private p() As Byte
  Private r_flg As Integer = 0
  Private w_flg As Integer = 0

  Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    AppendMessage(Clib.com_port_chk)
  End Sub

  Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
    If Clib.portOpen = 0 Then
      AppendMessage("接続しました")
    Else
      AppendMessage("接続できません")
    End If
  End Sub

  Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
    If Clib.portClose = 0 Then
      AppendMessage("切断しました")
    Else
      AppendMessage("切断できません")
    End If
  End Sub

  Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
    If Clib.app_cmd(Clib.kuroRS.c) = 0 Then
      If Clib.app_cmd(Clib.kuroRS.i) = 0 Then
        AppendMessage("応答がありました。")
      End If
    End If
  End Sub

  Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
    If r_flg = 0 Then
      r_flg = 1
      MsgBox("OKボタンを押した後、学習させたいリモコンのボタンを押してください。")
      If Clib.app_cmd(Clib.kuroRS.r) = 0 Then
        Clib.readBuffer = ""
        System.Threading.Thread.Sleep(3000)
        AppendMessage(Clib.readBuffer.Length & "Byte " & Clib.readBuffer)
      End If
      If Clib.readBuffer.Length = 484 Then
        AppendMessage("読み取り完了。")
        Me.TextBox2.Text = Clib.readBuffer.Substring(2, Clib.readBuffer.Length - 4)
      Else
        AppendMessage("読み取り失敗。")
      End If
    Else
      AppendMessage("読み取り失敗。")
    End If
    r_flg = 0
  End Sub

  Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
    If Me.TextBox2.Text = "" Then
      Exit Sub
    End If
    If w_flg = 0 Then
      w_flg = 1
      If Clib.app_cmd(Clib.kuroRS.t) = 0 Then
        If Clib.app_cmd(p) = 0 Then
          Dim b_pow_off() As Byte = ByteArray(Me.TextBox2.Text)
          If Clib.app_cmd(b_pow_off) = 0 Then
            AppendMessage("送信完了。")
          Else
            AppendMessage("送信失敗。")
          End If
        End If
      End If
    Else
      AppendMessage("読み取り失敗。")
    End If
    w_flg = 0
  End Sub

  '************************************************************************************
  '文字列を一次元バイト配列に変換
  '************************************************************************************
  Private Function ByteArray(ByVal strByteData As String) As Byte()
    If strByteData Is System.DBNull.Value Then strByteData = ""
    If strByteData.Length Mod 2 <> 0 Then strByteData = strByteData & "0"
    Dim i As Integer
    Dim t As Byte()
    Dim c As Byte
    Dim MS As New System.IO.MemoryStream()
    Dim BstrByteData As New System.IO.BinaryWriter(MS)
    MS.Flush()
    For i = 0 To strByteData.Length - 1 Step 2
      Try
        c = CInt("&H" & strByteData.Substring(i, 2))
        BstrByteData.Write(c)
      Catch
        Exit For
      End Try
    Next
    Dim BR As New System.IO.BinaryReader(MS)
    MS.Position = 0
    t = BR.ReadBytes(MS.Length)
    BR.Close()
    BR = Nothing
    MS = Nothing
    Return t
  End Function

  Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
    Select Case ListBox1.Text
      Case "Port1" : p = Clib.kuroRS.Port1
      Case "Port2" : p = Clib.kuroRS.Port2
      Case "Port3" : p = Clib.kuroRS.Port3
      Case "Port4" : p = Clib.kuroRS.Port4
      Case Else : p = Clib.kuroRS.Port1
    End Select
  End Sub

  Private Sub AppendMessage(ByVal mes As String)
    If Me.RichTextBox1.InvokeRequired Then
      Dim d As New SetTextCallback(AddressOf AppendMessage)
      Me.Invoke(d, New Object() {mes})
    Else
      Me.RichTextBox1.AppendText(mes & vbCrLf)
    End If
  End Sub

  Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
    If Me.TextBox2.Text <> "" Then
      Clipboard.SetText(Me.TextBox2.Text)
    End If
  End Sub

  Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click
    Me.TextBox2.Text = ""
    Me.RichTextBox1.Text = ""
  End Sub
End Class



Class.vb
Imports System.IO.Ports
Imports System.Management

Public Class KURO_RS
  Public r() As Byte = {&H72}  'デバイスを学習モード
  Public t() As Byte = {&H74}  'デバイスを送信モード
  Public c() As Byte = {&H63}  'デバイスをモード監視状態に移行
  Public i() As Byte = {&H69}  'デバイスのL E D を点灯
  Public Port1() As Byte = {&H31}  'PORT 1
  Public Port2() As Byte = {&H32}  'PORT 2
  Public Port3() As Byte = {&H33}  'PORT 3
  Public Port4() As Byte = {&H34}  'PORT 4
  Public Y As String = "59"  'OK
  Public E As String = "45"  'OK
  Public O As String = "4F"  'OK
End Class

Public Class ClassLib
  Public kuroRS As KURO_RS = New KURO_RS  'インスタンス
  Public Serial_Port As SerialPort
  Public Com_Port As String = "AUTO"
  Private DATA_BIT As Integer = 115200
  Public readBuffer As String = ""
  Private ReTryLimit As Integer = 3

  Public Function com_port_chk() As String
    'Regexオブジェクトを作成 
    Dim ports As New System.Text.RegularExpressions.Regex( _
        "COM(\d+)", _
        System.Text.RegularExpressions.RegexOptions.IgnoreCase)
    'デバイスマネージャから調査（WMI利用）
    Dim Searcher As New ManagementObjectSearcher()
    Dim PrcSrc As ManagementObjectCollection
    Dim Prc As ManagementObject
    Searcher.Query.QueryString = "SELECT * FROM Win32_PnPEntity Where Name Like 'BUFFALO RemoteStation PC-OP-RS1 (COM%)'"
    PrcSrc = Searcher.Get
    For Each Prc In PrcSrc
      'TextBox1.Text内で正規表現と一致する対象を1つ検索 
      Return ports.Match(Prc("Name").ToString()).ToString
    Next
    Return ""
  End Function

  Public Function portOpen() As Integer
    If Com_Port.ToUpper = "AUTO" Then
      Com_Port = com_port_chk()
    End If
    Try
      Serial_Port = New SerialPort(Com_Port, DATA_BIT, Parity.None, 8, StopBits.One)
      If Not Serial_Port.IsOpen Then
        Try
          Serial_Port.Open()
        Catch ex As UnauthorizedAccessException
          Return -1
          Exit Function
        End Try
      End If
      Serial_Port.DtrEnable = True
      Serial_Port.RtsEnable = True
    Catch ex As ApplicationException
      Return -1
      Exit Function
    End Try
    AddHandler Me.Serial_Port.DataReceived, AddressOf SerialPort_DataReceived
    Return 0
  End Function

  Public Function portClose() As Integer
    If IsDBNull(Serial_Port) Or Serial_Port Is Nothing Then
      Return 0
      Exit Function
    End If
    Try
      If Serial_Port.IsOpen Then
        Serial_Port.Close()
        Serial_Port.Dispose()
      End If
      Return 0
    Catch ex As ApplicationException
      Return -1
    End Try
    Serial_Port = Nothing
  End Function

  Private Sub SerialPort_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs)
    Dim buf(1024) As Byte
    Dim len As Integer = Serial_Port.Read(buf, 0, 1024)
    Dim s As String = Replace(BitConverter.ToString(buf, 0, len).ToUpper, "-", "")
    readBuffer += s
  End Sub

  'パラメータ送信
  Public Function app_cmd(ByVal par() As Byte) As Integer
    If IsDBNull(Serial_Port) Or Serial_Port Is Nothing Then
      Return -1
      Exit Function
    End If
    Dim i As Integer = 0
    readBuffer = ""
    If Not Serial_Port.IsOpen Then
      Return -1
      Exit Function
    End If
    Do
      If readBuffer = "" Then
        Serial_Port.Write(par, 0, par.Length)
        If par.Length > 200 Then
          System.Threading.Thread.Sleep(2000)
        Else
          System.Threading.Thread.Sleep(100)
        End If
      End If
      i += 1
      If i > ReTryLimit Then
        If par Is kuroRS.c Then
          Return 0
        End If
        Return -1
        Exit Function
      End If
    Loop While readBuffer.IndexOf(kuroRS.Y) And readBuffer.IndexOf(kuroRS.E) And readBuffer.IndexOf(kuroRS.O)
    Return 0
  End Function

End Class



KUROrsLib.dll ソース

Imports System.IO.Ports
Imports System.Management
Imports System.EnterpriseServices
Imports System.Reflection
'********************************************
' COM+ 登録の詳細
' COM+ アプリケーション名を指定します。

'sn -k KURO-RSLib.snk
'http://msdn.microsoft.com/ja-jp/library/ms973809.aspx
<Assembly: ApplicationNameAttribute("KURO-RS Control Library")>
<Assembly: AssemblyKeyFileAttribute("bin/kuro-rs.snk")>
'********************************************

<ComClass(ClassLib.ClassID, ClassLib.InterfaceID, ClassLib.EventID)> _
<TransactionAttribute(TransactionOption.Required)> _
Public Class ClassLib

    Inherits ServicedComponent
    Private kuroRS As KURO_RS = New KURO_RS  'インスタンス
    Public Serial_Port As SerialPort
    Public Com_Port As String = "AUTO"
    Public Unit_Port() As Byte = kuroRS.Port1
    Private DATA_BIT As Integer = 115200
    Public Data As String = ""

    Public readBuffer As String = ""
    Private ReTryLimit As Integer = 3

#Region "COM GUIDs"
    Public Const ClassID As String = "18EA9F99-5753-4241-A13F-87911B492A31"
    Public Const InterfaceID As String = "25459B9B-D98F-452c-B243-9F23565DE1FD"
    Public Const EventID As String = "425C1998-EA5C-4d0b-8A8E-396C2AABF59C"
#End Region


    'http://support.microsoft.com/kb/216434/ja
    'http://dobon.net/vb/dotnet/system/registrykey.html
    <System.Runtime.InteropServices.ComRegisterFunctionAttribute()> _
    Public Shared Sub RegisterServer(ByVal str1 As String)
        'COMインストール時に実行する処理を記述
        Try
            Dim regkey As Microsoft.Win32.RegistryKey = _
                Microsoft.Win32.Registry.ClassesRoot.OpenSubKey("CLSID\{18EA9F99-5753-4241-A13F-87911B492A31}\Implemented Categories", True)
            regkey.CreateSubKey("{7DD95801-9882-11CF-9FA9-00AA006C42C4}")
            regkey.CreateSubKey("{7DD95802-9882-11CF-9FA9-00AA006C42C4}")
            regkey.Close()
        Catch
        End Try

    End Sub

    <System.Runtime.InteropServices.ComUnregisterFunctionAttribute()> _
    Public Shared Sub UnregisterServer(ByVal str1 As String)
        'COMアンインストール時に実行する処理を記述
        Try
            Dim regkey As Microsoft.Win32.RegistryKey = _
                Microsoft.Win32.Registry.ClassesRoot.OpenSubKey("CLSID\{18EA9F99-5753-4241-A13F-87911B492A31}\Implemented Categories", True)
            regkey.DeleteSubKey("{7DD95801-9882-11CF-9FA9-00AA006C42C4}")
            regkey.DeleteSubKey("{7DD95802-9882-11CF-9FA9-00AA006C42C4}")
            regkey.Close()
        Catch
        End Try

    End Sub

    <AutoComplete()> _
    Public Function DoTransaction() As String
        Return "KURO-RS Control Library COM+ Registed"
    End Function

    Public Sub New()
        MyBase.New()
    End Sub

    'COMポート設定
    Public Property ComPort() As String
        Get
            If Com_Port.ToUpper = "AUTO" Then
                Com_Port = com_port_chk()
            End If
            Return Com_Port
        End Get
        Set(ByVal newComPort As String)
            If IsNumeric(newComPort) Then
                Com_Port = "COM" & CInt(newComPort)
            Else
                Com_Port = com_port_chk()
            End If
        End Set
    End Property

    'COMポートオープン
    Public ReadOnly Property Open() As Integer
        Get
            Return portOpen()
        End Get
    End Property

    'COMポートクローズ
    Public ReadOnly Property Close() As Integer
        Get
            Return portClose()
        End Get
    End Property

    '端末の応答
    Public ReadOnly Property State() As Integer
        Get
            If app_cmd(kuroRS.c) = 0 Then
                If app_cmd(kuroRS.i) = 0 Then
                    Return 0
                Else
                    Return -1
                End If
            Else
                Return -2
            End If
        End Get
    End Property

    '端末の送信ポート
    Public Property Port() As Integer
        Get
            If Unit_Port Is kuroRS.Port1 Then
                Return 1
            ElseIf Unit_Port Is kuroRS.Port2 Then
                Return 2
            ElseIf Unit_Port Is kuroRS.Port3 Then
                Return 3
            ElseIf Unit_Port Is kuroRS.Port4 Then
                Return 4
            Else
                Return 0
            End If
        End Get
        Set(ByVal newUnitPort As Integer)
            Select Case newUnitPort
                Case 1 : Unit_Port = kuroRS.Port1
                Case 2 : Unit_Port = kuroRS.Port2
                Case 3 : Unit_Port = kuroRS.Port3
                Case 4 : Unit_Port = kuroRS.Port4
                Case Else : Unit_Port = kuroRS.Port1
            End Select
        End Set
    End Property

    Public Property setDATA() As String
        Get
            If app_cmd(kuroRS.r) = 0 Then
                readBuffer = ""
                System.Threading.Thread.Sleep(3000)
            End If
            If readBuffer.Length = 484 Then
                Return readBuffer.Substring(2, readBuffer.Length - 4)
            Else
                Return ""
            End If
        End Get
        Set(ByVal newData As String)
            Data = newData
        End Set
    End Property

    '送信
    Public ReadOnly Property Send() As Integer
        Get
            If Data.Length = 240 Then
                If app_cmd(kuroRS.t) = 0 Then
                    If app_cmd(Unit_Port) = 0 Then
                        Dim bSend() As Byte = ByteArray(Data)
                        If app_cmd(bSend) = 0 Then
                            Return 0
                        Else
                            Return -1
                        End If
                    Else
                        '送信ポート異常
                        Return -2
                    End If
                Else
                    '端末応答無し
                    Return -3
                End If
            Else
                '送信データの長さが異常
                Return -4
            End If
        End Get
    End Property

    'COMポート確認
    Private Function com_port_chk() As String
        'Regexオブジェクトを作成 
        Dim ports As New System.Text.RegularExpressions.Regex( _
                "COM(\d+)", _
                System.Text.RegularExpressions.RegexOptions.IgnoreCase)
        'デバイスマネージャから調査（WMI利用）
        Dim Searcher As New ManagementObjectSearcher()
        Dim PrcSrc As ManagementObjectCollection
        Dim Prc As ManagementObject
        Searcher.Query.QueryString = "SELECT * FROM Win32_PnPEntity Where Name Like 'BUFFALO RemoteStation PC-OP-RS1 (COM%)'"
        PrcSrc = Searcher.Get
        For Each Prc In PrcSrc
            'TextBox1.Text内で正規表現と一致する対象を1つ検索 
            Return ports.Match(Prc("Name").ToString()).ToString
        Next
        Return ""
    End Function

    Private Function portOpen() As Integer
        If Com_Port.ToUpper = "AUTO" Then
            Com_Port = com_port_chk()
        End If
        Try
            Serial_Port = New SerialPort(Com_Port, DATA_BIT, Parity.None, 8, StopBits.One)
            If Not Serial_Port.IsOpen Then
                Try
                    Serial_Port.Open()
                Catch ex As UnauthorizedAccessException
                    Return -1
                    Exit Function
                End Try
            End If
            Serial_Port.DtrEnable = True
            Serial_Port.RtsEnable = True
        Catch ex As ApplicationException
            Return -1
            Exit Function
        End Try
        AddHandler Me.Serial_Port.DataReceived, AddressOf SerialPort_DataReceived
        Return 0
    End Function

    Private Function portClose() As Integer
        If IsDBNull(Serial_Port) Or Serial_Port Is Nothing Then
            Return 0
            Exit Function
        End If
        Try
            If Serial_Port.IsOpen Then
                Serial_Port.Close()
                Serial_Port.Dispose()
            End If
            Return 0
        Catch ex As ApplicationException
            Return -1
        End Try
        Serial_Port = Nothing
    End Function

    Private Sub SerialPort_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs)
        Dim buf(1024) As Byte
        Dim len As Integer = Serial_Port.Read(buf, 0, 1024)
        Dim s As String = Replace(BitConverter.ToString(buf, 0, len).ToUpper, "-", "")
        readBuffer += s
    End Sub

    'パラメータ送信
    Public Function app_cmd(ByVal par() As Byte) As Integer
        If IsDBNull(Serial_Port) Or Serial_Port Is Nothing Then
            Return -1
            Exit Function
        End If
        Dim i As Integer = 0
        readBuffer = ""
        If Not Serial_Port.IsOpen Then
            Return -1
            Exit Function
        End If
        Do
            If readBuffer = "" Then
                Serial_Port.Write(par, 0, par.Length)
                System.Threading.Thread.Sleep(100)
            End If
            i += 1
            If i > ReTryLimit Then
                If par Is kuroRS.c Then
                    Return 0
                End If
                Return -1
                Exit Function
            End If
        Loop While readBuffer.IndexOf(kuroRS.Y) And readBuffer.IndexOf(kuroRS.E) And readBuffer.IndexOf(kuroRS.O)
        Return 0
    End Function

    Public Overrides Function ToString() As String
        ToString = Com_Port
    End Function

    '************************************************************************************
    '文字列を一次元バイト配列に変換
    '************************************************************************************
    Private Function ByteArray(ByVal strByteData As String) As Byte()
        If strByteData Is System.DBNull.Value Then strByteData = ""
        If strByteData.Length Mod 2 <> 0 Then strByteData = strByteData & "0"
        Dim i As Integer
        Dim t As Byte()
        Dim c As Byte
        Dim MS As New System.IO.MemoryStream()
        Dim BstrByteData As New System.IO.BinaryWriter(MS)
        MS.Flush()
        For i = 0 To strByteData.Length - 1 Step 2
            Try
                c = CInt("&H" & strByteData.Substring(i, 2))
                BstrByteData.Write(c)
            Catch
                Exit For
            End Try
        Next
        Dim BR As New System.IO.BinaryReader(MS)
        MS.Position = 0
        t = BR.ReadBytes(MS.Length)
        BR.Close()
        BR = Nothing
        MS = Nothing
        Return t
    End Function

End Class

Public Class KURO_RS
    Public r() As Byte = {&H72}  'デバイスを学習モード
    Public t() As Byte = {&H74}  'デバイスを送信モード
    Public c() As Byte = {&H63}  'デバイスをモード監視状態に移行
    Public i() As Byte = {&H69}  'デバイスのL E D を点灯
    Public Port1() As Byte = {&H31}  'PORT 1
    Public Port2() As Byte = {&H32}  'PORT 2
    Public Port3() As Byte = {&H33}  'PORT 3
    Public Port4() As Byte = {&H34}  'PORT 4
    Public Y As String = "59"  'OK
    Public E As String = "45"  'OK
    Public O As String = "4F"  'OK
End Class





戻る

質問などは