Интерфейс Mailslot на примере работы чата Intranet Chat

Option Strict On
Option Explicit On
Option Infer On

Imports System.Runtime.CompilerServices

''' <summary>
''' Алгоритм шифрования и расшифрования RC4.
''' </summary>
Public Class Rc4

    ''' <summary>
    ''' Ключ шифрования (и расшифрования).
    ''' </summary>
    Public ReadOnly Property Key As Byte()

#Region "CTOR"

    ''' <summary>
    ''' Инициализация алгоритма RC4 заданным ключом.
    ''' </summary>
    ''' <param name="key"></param>
    Public Sub New(key As Byte())
        Me.Key = key
    End Sub

    Private S(255) As Integer 'Вектор перестановки.
    Private X As Integer 'Счётчик.
    Private Y As Integer 'Счётчик.

    ''' <summary>
    ''' Инициализирует вектор перестановки заданным ключом
    ''' (алгоритм ключевого расписания, key-scheduling algorithm).
    ''' </summary>
    ''' <param name="key">Байты ключа.</param>
    Private Sub Init(key() As Byte)
        X = 0
        Y = 0
        For i As Integer = 0 To 255
            S(i) = i
        Next
        Dim j As Integer = 0
        Dim keyLen As Integer = key.Length
        For i As Integer = 0 To 255
            j = (j + S(i) + CInt(key(i Mod keyLen))) Mod 256
            S.Swap(i, j)
        Next
    End Sub

#End Region '/CTOR

#Region "OPEN METHODS"

    ''' <summary>
    ''' Кодирует массив.
    ''' </summary>
    ''' <param name="openTextBytes">Массив байтов открытого текста.</param>
    Public Function Encode(openTextBytes As Byte()) As Byte()
        Init(Key)
        Dim ecnode As Byte() = New Byte(openTextBytes.Length - 1) {}
        For i As Integer = 0 To openTextBytes.Length - 1
            ecnode(i) = (openTextBytes(i) Xor GetNextItem())
        Next
        Return ecnode
    End Function

    ''' <summary>
    ''' Декодирует массив.
    ''' </summary>
    ''' <param name="encodedBytes">Зашифрованный массив.</param>
    Public Function Decode(encodedBytes As Byte()) As Byte()
        Return Encode(encodedBytes)
    End Function

#End Region '/OPEN METHODS

    ''' <summary>
    ''' Возвращает следующий элемент ПСП.
    ''' </summary>
    Private Function GetNextItem() As Byte
        X = (X + 1) Mod 256
        Y = (Y + S(X)) Mod 256
        S.Swap(X, Y)
        Dim ind As Integer = (S(X) + S(Y)) Mod 256
        Return CByte(S(ind))
    End Function

End Class

''' <summary>
''' Класс, расширяющий функциональность заданных типов.
''' </summary>
<Extension()>
Friend Module SwapExt

    ''' <summary>
    ''' Меняет местами заданные элементы массива.
    ''' </summary>
    ''' <typeparam name="T">Тип массива.</typeparam>
    ''' <param name="arr">Массив.</param>
    ''' <param name="index1">Индекс 1-го элемента.</param>
    ''' <param name="index2">Индекс 2-го элемента.</param>
    <Extension()>
    Public Sub Swap(Of T)(arr() As T, index1 As Integer, index2 As Integer)
        Dim temp As T = arr(index1)
        arr(index1) = arr(index2)
        arr(index2) = temp
    End Sub

End Module

Imports Microsoft.Win32.SafeHandles
Imports System.Runtime.ConstrainedExecution
Imports System.Runtime.InteropServices
Imports System.Security
Imports System.Security.Permissions

Namespace Mailslots

    <SuppressUnmanagedCodeSecurity()>
    <SecurityCritical(SecurityCriticalScope.Everything)>
    <HostProtection(SecurityAction.LinkDemand, MayLeakOnAbort:=True), SecurityPermission(SecurityAction.LinkDemand, UnmanagedCode:=True)>
    Public Class SafeMailslotHandle
        Inherits SafeHandleZeroOrMinusOneIsInvalid

#Region "NATIVE"

        <ReliabilityContract(Consistency.WillNotCorruptState, Cer.Success)>
        <DllImport("kernel32.dll")>
        Private Shared Function CloseHandle(handle As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function

#End Region '/NATIVE

#Region "CTOR"

        Private Sub New()
            MyBase.New(True)
        End Sub

        Public Sub New(preexistingHandle As IntPtr, ownsHandle As Boolean)
            MyBase.New(ownsHandle)
            MyBase.SetHandle(preexistingHandle)
        End Sub

#End Region '/CTOR

        Protected Overrides Function ReleaseHandle() As Boolean
            Return SafeMailslotHandle.CloseHandle(Me.handle)
        End Function

    End Class

End Namespace

Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Security
Imports System.Text

Namespace Mailslots

    ''' <summary>
    ''' Сервер Mailslot.
    ''' </summary>
    <SuppressUnmanagedCodeSecurity()>
    Public Class MailslotServer
        Implements IDisposable

#Region "NATIVE"

        <DllImport("kernel32.dll")>
        Private Shared Function CreateMailslot(mailslotName As String, nMaxMessageSize As UInteger, lReadTimeout As Integer, securityAttributes As IntPtr) As SafeMailslotHandle
        End Function

        <DllImport("kernel32.dll")>
        Private Shared Function GetMailslotInfo(hMailslot As SafeMailslotHandle, lpMaxMessageSize As IntPtr, <Out()> ByRef lpNextSize As Integer, <Out()> ByRef lpMessageCount As Integer, lpReadTimeout As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function

        <DllImport("kernel32.dll")>
        Private Shared Function ReadFile(handle As SafeMailslotHandle, bytes As Byte(), numBytesToRead As Integer, <Out()> ByRef numBytesRead As Integer, overlapped As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function

#End Region '/NATIVE

        ''' <summary>
        ''' Число ожидающих сообщений. Обновляется только после вызова <see cref="GetNextMessage()"/>.
        ''' </summary>
        Public ReadOnly Property NumberMessages As Integer
            Get
                Return _NumberMessages
            End Get
        End Property
        Private _NumberMessages As Integer = 0

#Region "CTOR"

        Private Handle As SafeMailslotHandle

        Public Sub New(name As String)
            Handle = CreateMailslot($"\\.\mailslot\{name}", 0, 0, IntPtr.Zero) 'обратите внимание: данный синтаксис поддерживается только начиная с VS2019, в более ранних версиях используйте метод String.Format()
            If Handle.IsInvalid Then
                Throw New Win32Exception("Ошибка создания Mailslot.CreateMailslot()")
            End If
        End Sub

        Private Sub Dispose() Implements IDisposable.Dispose
            If (Handle IsNot Nothing) Then
                Handle.Close()
                Handle = Nothing
            End If
        End Sub

#End Region '/CTOR

#Region "METHODS"

        Private Const NO_MESSAGE As Integer = -1

        ''' <summary>
        ''' Получает следующее сообщение.
        ''' </summary>
        Public Function GetNextMessage() As String
            Dim messageBytes As Integer
            If (Not GetMailslotInfo(Handle, IntPtr.Zero, messageBytes, _NumberMessages, IntPtr.Zero)) Then
                Throw New Win32Exception("Ошибка в Mailslot.GetMailslotInfo()")
            End If
            If (messageBytes = NO_MESSAGE) Then
                Return String.Empty
            End If
            Dim buffer As Byte() = New Byte(messageBytes - 1) {}
            Dim bytesRead As Integer
            Dim succeeded As Boolean = ReadFile(Handle, buffer, messageBytes, bytesRead, IntPtr.Zero)
            If (Not succeeded) OrElse (bytesRead = 0) Then
                Throw New Win32Exception("Ошибка в Mailslot.ReadFile()")
            End If
            Dim result As String = Encoding.Unicode.GetString(buffer)
            Return result
        End Function

#End Region '/METHODS

    End Class '/MailslotServer

End Namespace

Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Security
Imports System.Text

Namespace Mailslots

    ''' <summary>
    ''' Клиент Mailslot.
    ''' </summary>
    <SuppressUnmanagedCodeSecurity()>
    Public Class MailslotClient
        Implements IDisposable

        Private Handle As SafeMailslotHandle
        Private ReadOnly Name As String
        Private ReadOnly Machine As String

#Region "ENUMS"

        <Flags()>
        Public Enum FileDesiredAccess As UInteger
            GenericRead = &H80000000UI
            GenericWrite = &H40000000UI
            GenericExecute = &H20000000UI
            GenericAll = &H10000000UI
        End Enum

        <Flags()>
        Public Enum FileShareMode As UInteger
            Zero = 0UI
            FileShareRead = 1UI
            FileShareWrite = 2UI
            FileShareDelete = 4UI
        End Enum

        Public Enum FileCreationDisposition As UInteger
            CreateNew = 1UI
            CreateAlways
            OpenExisting
            OpenAlways
            TruncateExisting
        End Enum

#End Region '/ENUMS

#Region "NATIVE"

        <DllImport("kernel32.dll")>
        Private Shared Function CreateFile(fileName As String, desiredAccess As FileDesiredAccess, shareMode As FileShareMode, securityAttributes As IntPtr, creationDisposition As FileCreationDisposition, flagsAndAttributes As Integer, hTemplateFile As IntPtr) As SafeMailslotHandle
        End Function

        <DllImport("kernel32.dll")>
        Private Shared Function WriteFile(handle As SafeMailslotHandle, bytes As Byte(), numBytesToWrite As Integer, <Out()> ByRef numBytesWritten As Integer, overlapped As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function

#End Region '/NATIVE

#Region "CTOR"

        Public Sub New(name As String)
            Me.New(name, ".")
        End Sub

        Public Sub New(name As String, machine As String)
            Me.Name = name
            Me.Machine = machine
        End Sub

        Private Sub CreateHandle()
            Dim fileName As String = $"\\{Machine}\MAILSLOT\{Name}"
            Handle = CreateFile(fileName, FileDesiredAccess.GenericWrite, FileShareMode.FileShareRead, IntPtr.Zero, FileCreationDisposition.OpenExisting, 0, IntPtr.Zero)
            If Handle.IsInvalid Then
                Throw New Win32Exception("Ошибка создания указателя CreateHandle()")
            End If
        End Sub

        Private Sub Dispose() Implements IDisposable.Dispose
            If (Handle IsNot Nothing) Then
                Handle.Close()
                Handle = Nothing
            End If
        End Sub

#End Region '/CTOR

#Region "METHODS"

        ''' <summary>
        ''' Отправляет сообщение.
        ''' </summary>
        ''' <param name="msg">Байты сообщения.</param>
        Public Overridable Sub SendMessage(msg As String)
            Dim message As Byte() = Encoding.UTF8.GetBytes(msg)
            SendMessage(message)
        End Sub

        ''' <summary>
        ''' Отправляет сообщение.
        ''' </summary>
        ''' <param name="msg">Текст сообщения.</param>
        Public Overridable Sub SendMessage(msg As Byte())
            If (Handle Is Nothing) Then
                CreateHandle()
            End If
            Dim bytesWritten As Integer
            Dim succeeded As Boolean = WriteFile(Handle, msg, msg.Length, bytesWritten, IntPtr.Zero)
            If (Not succeeded) OrElse (msg.Length <> bytesWritten) Then
                Me.Dispose()
                Throw New Win32Exception("Ошибка отправки сообщения SendMessage()")
            End If
        End Sub

#End Region '/METHODS

    End Class '/MailslotClient

End Namespace

Namespace Mailslots

    ''' <summary>
    ''' Клиент для передачи сообщений в общий чат программы "Intranet Chat".
    ''' </summary>
    Public Class IChatClient
        Inherits MailslotClient
        Implements IDisposable

#Region "ПОЛЯ"

        ''' <summary>
        ''' Кодер/декодер алгоритма RC4.
        ''' </summary>
        Private ReadOnly Rc As New Rc4(GetBytes("tahci"))

        ''' <summary>
        ''' Счётчик сообщений, отправленных клиентом. Начинается с 1 и увеличивается на 1 с каждым сообщением.
        ''' </summary>
        Private MessageCounter As Integer = 0

#End Region '/ПОЛЯ

#Region "КОНСТРУКТОРЫ"

        ''' <summary>
        ''' Создаёт клиента для обмена сообщениями в общем чате.
        ''' </summary>
        Public Sub New()
            MyBase.New("ichat047", "*")
            Disconnect()
            Connect()
        End Sub

        Protected Sub New(machine As String)
            MyBase.New("ichat047", machine)
            Disconnect()
            Connect()
        End Sub

#End Region '/КОНСТРУКТОРЫ

#Region "OPEN METHODS"

        ''' <summary>
        ''' Отправляет сообщение в общий чат.
        ''' </summary>
        ''' <param name="msg">Текст сообщения.</param>
        Public Overrides Sub SendMessage(msg As String)
            MessageCounter += 1
            Dim wrapped As Byte() = GetWrappedMessage(msg)
            Dim encoded As Byte() = Rc.Encode(wrapped)
            MyBase.SendMessage(encoded)
        End Sub

#End Region '/OPEN METHODS

#Region "ЗАЩИЩЁННЫЕ МЕТОДЫ"

        ''' <summary>
        ''' Возвращает сообщение с нужным для публичного сообщения обрамлением.
        ''' </summary>
        ''' <param name="msg">Текст сообщения.</param>
        ''' <remarks>Вот как выглядит сообщение чата: 
        ''' ‼iChat‼‼48‼‼AAVE‼‼TEXT‼‼iTCniaM‼‼Message text‼‼‼
        ''' </remarks>
        Protected Overridable Function GetWrappedMessage(msg As String) As Byte()
            Dim wrapped As New List(Of Byte)
            wrapped.AddRange(GetCommon())
            wrapped.AddRange(GetBytes("TEXT"))
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetLineName())) '"iTCniaM")) 'имя линии для общего чата.
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(msg))
            wrapped.AddRange(GetDelim(3))
            Debug.WriteLine("Message=" & Text.Encoding.GetEncoding(1251).GetString(wrapped.ToArray()))
            Return wrapped.ToArray()
        End Function

        ''' <summary>
        ''' Возвращает часть сообщения, общую для всех: счётчик сообщений и имя отправителя.
        ''' </summary>
        Protected Function GetCommon() As List(Of Byte)
            Dim common As New List(Of Byte)
            common.AddRange(GetDelim(1))
            common.AddRange(GetBytes("iChat"))
            common.AddRange(GetDelim(2))
            common.AddRange(GetBytes(MessageCounter.ToString()))
            common.AddRange(GetDelim(2))
            Dim sender As String = GetComputerName()
            common.AddRange(GetBytes(sender))
            common.AddRange(GetDelim(2))
            Return common
        End Function

        ''' <summary>
        ''' Преобразует строку в массив байтов в кодировке Windows-1251.
        ''' </summary>
        Protected Function GetBytes(s As String) As Byte()
            Return Text.Encoding.GetEncoding(1251).GetBytes(s)
        End Function

        ''' <summary>
        ''' Возвращает заданное количество разделителей.
        ''' </summary>
        ''' <param name="num">Необходимое количество разделителей.</param>
        ''' <remarks>В программе iChat разделителем является байт 0x13.</remarks>
        Protected Function GetDelim(num As Integer) As List(Of Byte)
            Dim d As New List(Of Byte)
            For i As Integer = 0 To num - 1
                d.Add(&H13)
            Next
            Return d
        End Function

#End Region '/ЗАЩИЩЁННЫЕ МЕТОДЫ

#Region "ЗАКРЫТЫЕ МЕТОДЫ"

        ''' <summary>
        ''' Отключается от общего чата.
        ''' </summary>
        Private Sub Disconnect()
            MessageCounter += 1
            Dim wrapped As New List(Of Byte)
            wrapped.AddRange(GetCommon())
            wrapped.AddRange(GetBytes("DISCONNECT"))
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetLineName())) 'имя линии чата
            wrapped.AddRange(GetDelim(1))
            Debug.WriteLine("Disconnect=" & Text.Encoding.GetEncoding(1251).GetString(wrapped.ToArray()))
            Dim encoded As Byte() = Rc.Encode(wrapped.ToArray())
            MyBase.SendMessage(encoded)
        End Sub

        ''' <summary>
        ''' Подключиться к общему чату.
        ''' </summary>
        Private Sub Connect()
            MessageCounter += 1
            Dim wrapped As New List(Of Byte)
            wrapped.AddRange(GetCommon())
            wrapped.AddRange(GetBytes("CONNECT"))
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetLineName())) 'имя линии чата
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetUserName()))
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetComputerName()))
            wrapped.AddRange(GetDelim(4))
            wrapped.AddRange(GetBytes("Hello all!"))
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetDestination())) 'получатель или "*"
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetVersion())) 'версия программы
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetStatus()))
            wrapped.AddRange(GetDelim(1))
            Debug.WriteLine("Connect=" & Text.Encoding.GetEncoding(1251).GetString(wrapped.ToArray()))
            Dim encoded As Byte() = Rc.Encode(wrapped.ToArray())
            MyBase.SendMessage(encoded)
        End Sub

        ''' <summary>
        ''' Возвращает имя линии общего чата.
        ''' </summary>
        Private Function GetLineName() As String
            Return "iTCniaM"
        End Function

        ''' <summary>
        ''' Возвращает статус.
        ''' </summary>
        Private Function GetStatus() As String
            Return "0"
        End Function

        ''' <summary>
        ''' Возвращает версию программы iChat.
        ''' </summary>
        Private Function GetVersion() As String
            Return "1.21b4"
        End Function

        ''' <summary>
        ''' Получатель. Для публичного чата это "*".
        ''' </summary>
        Private Function GetDestination() As String
            Return "*"
        End Function

        ''' <summary>
        ''' Возвращает DNS имя компьютера, на котором запущен клиент iChat.
        ''' </summary>
        Private Function GetComputerName() As String
            Return System.Net.Dns.GetHostName()
        End Function

        ''' <summary>
        ''' Возвращает имя текущего пользователя Windows.
        ''' </summary>
        Private Function GetUserName() As String
            Return Environment.UserName
        End Function

#End Region '/ЗАКРЫТЫЕ МЕТОДЫ

        Protected Overloads Sub Dispose() Implements IDisposable.Dispose
            Disconnect() 'не забудем отключиться от чата при завершении работы
            MyBase.Dispose()
        End Sub

    End Class

End Namespace

Namespace Mailslots

    ''' <summary>
    ''' Клиент для передачи приватных сообщений программы "Intranet Chat".
    ''' </summary>
    Public Class IChatPrivateClient
        Inherits IChatClient

#Region "КОНСТРУКТОР"

        ''' <summary>
        ''' Имя компьютера адресата.
        ''' </summary>
        Private ReadOnly Destination As String

        ''' <summary>
        ''' Создаёт клиента для обмена приватными сообщениями с заданным компьютером.
        ''' </summary>
        ''' <param name="dest">Имя адресата.</param>
        Public Sub New(dest As String)
            MyBase.New(dest)
            Destination = dest
        End Sub

#End Region '/КОНСТРУКТОР

#Region "ЗАЩИЩЁННЫЕ МЕТОДЫ"

        ''' <summary>
        ''' Возвращает сообщение с нужным для приватного сообщения обрамлением.
        ''' </summary>
        ''' <param name="msg">Текст сообщения.</param>
        ''' <remarks>Вот как выглядит приватное сообщение чата: 
        ''' ‼iChat‼‼49‼‼AAVE‼‼TEXT‼‼gsMTCI‼‼ Hello‼‼VIRPC‼
        ''' </remarks>
        Protected Overrides Function GetWrappedMessage(msg As String) As Byte()
            Dim wrapped As New List(Of Byte)
            wrapped.AddRange(GetCommon())
            wrapped.AddRange(GetBytes("TEXT"))
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(GetLineName())) 'имя линии приватного чата.
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(msg))
            wrapped.AddRange(GetDelim(2))
            wrapped.AddRange(GetBytes(Destination))
            wrapped.AddRange(GetDelim(1))
            Return wrapped.ToArray()
        End Function

        ''' <summary>
        ''' Возвращает имя линии приватного чата.
        ''' </summary>
        Private Function GetLineName() As String
            Return "gsMTCI"
        End Function

#End Region '/ЗАЩИЩЁННЫЕ МЕТОДЫ

    End Class

End Namespace