home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch14 / frmmslot.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  4.9 KB  |  128 lines
  1. VERSION 5.00
  2. Begin VB.Form frmmslot 
  3.    Caption         =   "Mailslot"
  4.    ClientHeight    =   2115
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1515
  7.    ClientWidth     =   4260
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   2115
  11.    ScaleWidth      =   4260
  12.    Begin VB.Timer Timer1 
  13.       Interval        =   100
  14.       Left            =   3960
  15.       Top             =   -60
  16.    End
  17.    Begin VB.TextBox txtMailSlotName 
  18.       Height          =   285
  19.       Left            =   1500
  20.       TabIndex        =   2
  21.       Text            =   "\\.\mailslot\demo\slot1"
  22.       Top             =   120
  23.       Width           =   2535
  24.    End
  25.    Begin VB.TextBox txtInfo 
  26.       Height          =   1455
  27.       Left            =   240
  28.       MultiLine       =   -1  'True
  29.       TabIndex        =   1
  30.       Top             =   480
  31.       Width           =   3795
  32.    End
  33.    Begin VB.CheckBox chkServer 
  34.       Caption         =   "Server"
  35.       Height          =   255
  36.       Left            =   300
  37.       TabIndex        =   0
  38.       Top             =   120
  39.       Value           =   1  'Checked
  40.       Width           =   1035
  41.    End
  42. Attribute VB_Name = "frmmslot"
  43. Attribute VB_GlobalNameSpace = False
  44. Attribute VB_Creatable = False
  45. Attribute VB_PredeclaredId = True
  46. Attribute VB_Exposed = False
  47. Option Explicit
  48. ' Copyright 
  49.  1997 by Desaware Inc. All Rights Reserved
  50. Private Type OVERLAPPED
  51.         Internal As Long
  52.         InternalHigh As Long
  53.         offset As Long
  54.         OffsetHigh As Long
  55.         hEvent As Long
  56. End Type
  57. Private Declare Function CreateMailslot Lib "kernel32" Alias "CreateMailslotA" (ByVal lpName As String, ByVal nMaxMessageSize As Long, ByVal lReadTimeout As Long, ByVal lpSecurityAttributes As Long) As Long
  58. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  59. Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
  60. Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
  61. Private Declare Function ReadFileAsync Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
  62. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  63. Private Declare Function GetLastError Lib "kernel32" () As Long
  64. Private Const OPEN_EXISTING = 3
  65. Private Const GENERIC_READ = &H80000000
  66. Private Const GENERIC_WRITE = &H40000000
  67. Private Const GENERIC_EXECUTE = &H20000000
  68. Private Const GENERIC_ALL = &H10000000
  69. Private Const INVALID_HANDLE_VALUE = -1
  70. Private Const FILE_SHARE_READ = &H1
  71. Private Const FILE_SHARE_WRITE = &H2
  72. Private Const FILE_ATTRIBUTE_NORMAL = &H80
  73. Dim IsServer As Boolean
  74. Dim mshandle&   ' Mailslot handle
  75. Private Sub chkServer_Click()
  76.     SetServerState chkServer.Value
  77. End Sub
  78. Private Sub Form_Load()
  79.     mshandle = INVALID_HANDLE_VALUE
  80.     SetServerState chkServer.Value
  81. End Sub
  82. Private Sub SetServerState(ByVal newstate)
  83.     If mshandle <> INVALID_HANDLE_VALUE Then
  84.         Call CloseHandle(mshandle)
  85.         mshandle = 0
  86.     End If
  87.     txtInfo.Text = ""
  88.     IsServer = newstate
  89.     If IsServer Then
  90.         ' It's a server
  91.         mshandle = CreateMailslot(txtMailSlotName.Text, 0, 0, 0)
  92.     Else
  93.         ' Open as a client
  94.         mshandle = CreateFile(txtMailSlotName.Text, GENERIC_WRITE, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  95.     End If
  96.     If mshandle = INVALID_HANDLE_VALUE Then
  97.         MsgBox "Unable to open mailslot"
  98.     End If
  99. End Sub
  100. Private Sub Form_Unload(Cancel As Integer)
  101.     If mshandle <> INVALID_HANDLE_VALUE Then
  102.         Call CloseHandle(mshandle)
  103.         mshandle = 0
  104.     End If
  105. End Sub
  106. Private Sub Timer1_Timer()
  107.     Dim res&
  108.     Dim inchar%
  109.     Dim bytesread&
  110.     If IsServer And mshandle <> INVALID_HANDLE_VALUE Then
  111.         ' It's a server, so read a byte and add it to
  112.         ' the text box
  113.         res = ReadFile(mshandle, inchar, 2, bytesread&, 0)
  114.         If res And bytesread = 2 Then
  115.             txtInfo.Text = txtInfo.Text & Chr$(inchar)
  116.         End If
  117.     End If
  118. End Sub
  119. Private Sub txtInfo_KeyPress(KeyAscii As Integer)
  120.     Dim res&
  121.     Dim byteswritten&
  122.     If (Not IsServer) And mshandle <> INVALID_HANDLE_VALUE Then
  123.         ' It's a client, send the message
  124.         res = WriteFile(mshandle, KeyAscii, 2, byteswritten, 0)
  125.         KeyAscii = 0
  126.     End If
  127. End Sub
  128.