ＶＢｄｏｔｎｅｔ２００５ ＴＣＰ ＩＰ System.Net.Sockets应用实例
2008-03-25 14:08
459 查看
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
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
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- system.net.sockets.tcplistener
- VB.NET应用程序中多线程的应用实例
- C#TCP/IP网络应用开发包SocketWrench .NET详细介绍
- System.Net.Sockets.TcpListener
- VB.NET中TextBox的智能感知应用实例
- System.Net.Sockets.TcpListener
- [VB.NET源码]WebBrowser实例应用
- android通过执行netstat及cat /proc/net/tcp查看正在运行应用的本地端口号pid和uid以及对方的IP和端口号
- vb.net中的操作符应用实例
- VB.net应用技巧7： UDP绑定到自身IP
- [VB.NET源码]Instant VB.NET实例解析应用编程(PDF)
- System.Net.Sockets.TcpClient
- System.Net.Sockets.TcpClient
- android通过执行netstat及cat /proc/net/tcp查看正在运行应用的本地端口号pid和uid以及对方的IP和端口号
- 基于全硬件TCP/IP的产品应用实例
- System.Net.Sockets TcpClient 类
- VB.Net--应用ArrayList实例
- 章鱼哥出品_VB.NET 线程委托应用实例 一个简单的例子让你轻松掌握委托的用法
- 技巧 vb.net中的操作符应用实例
- VB.Net中应用ArrayList实例