Public Function MailSlotReadFirst(ByRef m_Message As String, ByRef m_MsgCount As Integer) As Boolean
    'ПРИЕМНИК(сервер) ф-ция читает первое сообщение если есть
    'возвращает True, если есть хотя бы одно и оно было прочитано
    'm_Message (Out)-текст сообщения, если прочли
    'm_MsgCount -к-во сообщений оставшихся после чтения (без учета прочитанного)

    MailSlotReadFirst = False

    Dim lBufferSize As Integer
    m_Message = ""
    m_MsgCount = 0
    GetMailslotInfo(hMailSlotHandle, 0, lBufferSize, m_MsgCount, 0)
    If m_MsgCount > 0 Then
      Dim sBuffer As String
      ' Create a buffer
      sBuffer = StrDup(lBufferSize, Chr(0))

      ' Read data: optional параметры ф-ции не используем
      If ReadFile(hMailSlotHandle, sBuffer, lBufferSize, 0, IntPtr.Zero) Then
        m_Message = sBuffer
        m_MsgCount = m_MsgCount - 1
        MailSlotReadFirst = True
      End If
    End If
  End Function

  Public Function SendMessageToMailSlot(ByVal sMessage As String, ByVal sMailSlot As String, _
   Optional ByVal CPP As Boolean = False) As Boolean
    'ПЕРЕДАТЧИК(клиент)ф-ция отправляет сообщение sMessage серверу с именем sMailSlot
    'если сервер не запущен, то сообщение не отправляется
    Dim hFile As IntPtr
    Dim m_tSA As SECURITY_ATTRIBUTES

    hFile = CreateFile(sMailSlot, _
                       GENERIC_WRITE, _
                       FILE_SHARE_READ, _
                       m_tSA, _
                       OPEN_EXISTING, _
                       FILE_ATTRIBUTE_NORMAL, _
                       IntPtr.Zero)
    If hFile = INVALID_HANDLE_VALUE Then Return False

    If CPP Then
      SendMessageToMailSlot = WriteFile(hFile, sMessage, Strings.Len(sMessage) + 1, 0, IntPtr.Zero) 'добавляем '\0'
    Else
      SendMessageToMailSlot = WriteFile(hFile, sMessage, Strings.Len(sMessage), 0, IntPtr.Zero) 'при отправке в VB не добавляем '\0'
    End If
    CloseHandle(hFile)
  End Function

Public Class Form1

  Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
    MakeMailSlot("\\.\mailslot\MailSlotMyName")
  End Sub

  Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
    CloseMailSlot() 'необх. нет, т.к. он уничтожится по любому вместе с закрытием приложения
  End Sub

'я беру интервал 1 секунда  
Private Sub TimerMailSlot_Tick(sender As Object, e As EventArgs) Handles TimerMailSlot.Tick
    ReadApplyMessages_MailSlot()
  End Sub

  Public Sub ReadApplyMessages_MailSlot()
    Dim the_str As String = vbNullString
    Dim the_msgCount As Integer
    Do
      If MailSlotReadFirst(the_str, the_msgCount) Then
        '---обработка сообщения---
        MsgBox(the_str)
        '---обработка сообщения---
        If the_msgCount = 0 Then Exit Do
      Else
        Exit Do
      End If
    Loop
  End Sub

  Private Sub ButtonSendANSI_Click(sender As Object, e As EventArgs) Handles ButtonSendANSI.Click
    SendMessageToMailSlot(TextBoxToSend.Text, "\\.\mailslot\MailSlotMyName", False)
  End Sub

  Private Sub ButtonSendUTF8_Click(sender As Object, e As EventArgs) Handles ButtonSendUTF8.Click
    SendMessageToMailSlot(TextBoxToSend.Text, "\\.\mailslot\MailSlotMyName", True)
  End Sub
End Class



Module MailSlots
  Public Structure SECURITY_ATTRIBUTES
    Dim nLength As Integer
    Dim lpSecurityDescriptor As IntPtr
    Dim bInheritHandle As Boolean
  End Structure

  'File Attribute Constants
  Public Const FILE_ATTRIBUTE_NORMAL = &H80

  Public ReadOnly INVALID_HANDLE_VALUE As IntPtr = New IntPtr(-1)

  'File Management Functions

  'dwDesiredAccess - The requested access to the file or device, which can be summarized as read, write, both...
  Public Const GENERIC_WRITE = &H40000000
  'dwShareMode - The requested sharing mode of the file or device
  Public Const FILE_SHARE_READ = &H1
  'dwCreationDisposition -An action to take on a file or device that exists or does not exist.
  Public Const OPEN_EXISTING = 3

  Public Declare Unicode Function CreateFile Lib "kernel32" _
   Alias "CreateFileW" ( _
   ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Integer, _
   ByVal dwShareMode As Integer, _
   ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _
   ByVal dwCreationDisposition As Integer, _
   ByVal dwFlagsAndAttributes As Integer, _
   ByVal hTemplateFile As IntPtr) As IntPtr

  Public Declare Function ReadFile Lib "kernel32" ( _
   ByVal hFile As IntPtr, _
   ByVal lpBuffer As Byte(), _
   ByVal nNumberOfBytesToRead As Integer, _
   ByRef lpNumberOfBytesRead As Integer, _
   ByVal lpOverlapped As IntPtr) As Boolean 'два крайних параметра -Optional
  Public Declare Function WriteFile Lib "kernel32" ( _
   ByVal hFile As IntPtr, _
   ByVal lpBuffer As Byte(), _
   ByVal nNumberOfBytesToWrite As Integer, _
   ByRef lpNumberOfBytesWritten As Integer, _
   ByVal lpOverlapped As IntPtr) As Boolean

  'Mailslot Functions
  Public Declare Unicode Function CreateMailslot Lib "kernel32" _
   Alias "CreateMailslotW" ( _
   ByVal lpName As String, _
   ByVal nMaxMessageSize As Integer, _
   ByVal lReadTimeout As Integer, _
   ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES) As IntPtr
  Public Declare Function GetMailslotInfo Lib "kernel32" ( _
   ByVal hMailslot As IntPtr, _
   ByRef lpMaxMessageSize As Integer, _
   ByRef lpNextSize As Integer, _
   ByRef lpMessageCount As Integer, _
   ByRef lpReadTimeout As Integer) As Boolean

  'Handle and Object Functions
  Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As IntPtr) As Boolean

  Public hMailSlotHandle As IntPtr

  Public Function MakeMailSlot(ByVal lpszSlotName As String) As Boolean
    'ПРИЕМНИК(сервер) ф-ция создает MailSlot с именем lpszSlotName
    'невозможно создать более одного MailSlot с заданным именем
    Dim m_tSA As SECURITY_ATTRIBUTES

    If Strings.Len(lpszSlotName) = 0 Then
      ' No slotname
      hMailSlotHandle = INVALID_HANDLE_VALUE
      MakeMailSlot = False
      Exit Function
    End If

    ' The handle to the slot
    hMailSlotHandle = CreateMailslot(lpszSlotName, 0, 0, m_tSA)

    MakeMailSlot = (hMailSlotHandle <> INVALID_HANDLE_VALUE)
  End Function

  Public Sub CloseMailSlot()
    'ПРИЕМНИК(сервер) ф-ция уничтожает MailSlot
    'При этом все непрочитанные сообщения также уничтожаются
    'При закрытии приложения (включая принудительное типа End Task/kill) MailSlot и сообщения также уничтожатся
    If hMailSlotHandle <> INVALID_HANDLE_VALUE Then
      CloseHandle(hMailSlotHandle)
      hMailSlotHandle = INVALID_HANDLE_VALUE
    End If
  End Sub

  Public Function MailSlotReadFirst(ByRef m_Message As String, ByRef m_MsgCount As Integer) As Boolean
    'ПРИЕМНИК(сервер) ф-ция читает первое сообщение если есть
    'возвращает True, если есть хотя бы одно и оно было прочитано
    'm_Message (Out)-текст сообщения, если прочли
    'm_MsgCount -к-во сообщений оставшихся после чтения (без учета прочитанного)

    MailSlotReadFirst = False

    Dim lBufferSize As Integer
    m_Message = ""
    m_MsgCount = 0
    GetMailslotInfo(hMailSlotHandle, 0, lBufferSize, m_MsgCount, 0)
    If m_MsgCount > 0 Then
      Dim sBuffer(lBufferSize - 1) As Byte

      ' Read data: optional параметры ф-ции не используем
      If ReadFile(hMailSlotHandle, sBuffer, lBufferSize, 0, IntPtr.Zero) Then
        Using mstream As New IO.MemoryStream(sBuffer)
          Using reader As New IO.StreamReader(mstream, System.Text.Encoding.Default, True)
            m_Message = reader.ReadToEnd()
          End Using
        End Using
        m_MsgCount = m_MsgCount - 1
        MailSlotReadFirst = True
      End If
    End If
  End Function

  Public Function SendMessageToMailSlot(ByVal sMessage As String, ByVal sMailSlot As String, _
   Optional ByVal bUTF8 As Boolean = True, Optional ByVal CPP As Boolean = False) As Boolean
    'ПЕРЕДАТЧИК(клиент)ф-ция отправляет сообщение sMessage серверу с именем sMailSlot
    'если сервер не запущен, то сообщение не отправляется
    'bUTF8 -кодировать в UTF8 CPP-если true, то добавлять '\0' в конце
    Dim hFile As IntPtr
    Dim m_tSA As SECURITY_ATTRIBUTES

    hFile = CreateFile(sMailSlot, _
                       GENERIC_WRITE, _
                       FILE_SHARE_READ, _
                       m_tSA, _
                       OPEN_EXISTING, _
                       FILE_ATTRIBUTE_NORMAL, _
                       IntPtr.Zero)
    If hFile = INVALID_HANDLE_VALUE Then Return False

    If CPP Then sMessage = sMessage & Chr(0) 'при отправке в VB не добавляем '\0'

    Dim buffer As Byte()
    If bUTF8 Then 'отправлять Юникод
      'Указываем всегда использовать BOM
      Dim pre As Byte() = System.Text.Encoding.UTF8.GetPreamble()
      Dim body As Byte() = System.Text.Encoding.UTF8.GetBytes(sMessage)
      ReDim buffer(pre.Length + body.Length - 1)
      Array.Copy(pre, buffer, pre.Length)
      Array.Copy(body, 0, buffer, pre.Length, body.Length)
      'System.Text.Encoding.UTF8.GetPreamble().Concat(System.Text.Encoding.UTF8.GetBytes(sMessage)).ToArray
    Else 'отправлять ANSI
      buffer = System.Text.Encoding.Default.GetBytes(sMessage)
    End If

    SendMessageToMailSlot = WriteFile(hFile, buffer, buffer.Length(), 0, IntPtr.Zero)
    CloseHandle(hFile)
  End Function
End Module

Imports System.Runtime.InteropServices

Module ModuleCopyData
  Public Const WM_COPYDATA = &H4A

  <StructLayout(LayoutKind.Sequential)>
  Public Structure COPYDATASTRUCT
    Dim dwData As IntPtr ' additional 32 bit data to pass
    Dim cbData As Integer ' length in bytes of data pointed by lpData
    Dim lpData As IntPtr 'Byte() ' pointer to data to be passed to the receiving app. 
  End Structure

  Public Declare Unicode Function SendMessage_COPYDATASTRUCT Lib "user32" Alias "SendMessageW" _
   (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As COPYDATASTRUCT) As Integer

  Public Sub SendMessageCopyData(ByVal dwData As Integer, ByVal sMessage As String, ByVal hwndTarget As IntPtr, _
   Optional ByVal bUTF8 As Boolean = True, Optional ByVal AddZero As Boolean = False)
    'dwData -тип сообщения (например номер команды)
    'sMessage -текстовое сообщение
    'hwndTarget -окно - получатель сообщения
    'bUTF8 -кодировать в UTF8; AddZero-если true, то добавлять '\0' в конце

    If AddZero Then sMessage = sMessage & Chr(0) 'в VB6 при приеме иногда читал байты по указателю до символа '\0'

    Dim buffer As Byte()
    Using mstream As New IO.MemoryStream()
      Using writer As New IO.StreamWriter(mstream, IIf(bUTF8, System.Text.Encoding.UTF8, System.Text.Encoding.Default))
        writer.Write(sMessage)
        writer.Flush()
        buffer = mstream.ToArray()
      End Using
    End Using
    Dim cds As New COPYDATASTRUCT
    cds.dwData = CType(dwData, IntPtr) 'идентифицирует тип передаваемых данных
    cds.cbData = buffer.Length
    Dim lpData As IntPtr = Marshal.AllocHGlobal(buffer.Length)
    Marshal.Copy(buffer, 0, lpData, buffer.Length)
    cds.lpData = lpData

    Call SendMessage_COPYDATASTRUCT(hwndTarget, WM_COPYDATA, hwndTarget, cds)

    Marshal.FreeHGlobal(lpData)

  End Sub

End Module

'=====

Imports System.Runtime.InteropServices

Public Class Form1
  Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
    'Debug.WriteLine(m.ToString())

    Select Case m.Msg
      Case WM_COPYDATA
        Dim the_str As String
        Dim cds As COPYDATASTRUCT = CType(Marshal.PtrToStructure(m.LParam, GetType(COPYDATASTRUCT)), COPYDATASTRUCT)
        Dim buffer(cds.cbData - 1) As Byte
        Marshal.Copy(cds.lpData, buffer, 0, cds.cbData)
        Using mstream As New IO.MemoryStream(buffer)
          Using reader As New IO.StreamReader(mstream, System.Text.Encoding.Default, True)
            the_str = reader.ReadToEnd()
          End Using
        End Using
        MsgBox(the_str & ";len=" & Strings.Len(the_str))
      Case Else
    End Select

    ' Forward message to base WndProc.
    MyBase.WndProc(m)
  End Sub

  Private Sub ButtonSendMeANSI_Click(sender As Object, e As EventArgs) Handles ButtonSendMeANSI.Click
    SendMessageCopyData(1, TextBoxSendMeANSI.Text, Me.Handle, False, False)
  End Sub

  Private Sub ButtonSendMeUNI_Click(sender As Object, e As EventArgs) Handles ButtonSendMeUNI.Click
    SendMessageCopyData(2, TextBoxSendMeUNI.Text, Me.Handle, True, False)
  End Sub
End Class

  Public Structure COPYDATASTRUCT
    Dim dwData As IntPtr ' additional 32 bit data to pass
    Dim cbData As Integer ' length in bytes of data pointed by lpData
    Dim lpData As Byte() ' pointer to data to be passed to the receiving app.
  End Structure

  Public Sub SendMessageCopyData(ByVal dwData As Integer, ByVal sMessage As String, ByVal hwndTarget As IntPtr, _
   Optional ByVal bUTF8 As Boolean = True, Optional ByVal AddZero As Boolean = False)
    'dwData -тип сообщения (например номер команды)
    'sMessage -текстовое сообщение
    'hwndTarget -окно - получатель сообщения
    'bUTF8 -кодировать в UTF8; AddZero-если true, то добавлять '\0' в конце

    If AddZero Then sMessage = sMessage & Chr(0) 'в VB6 при приеме иногда читал байты по указателю до символа '\0'

    Dim cds As New COPYDATASTRUCT
    Using mstream As New IO.MemoryStream()
      Using writer As New IO.StreamWriter(mstream, IIf(bUTF8, System.Text.Encoding.UTF8, System.Text.Encoding.Default))
        writer.Write(sMessage)
        writer.Flush()
        cds.lpData = mstream.ToArray()
      End Using
    End Using
    cds.dwData = CType(dwData, IntPtr) 'идентифицирует тип передаваемых данных
    cds.cbData = cds.lpData.Length

    Call SendMessage_COPYDATASTRUCT(hwndTarget, WM_COPYDATA, hwndTarget, cds)

  End Sub

'---
  Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
    'Debug.WriteLine(m.ToString())

    Select Case m.Msg
      Case WM_COPYDATA
        Dim the_str As String
        Dim cds As COPYDATASTRUCT = CType(Marshal.PtrToStructure(m.LParam, GetType(COPYDATASTRUCT)), COPYDATASTRUCT)
        Using mstream As New IO.MemoryStream(cds.lpData)
          Using reader As New IO.StreamReader(mstream, System.Text.Encoding.Default, True)
            the_str = reader.ReadToEnd()
          End Using
        End Using
        MsgBox(the_str & ";len=" & Strings.Len(the_str))
      Case Else
    End Select

    ' Forward message to base WndProc.
    MyBase.WndProc(m)
  End Sub

cds.lpData = VarPtr(StringToMas(str_id).ByteStr(0))

Public Type StringToChar
  ByteStr() As Byte
End Type

Public Function StringToMas(str As String) As StringToChar
  Dim data As StringToChar
  Dim temp As String
  Dim Ln As Long
  Dim i As Long
  Dim Ptr As Long
  temp = str
  Ln = Len(temp)
  ReDim data.ByteStr(0 To Ln)
  If Ln > 0 Then
    For i = 0 To Ln - 1
      data.ByteStr(i) = Asc(Mid(temp, i + 1, 1))
    Next i
  End If
  data.ByteStr(Ln) = 0
  StringToMas = data
End Function