ＶＢｄｏｔｎｅｔ２００５　ＴＣＰ　ＩＰ　System.Net.Sockets应用实例

最新推荐文章于 2023-12-03 18:20:10 发布
最新推荐文章于 2023-12-03 18:20:10 发布
阅读量390 收藏
点赞数
文章标签： byte integer string structure exception button
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/daliandhc/article/details/2216671
版权

Option Strict On

Imports System.Net.Sockets
Imports System.Text

Imports System.Runtime.InteropServices
Imports Microsoft.VisualBasic
'Ｓｅｒｖｅｒ端

Public Class UserConnection
    ' Events
    Public Event LineReceived As LineReceivedEventHandler

    ' Methods
    Public Sub New(ByVal client As TcpClient)
        UserConnection.__ENCList.Add(New WeakReference(Me))
        Me.writeStartFlag = 0
        Me.stepCount = 0
        Me.sendLength = 0
        Me.sendArray = New Byte(&HFAA - 1) {}
        Me.disTinct = ""
        Me.readBuffer = New Byte(&H100 - 1) {}
        Me.writeBuffer = New Byte(&HFB5 - 1) {}
        Me.client = client
        Me.client.GetStream.BeginRead(Me.readBuffer, 0, &HFF, New AsyncCallback(AddressOf Me.StreamReceiver), Nothing)
    End Sub

    Public Sub Send3R()
        Me.writeStartFlag = 1
        Dim myElementCount As Integer = 0
        '    '    SyncLock client.GetStream
        '    '        Dim writer As New IO.BinaryWriter(client.GetStream)
        '    '        Dim myStruct As Send4RMsg
        '    '        myStruct = New Send4RMsg(" ")
        '    '        Dim strMsg As String = ""
        '    '        Dim sendLength As UShort

        SyncLock client.GetStream
            Dim writer As New IO.BinaryWriter(client.GetStream)
            Dim myStruct As New Send3RMsg(" ")
            Dim sendLength As UShort = &HFAA
            myStruct.wLen = BitConverter.GetBytes(sendLength)
            Me.sendArray(0) = myStruct.wLen(0)
            Me.sendArray(1) = myStruct.wLen(1)
            Me.writeStartFlag = 0
            myStruct.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("3")(0)
            myStruct.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.sendArray(2) = myStruct.cKbn
            Me.sendArray(3) = myStruct.cSRKbn
            myElementCount = 4
            Dim r As Integer = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cSts(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRtn(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 3)
            Me.sendArray(myElementCount) = myStruct.cRComand
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRWcc
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRSba(r)
                myElementCount += 1
                r += 1

            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRKMode(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRRenban(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            Me.sendArray(myElementCount) = myStruct.cRFrmKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRDatKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRMsegKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRKnjKbn
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                If (r > 0) AndAlso r Mod 1000 = 0 Then
                    Me.sendArray(myElementCount) = Encoding.GetEncoding("Shift-JIS").GetBytes(ChrW(21))(0)
                End If
                myElementCount += 1
                r += 1
            Loop While (r <= &HBB7)
            writer.Write(Me.sendArray)
            writer.Flush()
        End SyncLock
        Me.writeStartFlag = 0
    End Sub

    Public Sub Send4R()
        Me.writeStartFlag = 1
        Dim myElementCount As Integer = 0

        SyncLock Me.client.GetStream

            Dim writer As New IO.BinaryWriter(Me.client.GetStream)
            Dim myStruct As New Send4RMsg(" ")
            Dim sendLength As UShort = &HFAA
            myStruct.wLen = BitConverter.GetBytes(sendLength)
            Me.sendArray(0) = myStruct.wLen(0)
            Me.sendArray(1) = myStruct.wLen(1)
            Me.writeStartFlag = 0
            myStruct.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("4")(0)
            myStruct.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.sendArray(2) = myStruct.cKbn
            Me.sendArray(3) = myStruct.cSRKbn
            myElementCount = 4
            Dim r As Integer = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cSts(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRtn(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 3)
            Me.sendArray(myElementCount) = myStruct.cRComand
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRWcc
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRSba(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRKMode(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRRenban(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            Me.sendArray(myElementCount) = myStruct.cRFrmKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRDatKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRMsegKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRKnjKbn
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                If r > 0 AndAlso r Mod 1000 = 0 Then
                    Me.sendArray(myElementCount) = Encoding.GetEncoding("Shift-JIS").GetBytes(ChrW(21))(0)
                End If
                myElementCount += 1
                r += 1
            Loop While (r <= &HBB7)
            writer.Write(Me.sendArray)
            writer.Flush()
        End SyncLock
        Me.writeStartFlag = 0
    End Sub

    Public Sub Send5R()
        Me.writeStartFlag = 1
        Dim myElementCount As Integer = 0
        SyncLock Me.client.GetStream

            Dim writer As New IO.BinaryWriter(Me.client.GetStream)
            Dim myStruct As New Send5RMsg(" ")
            Dim sendLength As UShort = &HFAA
            myStruct.wLen = BitConverter.GetBytes(sendLength)
            Me.sendArray(0) = myStruct.wLen(0)
            Me.sendArray(1) = myStruct.wLen(1)
            Me.writeStartFlag = 0
            myStruct.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("5")(0)
            myStruct.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.sendArray(2) = myStruct.cKbn
            Me.sendArray(3) = myStruct.cSRKbn
            myElementCount = 4
            Dim r As Integer = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cSts(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRtn(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 3)
            Me.sendArray(myElementCount) = myStruct.cRComand
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRWcc
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRSba(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRKMode(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRRenban(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            Me.sendArray(myElementCount) = myStruct.cRFrmKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRDatKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRMsegKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRKnjKbn
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                If r > 0 AndAlso r Mod &H3E8 = 0 Then
                    Me.sendArray(myElementCount) = Encoding.GetEncoding("Shift-JIS").GetBytes(ChrW(21))(0)
                End If
                myElementCount += 1
                r += 1
            Loop While (r <= &HBB7)
            writer.Write(Me.sendArray)
            writer.Flush()
        End SyncLock
        Me.writeStartFlag = 0
    End Sub

    Public Sub Send7R()
        SyncLock Me.client.GetStream
            Dim writer As New IO.BinaryWriter(Me.client.GetStream)
            Dim myElementCount As Integer = 0
            Dim myStruct As New Send7RMsg(" ")
            Dim sendLength As UShort = &HFAA
            myStruct.wLen = BitConverter.GetBytes(sendLength)
            Me.sendArray(0) = myStruct.wLen(0)
            Me.sendArray(1) = myStruct.wLen(1)
            Me.writeStartFlag = 0
            myElementCount = 0
            myStruct.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("7")(0)
            myStruct.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.sendArray(2) = myStruct.cKbn
            Me.sendArray(3) = myStruct.cSRKbn
            myElementCount = 4
            Dim r As Integer = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cSts(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRtn(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 3)
            Me.sendArray(myElementCount) = myStruct.cRComand
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRWcc
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRSba(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRKMode(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRRenban(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            Me.sendArray(myElementCount) = myStruct.cRFrmKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRDatKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRMsegKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRKnjKbn
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRcvBuf(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            writer.Write(Me.sendArray)
            writer.Flush()
        End SyncLock
    End Sub

    Public Sub SendData(ByVal Data As String)
        SyncLock Me.client.GetStream
            Dim writer As New IO.StreamWriter(Me.client.GetStream)
            writer.Write((Data & ChrW(13) & ChrW(10)))
            writer.Flush()
        End SyncLock
    End Sub

    Public Sub SendInit()

        SyncLock Me.client.GetStream

            Dim writer As New IO.BinaryWriter(Me.client.GetStream)
            Dim myElementCount As Integer = 0
            Dim myStruct As New SendInitMsg(" ")
            Dim sendLength As UShort = &HFAA
            myStruct.wLen = BitConverter.GetBytes(sendLength)
            Me.sendArray(0) = myStruct.wLen(0)
            Me.sendArray(1) = myStruct.wLen(1)
            Me.writeStartFlag = 0
            myElementCount = 0
            myStruct.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("2")(0)
            myStruct.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.sendArray(2) = myStruct.cKbn
            Me.sendArray(3) = myStruct.cSRKbn
            myElementCount = 4
            Dim r As Integer = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cSts(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRtn(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 3)
            Me.sendArray(myElementCount) = myStruct.cRComand
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRWcc
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRSba(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRKMode(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 2)
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRRenban(r)
                myElementCount += 1
                r += 1
            Loop While (r <= 1)
            Me.sendArray(myElementCount) = myStruct.cRFrmKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRDatKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRMsegKbn
            myElementCount += 1
            Me.sendArray(myElementCount) = myStruct.cRKnjKbn
            myElementCount += 1
            r = 0
            Do
                Me.sendArray(myElementCount) = myStruct.cRcvBuf(r)
                myElementCount += 1
                r += 1
            Loop While (r <= &HBB7)
            writer.Write(Me.sendArray)
            writer.Flush()
        End SyncLock
    End Sub

    Private Sub StreamReceiver(ByVal ar As IAsyncResult)
        Try
            Dim BytesRead As Integer
            SyncLock Me.client.GetStream
                BytesRead = Me.client.GetStream.EndRead(ar)
            End SyncLock
            Dim strMessage As String = ""
            If (BytesRead > 1) Then
                strMessage = Encoding.ASCII.GetString(Me.readBuffer, 0, (BytesRead - 1))
            End If
            If Not strMessage.Contains("|") Then
                Me.stepCount += 1
                Dim intLen As Integer = Strings.Len(strMessage.Trim)
                Dim strFirst As String = ""
                Dim myLength As Byte() = New Byte() {Me.readBuffer(0), Me.readBuffer(1)}
                Me.sendLength = BitConverter.ToUInt16(myLength, 0)
                If (BytesRead < Me.sendLength) Then
                    Me.sendLength = CUShort(BytesRead)
                End If
                strFirst = ""
                Dim myString1 As Byte() = New Byte((Me.sendLength + 1) - 1) {}
                Dim VBLength As Integer = (Me.sendLength - 1)
                Dim r As Integer = 2
                Do While (r <= VBLength)
                    myString1((r - 2)) = Me.readBuffer(r)
                    r += 1
                Loop
                Me.stepCount = 0
                strFirst = Encoding.GetEncoding("Shift-JIS").GetString(myString1)
                If (strFirst.Length > 1) Then
                    Me.disTinct = strFirst.Substring(0, 2)
                End If
                strMessage = (Me.sendLength.ToString & strFirst)
            End If

            SyncLock Me.client.GetStream
                If "1S".Equals(Me.disTinct) Then
                    Me.SendInit()
                ElseIf "2S".Equals(Me.disTinct) Then
                    Me.Send4R()
                ElseIf "3S".Equals(Me.disTinct) Then
                    Me.Send3R()
                ElseIf "4S".Equals(Me.disTinct) Then
                    Me.Send4R()
                ElseIf "5S".Equals(Me.disTinct) Then
                    Me.Send5R()
                ElseIf Not "6S".Equals(Me.disTinct) Then
                    If "7S".Equals(Me.disTinct) Then
                        Me.Send7R()
                    ElseIf "8S".Equals(Me.disTinct) Then
                    End If
                End If
            End SyncLock
            RaiseEvent LineReceived(Me, strMessage)

            SyncLock Me.client.GetStream
                Me.client.GetStream.BeginRead(Me.readBuffer, 0, &HFF, New AsyncCallback(AddressOf Me.StreamReceiver), Nothing)
            End SyncLock
        Catch exception1 As IO.IOException

        Catch exception2 As Exception

            Interaction.MsgBox(exception2.ToString, MsgBoxStyle.OkOnly, Nothing)

        End Try
    End Sub


    ' Properties
    Public Property Name() As String
        Get
            Return Me.strName
        End Get
        Set(ByVal Value As String)
            Me.strName = Value
        End Set
    End Property


    ' Fields
    Private Shared myENCList As ArrayList = New ArrayList
    Private client As TcpClient
    Public disTinct As String
    Private Const READ_BUFFER_SIZE As Integer = &HFF
    Private readBuffer As Byte()
    Public sendArray As Byte()
    Public sendLength As UShort
    Public stepCount As Integer
    Private strName As String
    Private writeBuffer As Byte()
    Public writeStartFlag As Integer

    ' Nested Types
    Public Delegate Sub LineReceivedEventHandler(ByVal sender As UserConnection, ByVal Data As String)

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure MyStructure
        Public A As String
        Public B As String
        Public C As String
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure Receive
        <FieldOffset(0)> _
        Public wLen1 As Byte
        <FieldOffset(1)> _
        Public wLen2 As Byte
        <FieldOffset(2)> _
        Public cKbn1 As Byte
        Public ReceiveLength As Short
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2)> _
        Public wLen As Byte()
        Public cKbn As String
        Public cSRKbn As String
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=6)> _
        Public ReceiveContains As Byte()
        Public Function ToInt32() As Integer
            Return ((Me.wLen(0) * &H10000) Or (Me.wLen(1) * &H100))
        End Function

        Public Sub SetRGB(ByVal value As Integer)
            Me.wLen1 = CByte((value And &HFF))
            Me.wLen2 = CByte((value And &HFF))
            Me.cKbn1 = CByte((value And &HFF))
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure Send3RMsg
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(0)> _
        Public wLen As Byte()
        <FieldOffset(2)> _
        Public cKbn As Byte
        <FieldOffset(3)> _
        Public cSRKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(4)> _
        Public cSts As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=4), FieldOffset(6)> _
        Public cRtn As Byte()
        <FieldOffset(10)> _
        Public cRComand As Byte
        <FieldOffset(11)> _
        Public cRWcc As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(12)> _
        Public cRSba As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(15)> _
        Public cRKMode As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(&H12)> _
        Public cRRenban As Byte()
        <FieldOffset(20)> _
        Public cRFrmKbn As Byte
        <FieldOffset(&H15)> _
        Public cRDatKbn As Byte
        <FieldOffset(&H16)> _
        Public cRMsegKbn As Byte
        <FieldOffset(&H17)> _
        Public cRKnjKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=&HF92), FieldOffset(&H18)> _
        Public cRcvBuf As Byte()
        <DllImport("kernel32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
        Private Shared Sub RtlMoveMemory(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef Destination As String, ByRef Source As SendInitMsg, ByVal Length As Integer)
        End Sub

        Public Sub New(ByVal initialStr As String)
            Dim sendLength As UShort = &HFAA
            Me.wLen = BitConverter.GetBytes(sendLength)
            Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("3")(0)
            Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
            Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
            Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
            Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
            Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
        End Sub

        Public Property Value() As String
            Get
                Return Strings.Space(Marshal.SizeOf(Me))
            End Get
            Set(ByVal Value As String)
                Dim sendLength As UShort = &HFAA
                Me.wLen = BitConverter.GetBytes(sendLength)
                Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("3")(0)
                Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
                Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
                Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
                Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
                Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
                Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
            End Set
        End Property

    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure Send4RMsg
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(0)> _
        Public wLen As Byte()
        <FieldOffset(2)> _
        Public cKbn As Byte
        <FieldOffset(3)> _
        Public cSRKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(4)> _
        Public cSts As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=4), FieldOffset(6)> _
        Public cRtn As Byte()
        <FieldOffset(10)> _
        Public cRComand As Byte
        <FieldOffset(11)> _
        Public cRWcc As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(12)> _
        Public cRSba As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(15)> _
        Public cRKMode As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(&H12)> _
        Public cRRenban As Byte()
        <FieldOffset(20)> _
        Public cRFrmKbn As Byte
        <FieldOffset(&H15)> _
        Public cRDatKbn As Byte
        <FieldOffset(&H16)> _
        Public cRMsegKbn As Byte
        <FieldOffset(&H17)> _
        Public cRKnjKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=&HF92), FieldOffset(&H18)> _
        Public cRcvBuf As Byte()
        <DllImport("kernel32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
        Private Shared Sub RtlMoveMemory(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef Destination As String, ByRef Source As SendInitMsg, ByVal Length As Integer)
        End Sub

        Public Sub New(ByVal initialStr As String)
            Dim sendLength As UShort = &HFAA
            Me.wLen = BitConverter.GetBytes(sendLength)
            Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("4")(0)
            Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
            Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
            Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
            Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
            Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
        End Sub

        Public Property Value() As String
            Get
                Return Strings.Space(Marshal.SizeOf(Me))
            End Get
            Set(ByVal Value As String)
                Dim sendLength As UShort = &HFAA
                Me.wLen = BitConverter.GetBytes(sendLength)
                Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("4")(0)
                Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
                Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
                Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
                Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
                Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
                Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
            End Set
        End Property

    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure Send5RMsg
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(0)> _
        Public wLen As Byte()
        <FieldOffset(2)> _
        Public cKbn As Byte
        <FieldOffset(3)> _
        Public cSRKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(4)> _
        Public cSts As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=4), FieldOffset(6)> _
        Public cRtn As Byte()
        <FieldOffset(10)> _
        Public cRComand As Byte
        <FieldOffset(11)> _
        Public cRWcc As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(12)> _
        Public cRSba As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(15)> _
        Public cRKMode As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(&H12)> _
        Public cRRenban As Byte()
        <FieldOffset(20)> _
        Public cRFrmKbn As Byte
        <FieldOffset(&H15)> _
        Public cRDatKbn As Byte
        <FieldOffset(&H16)> _
        Public cRMsegKbn As Byte
        <FieldOffset(&H17)> _
        Public cRKnjKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=&HF92), FieldOffset(&H18)> _
        Public cRcvBuf As Byte()
        <DllImport("kernel32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
        Private Shared Sub RtlMoveMemory(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef Destination As String, ByRef Source As SendInitMsg, ByVal Length As Integer)
        End Sub

        Public Sub New(ByVal initialStr As String)
            Dim sendLength As UShort = &HFAA
            Me.wLen = BitConverter.GetBytes(sendLength)
            Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("5")(0)
            Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
            Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
            Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
            Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
            Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
        End Sub

        Public Property Value() As String
            Get
                Return Strings.Space(Marshal.SizeOf(Me))
            End Get
            Set(ByVal Value As String)
                Dim sendLength As UShort = &HFAA
                Me.wLen = BitConverter.GetBytes(sendLength)
                Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("5")(0)
                Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
                Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
                Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
                Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
                Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
                Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
            End Set
        End Property

    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure Send7RMsg
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(0)> _
        Public wLen As Byte()
        <FieldOffset(2)> _
        Public cKbn As Byte
        <FieldOffset(3)> _
        Public cSRKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(4)> _
        Public cSts As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=4), FieldOffset(6)> _
        Public cRtn As Byte()
        <FieldOffset(10)> _
        Public cRComand As Byte
        <FieldOffset(11)> _
        Public cRWcc As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(12)> _
        Public cRSba As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(15)> _
        Public cRKMode As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(&H12)> _
        Public cRRenban As Byte()
        <FieldOffset(20)> _
        Public cRFrmKbn As Byte
        <FieldOffset(&H15)> _
        Public cRDatKbn As Byte
        <FieldOffset(&H16)> _
        Public cRMsegKbn As Byte
        <FieldOffset(&H17)> _
        Public cRKnjKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=&HF92), FieldOffset(&H18)> _
        Public cRcvBuf As Byte()
        <DllImport("kernel32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
        Private Shared Sub RtlMoveMemory(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef Destination As String, ByRef Source As SendInitMsg, ByVal Length As Integer)
        End Sub

        Public Sub New(ByVal initialStr As String)
            Dim sendLength As UShort = &HFAA
            Me.wLen = BitConverter.GetBytes(sendLength)
            Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("7")(0)
            Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
            Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
            Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
            Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
            Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
        End Sub

        Public Property Value() As String
            Get
                Return Strings.Space(Marshal.SizeOf(Me))
            End Get
            Set(ByVal Value As String)
                Dim sendLength As UShort = &HFAA
                Me.wLen = BitConverter.GetBytes(sendLength)
                Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("7")(0)
                Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
                Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
                Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
                Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
                Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
                Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
            End Set
        End Property

    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure SendInitMsg
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(0)> _
        Public wLen As Byte()
        <FieldOffset(2)> _
        Public cKbn As Byte
        <FieldOffset(3)> _
        Public cSRKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(4)> _
        Public cSts As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=4), FieldOffset(6)> _
        Public cRtn As Byte()
        <FieldOffset(10)> _
        Public cRComand As Byte
        <FieldOffset(11)> _
        Public cRWcc As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(12)> _
        Public cRSba As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=3), FieldOffset(15)> _
        Public cRKMode As Byte()
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2), FieldOffset(&H12)> _
        Public cRRenban As Byte()
        <FieldOffset(20)> _
        Public cRFrmKbn As Byte
        <FieldOffset(&H15)> _
        Public cRDatKbn As Byte
        <FieldOffset(&H16)> _
        Public cRMsegKbn As Byte
        <FieldOffset(&H17)> _
        Public cRKnjKbn As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=&HF92), FieldOffset(&H18)> _
        Public cRcvBuf As Byte()
        <DllImport("kernel32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
        Private Shared Sub RtlMoveMemory(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef Destination As String, ByRef Source As SendInitMsg, ByVal Length As Integer)
        End Sub

        Public Sub New(ByVal initialStr As String)
            Dim sendLength As UShort = &HFAA
            Me.wLen = BitConverter.GetBytes(sendLength)
            Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
            Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
            Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
            Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
            Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
            Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
            Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
            Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
        End Sub

        Public Property Value() As String
            Get
                Return Strings.Space(Marshal.SizeOf(Me))
            End Get
            Set(ByVal Value As String)
                Dim sendLength As UShort = &HFAA
                Me.wLen = BitConverter.GetBytes(sendLength)
                Me.cKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cSRKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("R")(0)
                Me.cSts = Encoding.GetEncoding("Shift-JIS").GetBytes("OK")
                Me.cRtn = Encoding.GetEncoding("Shift-JIS").GetBytes("0000")
                Me.cRComand = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRWcc = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRSba = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRKMode = Encoding.GetEncoding("Shift-JIS").GetBytes("123")
                Me.cRRenban = Encoding.GetEncoding("Shift-JIS").GetBytes("12")
                Me.cRFrmKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRDatKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRMsegKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
                Me.cRKnjKbn = Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
                Me.cRcvBuf = Encoding.GetEncoding("Shift-JIS").GetBytes(Strings.Space(&HF92))
            End Set
        End Property

    End Structure

  
End Class 

 

'Ｃｌｉｅｎｔ端

Option Strict On

Imports System.Net.Sockets
Imports System.Text

Public Class Client
    Inherits System.Windows.Forms.Form

#Region " Windows desingner"

    Public Sub New()
        MyBase.New()

        '初期化 Windows
        InitializeComponent()

        'InitializeComponent() 初期化

    End Sub

    'FORM　Rewrite
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Windows Designerより修正
    Private components As System.ComponentModel.IContainer

    Friend WithEvents GroupBox1 As System.Windows.Forms.GroupBox
    Friend WithEvents btnSend As System.Windows.Forms.Button
    Friend WithEvents btnListUsers As System.Windows.Forms.Button
    Friend WithEvents lstUsers As System.Windows.Forms.ListBox
    Friend WithEvents GroupBox2 As System.Windows.Forms.GroupBox
    Friend WithEvents txtSend As System.Windows.Forms.RichTextBox
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents txtDisplay As System.Windows.Forms.RichTextBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.GroupBox1 = New System.Windows.Forms.GroupBox
        Me.txtDisplay = New System.Windows.Forms.RichTextBox
        Me.txtSend = New System.Windows.Forms.RichTextBox
        Me.btnSend = New System.Windows.Forms.Button
        Me.btnListUsers = New System.Windows.Forms.Button
        Me.lstUsers = New System.Windows.Forms.ListBox
        Me.GroupBox2 = New System.Windows.Forms.GroupBox
        Me.Button1 = New System.Windows.Forms.Button
        Me.GroupBox1.SuspendLayout()
        Me.SuspendLayout()
        '
        'GroupBox1
        '
        Me.GroupBox1.Controls.Add(Me.Button1)
        Me.GroupBox1.Controls.Add(Me.txtDisplay)
        Me.GroupBox1.Controls.Add(Me.txtSend)
        Me.GroupBox1.Controls.Add(Me.btnSend)
        Me.GroupBox1.Location = New System.Drawing.Point(7, 7)
        Me.GroupBox1.Name = "GroupBox1"
        Me.GroupBox1.Size = New System.Drawing.Size(406, 295)
        Me.GroupBox1.TabIndex = 0
        Me.GroupBox1.TabStop = False
        Me.GroupBox1.Text = "チャット"
        '
        'txtDisplay
        '
        Me.txtDisplay.Location = New System.Drawing.Point(7, 21)
        Me.txtDisplay.Name = "txtDisplay"
        Me.txtDisplay.Size = New System.Drawing.Size(393, 212)
        Me.txtDisplay.TabIndex = 7
        Me.txtDisplay.Text = ""
        '
        'txtSend
        '
        Me.txtSend.Location = New System.Drawing.Point(7, 240)
        Me.txtSend.Name = "txtSend"
        Me.txtSend.Size = New System.Drawing.Size(300, 48)
        Me.txtSend.TabIndex = 6
        Me.txtSend.Text = ""
        '
        'btnSend
        '
        Me.btnSend.AccessibleDescription = "Send button"
        Me.btnSend.AccessibleName = "Send button"
        Me.btnSend.ImeMode = System.Windows.Forms.ImeMode.NoControl
        Me.btnSend.Location = New System.Drawing.Point(313, 235)
        Me.btnSend.Name = "btnSend"
        Me.btnSend.Size = New System.Drawing.Size(80, 29)
        Me.btnSend.TabIndex = 5
        Me.btnSend.Text = "(&S)送信"
        '
        'btnListUsers
        '
        Me.btnListUsers.ImeMode = System.Windows.Forms.ImeMode.NoControl
        Me.btnListUsers.Location = New System.Drawing.Point(433, 27)
        Me.btnListUsers.Name = "btnListUsers"
        Me.btnListUsers.Size = New System.Drawing.Size(127, 22)
        Me.btnListUsers.TabIndex = 3
        Me.btnListUsers.Text = "(&L)ユーザリスト"
        '
        'lstUsers
        '
        Me.lstUsers.ItemHeight = 12
        Me.lstUsers.Location = New System.Drawing.Point(427, 55)
        Me.lstUsers.Name = "lstUsers"
        Me.lstUsers.Size = New System.Drawing.Size(146, 220)
        Me.lstUsers.TabIndex = 2
        '
        'GroupBox2
        '
        Me.GroupBox2.Location = New System.Drawing.Point(420, 7)
        Me.GroupBox2.Name = "GroupBox2"
        Me.GroupBox2.Size = New System.Drawing.Size(160, 295)
        Me.GroupBox2.TabIndex = 4
        Me.GroupBox2.TabStop = False
        Me.GroupBox2.Text = "オンラインリスト"
        '
        'Button1
        '
        Me.Button1.Location = New System.Drawing.Point(314, 264)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(79, 25)
        Me.Button1.TabIndex = 8
        Me.Button1.Text = "照会送信"
        Me.Button1.UseVisualStyleBackColor = True
        '
        'Client
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 12)
        Me.ClientSize = New System.Drawing.Size(704, 357)
        Me.Controls.Add(Me.btnListUsers)
        Me.Controls.Add(Me.lstUsers)
        Me.Controls.Add(Me.GroupBox1)
        Me.Controls.Add(Me.GroupBox2)
        Me.Name = "Client"
        Me.Text = "Client"
        Me.GroupBox1.ResumeLayout(False)
        Me.ResumeLayout(False)

    End Sub

#End Region
    Const READ_BUFFER_SIZE As Integer = 4010
    Const PORT_NUM As Integer = 20248

    Public sendLength As Integer = 0
    Public stepCount As Integer = 0
    Public StartFlag As Integer = 0

    Private client As TcpClient
    Private readBuffer(READ_BUFFER_SIZE) As Byte

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Dim frmConnectUser As New loginform
        StartFlag = 0
        Try
            'start a socket
            client = New TcpClient("127.0.0.1", PORT_NUM)
            '読み込み

            client.GetStream.BeginRead(readBuffer, 0, READ_BUFFER_SIZE, AddressOf DoRead, Nothing)

            'Form　SHOW
            Me.Show()
            SendData("CONNECT|" & "Tang")
            txtDisplay.AppendText("サーバに接続しました")
            stepCount = 0
            'AttemptLogin()
        Catch Ex As Exception
            MsgBox("サーバに接続できません", _
                   MsgBoxStyle.Exclamation, Me.Text)
            Me.Dispose()
        End Try
    End Sub

    'ログイン
    Sub AttemptLogin()
        Dim frmConnectUser As New loginform
        frmConnectUser.StartPosition = FormStartPosition.CenterParent
        frmConnectUser.ShowDialog(Me)
        SendData("CONNECT|" & frmConnectUser.txtUserLogin.Text)
        frmConnectUser.Dispose()
    End Sub

    'ユーザリスト
    Private Sub btnListUsers_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnListUsers.Click
        lstUsers.Items.Clear()
        SendData("REQUESTUSERS")
    End Sub

    '送信
    Private Sub btnSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSend.Click
        If txtSend.Text <> "" Then
            DisplayText("君説：" & txtSend.Text & Chr(13) & Chr(10))
            SendData("CHAT|" & txtSend.Text)
            txtSend.Clear()
        End If
    End Sub

    '*******************************************
    '         //受信//
    '*******************************************
    '受信も送信と同様にs-Jisで行う

    'デリゲートの宣言
    Public Delegate Sub myDelegate(ByVal statusMessage As String)

    ' Status　更新
    Private Sub StatusInvoke(ByVal statusMessage As String)
        'lstStatus.Items.Add(statusMessage)
        'データーの受信はマルチスレッドで行われる為にデリゲートを使用して
        'メインのスレッドでデーターの表示を行う必要がある。
        txtDisplay.AppendText(statusMessage)
    End Sub


    ' 文字表示
    Private Sub DisplayText(ByVal text As String)
        'txtDisplay.AppendText(text)
        Try
            'lstStatus.Invoke(New _
            '               myDelegate(AddressOf StatusInvoke), _
            '               New Object() {"1234"})
            txtDisplay.Invoke(New _
                           myDelegate(AddressOf StatusInvoke), _
                           text)
        Catch e As Exception
            MsgBox(e.ToString)
        End Try
    End Sub

    '読み込み
    Private Sub DoRead(ByVal ar As IAsyncResult)
        Dim BytesRead As Integer
        Dim strMessage As String

        Try
            ' ストリーム

            BytesRead = client.GetStream.EndRead(ar)
            If BytesRead < 1 Then
                '１より小さけば、サーバが停止された。
                MarkAsDisconnected()
                Exit Sub
            End If

            ' 情報ストリーム輸出
            strMessage = System.Text.Encoding.GetEncoding("Shift-JIS").GetString(readBuffer, 0, BytesRead) 'UTF8輸出


            If Not strMessage.Contains("|") AndAlso StartFlag = 1 Then
                stepCount = stepCount + 1

                'If stepCount = 1 Then
                Dim intLen As Integer

                intLen = Len(strMessage.Trim)


                Dim myLength As Byte()

                ReDim myLength(1)

                'CByte(value And &HFF0000 / &H10000)

                myLength(0) = Convert.ToByte(Convert.ToString(readBuffer(0)))
                myLength(1) = Convert.ToByte(Convert.ToString(readBuffer(1)))

                'sendLength = myLength(0) * &H100 Or myLength(1) * &H100
                sendLength = BitConverter.ToUInt16(myLength, 0)
                strMessage = sendLength.ToString

                'ElseIf stepCount = 2 Then
                stepCount = 0
                Dim strFirst As String
                Dim myString1 As Byte()
                Dim maxByte As Integer
                maxByte = sendLength
                If sendLength > 4010 Then
                    maxByte = 4010
                End If
                ReDim myString1(sendLength)

                For r As Integer = 2 To maxByte - 1
                    myString1(r - 2) = readBuffer(r)
                Next r
                strFirst = System.Text.Encoding.GetEncoding("Shift-JIS").GetString(myString1)
                strMessage = sendLength.ToString & strFirst
                'End If
            End If
            If StartFlag = 0 Then
                stepCount = 0
                StartFlag = 1
            End If
            ProcessCommands(strMessage)

            ' socket読み込み、バッファクリア
            client.GetStream.BeginRead(readBuffer, 0, READ_BUFFER_SIZE, AddressOf DoRead, Nothing)
        Catch e As Exception
            MsgBox(e.ToString)
            MarkAsDisconnected()
        End Try
    End Sub

    ' Offline　情報送信
    Private Sub frmMain_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        '  クライントクローズ情報送信
        If btnSend.Enabled = True Then
            SendData("DISCONNECT")
        End If

    End Sub
    'デリゲートの宣言
    Public Delegate Sub userDelegate()

    Dim userInfo() As String
    ' ユーザ表示
    Private Sub DisplayUsers(ByVal userInfo() As String)
        Me.userInfo = userInfo

        Try
            lstUsers.Invoke(New userDelegate(AddressOf ListUsers))
        Catch e As Exception
            MsgBox(e.ToString)
        End Try
    End Sub
    ' リストユーザ
    Private Sub ListUsers()
        Dim I As Integer
        For I = 1 To userInfo.Length - 1
            lstUsers.Items.Add(userInfo(I))
        Next
    End Sub

    ' Offline
    Private Sub MarkAsDisconnected()
        txtSend.ReadOnly = True
        btnSend.Enabled = False
    End Sub

    ' 受信
    Private Sub ProcessCommands(ByVal strMessage As String)
        Dim dataArray() As String

        ' "|" で区切る
        dataArray = strMessage.Split(Chr(124))

        '
        Select Case dataArray(0)
            Case "JOIN"
                ' 表示
                'DisplayText("すでにチャットに入る" & Chr(13) & Chr(10))
            Case "CHAT"
                ' 受信OK
                DisplayText(dataArray(1) & Chr(13) & Chr(10))
            Case "REFUSE"
                ' 名前が重複
                'AttemptLogin()
            Case "LISTUSERS"
                ' リストユーザ
                DisplayUsers(dataArray)
            Case "BROAD"
                ' 広報
                DisplayText("サーバ：" & dataArray(1) & Chr(13) & Chr(10))
            Case Else
                DisplayText("サーバ：" & dataArray(0))
        End Select
    End Sub

    ' バッファにメッセージ情報を送信
    Private Sub SendData(ByVal data As String)
        Dim writer As New IO.StreamWriter(client.GetStream)
        writer.Write(data & vbCr)
        writer.Flush()
    End Sub

    Private Sub GroupBox1_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GroupBox1.Enter

    End Sub

    Private Sub btnSend_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSend.Click

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim writer As New IO.BinaryWriter(client.GetStream)
        'Dim writer1 As New IO.StreamWriter(client.GetStream)
        Dim sendArray(7) As Byte
        Dim sendLength As UShort
        sendLength = 7
        sendArray(0) = BitConverter.GetBytes(sendLength)(0)
        sendArray(1) = BitConverter.GetBytes(sendLength)(1)
        sendArray(2) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("1")(0)
        sendArray(3) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("S")(0)
        sendArray(4) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
        sendArray(5) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("T")(0)
        sendArray(6) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("S")(0)
        writer.Write(sendArray)

        writer.Flush()

        writer = New IO.BinaryWriter(client.GetStream)

        sendLength = 7
        sendArray(0) = BitConverter.GetBytes(sendLength)(0)
        sendArray(1) = BitConverter.GetBytes(sendLength)(1)
        sendArray(2) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("4")(0)
        sendArray(3) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("S")(0)
        sendArray(4) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("0")(0)
        sendArray(5) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("T")(0)
        sendArray(6) = System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("S")(0)
        writer.Write(sendArray)

        writer.Flush()


        'writer1.Write("1S0TS")

        'writer.Write(System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("1"))
        'writer.Write(System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("S"))
        'writer.Write(System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("0"))
        'writer.Write(System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("T"))
        'writer.Write(System.Text.Encoding.GetEncoding("Shift-JIS").GetBytes("S"))
        'writer.Write("1S0TS")
        'writer1.Flush()

    End Sub
End Class

daliandhc
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
vb.net 实现TCP/IP协议实例详解(使用Socket实现)
XSZ_94的博客
07-08 2万+
最近因项目需求要求实现基于vb.net的TCP/IP协议，在网上也没有找到特别好的实例，故在学习完成后写下如下文字，仅供大家学习，如有错误还请大家批评指正，感谢！本文主要由三部分组成，第一部分展示代码实现的功能；第二部分解释部分与代码相关的基础知识；第三部分讲解服务器端与客户端的实现。本文代码参考自https://code.msdn.microsoft.com/windowsdesktop/Sim...
VB.net学习笔记之聊天工具Server端：System.Net.Sockets
DoubleVoid的CodeFarm~
09-25 1304
新开一个博客，把以前学习的笔记整理整理，防止忘记 1.变量定义： Dim sender1 As New System.Net.Sockets.Socket(Net.Sockets.AddressFamily.InterNetwork, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp) Dim bool
VB.net TCPIP简易实例
10-13
简易TCP/IP通讯实例，用VS2008建立，一个客户端，一个服务器端
VS2005快捷键大全
hzf100的专栏
06-12 1228
快捷键 功能 CTRL + SHIFT + B生成解决方案 CTRL + F7 生成编译 CTRL + O 打开文件 CTRL + SHIFT + O打开项目 CTRL + SHIFT + C显示类视图窗口 F4 显示属性窗口 SHIFT + F4显示项目属性窗口 CTRL + SHIFT + E显示资源视图 F12 转到定义 CTRL + F12转到声明 CTRL + ALT + J对象浏览 C
C#网络编程（System.Net.Sockets命名空间）
wenchm的博客
12-03 1482
System.Net.Sockets命名空间主要提供制作Sockets网络应用程序的相关类，其中Socket类、TcpClient类、TcpListener类和UdpClient类较为常用。
System.Net.Sockets空间
qq_41368899的博客
11-05 4544
System.Net.Sockets空间主要提供制作Sockets网络应用程序的相关类 1.Socket类 Socket类为网络通信提供了方法和属性，主要用于管理连接，实现Berkeley通信端套接字接口.同时，还定义了绑定，连接网络端点及传输数据所需的各种方法，提供处理端点连接传输等细节所需要的功能. 2.TCPClient类和TcpListener类 TcpClient类用于在同步阻止模...
System.Net.Sockets Namespace
极客神殿
07-28 349
System.Net.Sockets 命名空间为需要严密控制网络访问的开发人员提供了 Windows Sockets (Winsock) 接口的托管实现。 类 名称 说明 IPv6MulticastOption 包含用于加入 IPv6 多路广播组的选项值。 LingerOption 指定在调用 Socket 或 Close() 方法之后，如果仍有数据要发送，Close() 是否...
VB.net学习笔记之聊天工具Client端：System.Net.Sockets
DoubleVoid的CodeFarm~
09-25 1841
新开一个博客，把以前学习的笔记整理整理，防止忘记 1.变量定义： Dim sender1 As New System.Net.Sockets.Socket(Net.Sockets.AddressFamily.InterNetwork, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp) '用来处理发送和接收消息的So
System.Net.Sockets命名空间…
编程之路
02-24 5904
谢谢，我正在做个通过telnet获取数据的小工具，网上资料挺少，您这个能给我不少帮助。原文地址：vb.net">System.Net.Sockets命名空间 vb.net作者：欧阳孔剑 System.Net.Sockets命名空间主要提供制作Sockets网络应用程序的相关类，其中Socket类、TcpClient类、TcpListener类、UdpClinet类和NetWorkStream类较为
C#成魔之路<14> 网络编程技术(2 )System.Net.Sockets命名空间
游戏引擎研发进阶之路
03-14 1279
System.Net.Sockets命名空间主要是提供制作Sockets网络应用程序的相关类，其中Socket类，TcpClient类、TcpListener类、UdpClient类较为常用，下面对其进行介绍1、Socket类 Socket类为网络通信提供了一套丰富的方法和属性，主要用于管理连接，实现Berkelery通信段套接字接口，同时，还定义了绑定、连接网络端点以及传输数据所需的各种方法，并
VB.NET.tcp TCPClient.zip
12-16
`System.Net.Sockets.TcpClient`是.NET Framework提供的一个类，它封装了TCP协议的所有功能，包括连接、发送和接收数据。以下是一些关于如何使用TCPClient的关键知识点： 1. **建立连接**： 在VB.NET中，创建一个...
VB.netwangluotongxin.zip_VB.NET TCP_VB.NET TCP通信_tcp_vb.net网络_网络
09-21
在VB.NET中，我们可以使用System.Net.Sockets命名空间中的TcpClient和TcpListener类来实现TCP通信。 首先，TCP通信的基本流程包括服务器端的监听和客户端的连接。在服务器端，我们需要创建一个TcpListener实例，...
vb.net TCP通讯实例
12-15
在VB.NET中，我们可以使用System.Net.Sockets命名空间中的TcpClient和TcpListener类来实现TCP通信。 首先，我们需要创建一个TcpListener来监听特定的IP地址和端口，等待客户端的连接请求。以下是一个简单的Tcp...
VB.NET的TCP协议通信c程序
07-26
在VB.NET中，我们可以使用`System.Net.Sockets.TcpListener`类来创建一个TCP服务器。这个类允许我们监听特定端口上的连接请求。创建一个TcpListener实例，设置其监听的IP地址（通常为“Any”表示所有网络接口）和...
Net.zip_.Net 网络编程TCP实例_C# TCP server_TCPserver C#_c# tcpclient
09-15
在.NET框架中，网络编程是实现应用程序间通信的关键部分，特别是TCP（传输控制协议）由于其可靠性和面向连接的特性，被广泛用于构建稳定的网络服务。本实例将深入讲解C#语言中的TCPClient和TCPServer类，以及如何...
System.Net.Sockets
Java_c#
05-20 1560
   应用程序可以通过 TCPClient、TCPListener 和 UDPClient 类使用传输控制协议 (TCP) 和用户数据文报协议 (UDP) 服务。这些协议类建立在 System.Net.Sockets.Socket 类的基础之上，负责数据传送的细节。(也就是说TCPClient、TCPListener 和 UDPClient 类是用来简化Socket)TcpClient 和 TcpListener 使用 NetworkStream 类表示网络。使用 GetStream 方法返回网络流，然后调
Object-C编程能力扩展
08-24
随着嵌入式硬件和软件系统的发展，过程式编程语言难以满足需求，而现有面向对象语言在嵌入式系统下使用存在障碍。本文提出利用 C 的宏扩展其面向对象编程能力，使其成为支持面向对象编程风格的 Object-C 宏语言。通过实例验证，Object-C 宏语言能够有效支持面向对象编程，为嵌入式开发者提供一种经济、有效的解决方案。
ssm229基于SSM的高校学生综合素质评价系统.zip
最新发布
08-24
ssm229基于SSM的高校学生综合素质评价系统.zip
黑苹果引导OC-0.8.0
08-24
苹果OC引导，即OpenCore引导，是一种用于在非苹果硬件上安装和运行macOS操作系统的引导加载程序。OpenCore提供了更接近苹果原生引导体验的功能，使得黑苹果的安装和使用变得更加便捷和稳定。 与传统的Clover引导相比，OpenCore引导具有以下优势： 更接近原生：OpenCore通过更深入地模拟macOS的启动环境，使得非官方硬件平台上的macOS系统表现更接近原生系统。 更好的兼容性：OpenCore支持更多的硬件设备和macOS版本，能够提供更好的兼容性和稳定性。 更易于配置：OpenCore的配置文件结构更为清晰，配置过程也更为直观和简单。 在使用OC引导安装或运行macOS时，可能会遇到各种问题，如启动卡代码、设备无法识别等。针对这些问题，可以通过以下方式解决： 检查配置文件：确保config.plist文件中的各项设置正确无误，特别是设备属性和驱动程序部分。 更新固件和驱动程序：确保主板固件和所有必要的驱动程序都是最新版本，以解决已知的兼容性问题。 查看日志和错误信息：通过OC引导提供的日志和错误信息来定位问题所在，并尝试找到相应的解决方案。
vb.net tpc/ip通讯实例
07-13
在VB.NET中进行TCP/IP通讯的实例，可以通过System.Net命名空间中的TcpClient和TcpListener类来实现。 首先，我们需要创建一个服务器端，用于监听客户端的连接。通过TcpListener类可以实现该功能。以下是一个简单的...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值