Option Explicit
 
' öffentliche Programmvariablen
Private SlotHandle As Long
Private MySlot As String
 
' Konstanten für die CreateFile API's
Private Const OPEN_EXISTING = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_EXECUTE = &H20000000
Private Const GENERIC_ALL = &H10000000
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
 
' Konstanten für die CreateMailslot API's
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
 
Private tSA As SECURITY_ATTRIBUTES
 
' Client API's
Private Declare Function CreateFile Lib "kernel32" _
  Alias "CreateFileA" ( _
  ByVal lpFileName As String, _
  ByVal dwDesiredAccess As Long, _
  ByVal dwShareMode As Long, _
  lpSecurityAttributes As SECURITY_ATTRIBUTES, _
  ByVal dwCreationDisposition As Long, _
  ByVal dwFlagsAndAttributes As Long, _
  ByVal hTemplateFile As Long) As Long
 
Private Declare Function CreateFileNoSecurity Lib "kernel32" _
  Alias "CreateFileA" ( _
  ByVal lpFileName As String, _
  ByVal dwDesiredAccess As Long, _
  ByVal dwShareMode As Long, _
  ByVal Zero As Long, _
  ByVal dwCreationDisposition As Long, _
  ByVal dwFlagsAndAttributes As Long, _
  ByVal hTemplateFile As Long) As Long
 
Private Declare Function WriteFileSimple Lib "kernel32" _
  Alias "WriteFile" ( _
  ByVal hFile As Long, _
  ByVal lpBuffer As String, _
  ByVal nNumberOfBytesToWrite As Long, _
  lpNumberOfBytesWritten As Long, _
  ByVal Zero As Long) As Long
 
' Server API's
Private Declare Function ReadFileSimple Lib "kernel32" _
  Alias "ReadFile" ( _
  ByVal hFile As Long, _
  ByVal lpBuffer As String, _
  ByVal nNumberOfBytesToRead As Long, _
  lpNumberOfBytesRead As Long, _
  ByVal Zero As Long) As Long
 
Private Declare Function CreateMailslot Lib "kernel32" _
  Alias "CreateMailslotA" ( _
  ByVal lpName As String, _
  ByVal nMaxMessageSize As Long, _
  ByVal lReadTimeout As Long, _
  lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
 
Private Declare Function GetMailslotInfo Lib "kernel32" ( _
  ByVal hMailslot As Long, _
  lpMaxMessageSize As Long, _
  lpNextSize As Long, _
  lpMessageCount As Long, _
  lpReadTimeout As Long) As Long
 
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long
 
 
 
Private Sub Form_Load()
  ' bedarf wohl keiner Erklärung ;)
  Timer1.Interval = 100
  Timer1.Enabled = False
End Sub
Private Sub cmd_CreateSlot_Click()
  If txt_MySlot.Text = "" Then Exit Sub
  If Left$(txt_MySlot.Text, 13) <> "\\.\mailslot\" Then Exit Sub ' Name korrekt ?
 
  ' SlotName und MaxDateigröße übergeben
  SlotHandle = MailSlotCreate(txt_MySlot.Text, 400)
 
  ' Falls erfolgreich geöffnet, zyklisch nach
  ' Dateien schauen
  If SlotHandle > 0 Then
    Timer1.Enabled = True
  Else
    MsgBox "Der Mailslot konnte nicht erstellt werden.", vbCritical
  End If
End Sub
 
' Mailslot erstellen
Private Function MailSlotCreate( _
  ByVal SlotName As String, _
  MsgSize As Long) As Long
 
  Dim Handle As Long
 
  tSA.nLength = Len(tSA)
  tSA.lpSecurityDescriptor = 1
 
  If SlotName = "" Then
    ' kein Name angegeben?
    MailSlotCreate = -1: Exit Function
  End If
 
  ' Hier erhalten wir das Handle
  Handle = CreateMailslot(SlotName, MsgSize, 0, tSA)
 
  MailSlotCreate = Handle
End Function
 
Private Sub Timer1_Timer()
  Dim MsgText As String
  Dim MSize As Long
  Dim MsgCount As Long
  Dim SlotInfo As Long
  'Dim BytesRead As Long
  Dim BufferSize As Long
 
  ' GetMailslotInfo gibt uns Auskunft über den Mailslot
  ' MSize   = Maximale Dateigröße
  ' Buffersize = Größe der nächsten Datei im Mailslot
  ' MsgCount  = Anzahl der Dateien im Mailslot
 
  SlotInfo = GetMailslotInfo(SlotHandle, MSize, _
    BufferSize, MsgCount, 0)

>> <<