home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / column1r / winpopup.ctl < prev   
Encoding:
Text File  |  1999-08-25  |  6.5 KB  |  194 lines
  1. VERSION 5.00
  2. Begin VB.UserControl WinPoPupEmulator 
  3.    ClientHeight    =   480
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   510
  7.    ScaleHeight     =   480
  8.    ScaleWidth      =   510
  9.    Begin VB.Timer Timer1 
  10.       Enabled         =   0   'False
  11.       Interval        =   100
  12.       Left            =   0
  13.       Top             =   0
  14.    End
  15. End
  16. Attribute VB_Name = "WinPoPupEmulator"
  17. Attribute VB_GlobalNameSpace = False
  18. Attribute VB_Creatable = True
  19. Attribute VB_PredeclaredId = False
  20. Attribute VB_Exposed = True
  21. Option Explicit
  22. Option Base 1
  23.   
  24. Private Type SECURITY_ATTRIBUTES
  25.         nLength As Long
  26.         lpSecurityDescriptor As Long
  27.         bInheritHandle As Long
  28. End Type
  29. Const MAILSLOT_WAIT_FOREVER = (-1)
  30. Const OPEN_EXISTING = 3
  31. Const GENERIC_READ = &H80000000
  32. Const GENERIC_WRITE = &H40000000
  33. Const GENERIC_EXECUTE = &H20000000
  34. Const GENERIC_ALL = &H10000000
  35. Const INVALID_HANDLE_VALUE = -1
  36. Const FILE_SHARE_READ = &H1
  37. Const FILE_SHARE_WRITE = &H2
  38. Const FILE_ATTRIBUTE_NORMAL = &H80
  39. Private Declare Function CloseHandle Lib "kernel32" (ByVal hHandle As Long) As Long
  40. Private Declare Function WriteFile Lib "kernel32" (ByVal hFileName As Long, ByVal lpBuff As Any, ByVal nNrBytesToWrite As Long, lpNrOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
  41. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwAccess As Long, ByVal dwShare As Long, ByVal lpSecurityAttrib As Long, ByVal dwCreationDisp As Long, ByVal dwAttributes As Long, ByVal hTemplateFile As Long) As Long
  42. Private Declare Function GetMailslotInfo Lib "kernel32" (ByVal hMailslot As Long, lpMaxMessageSize As Long, lpNextSize As Long, lpMessageCount As Long, lpReadTimeout As Long) As Long
  43. Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
  44. Private Declare Function CreateMailslot Lib "kernel32.dll" Alias "CreateMailslotA" (ByVal lpName As String, ByVal nMaxMessageSize As Long, ByVal lReadTimeout As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
  45. Dim MHandle As Long
  46. 'Default Property Values:
  47. Const m_def_MailSlotHandle = 0
  48. Const m_def_MessageFrom = ""
  49. Const m_def_MessageText = ""
  50. 'Property Variables:
  51. Dim m_MailSlotHandle As Long
  52. Dim m_MessageFrom() As String
  53. Dim m_MessageText() As String
  54. 'Event Declarations:
  55. Event MessageWaiting(NbrMessageWaiting As Integer)
  56. Function SendToWinPopUp(PopFrom As String, PopTo As String, MsgText As String) As Long
  57.     Dim rc As Long
  58.     Dim mshandle As Long
  59.     Dim msgtxt As String
  60.     Dim byteswritten As Long
  61.     Dim mailslotname As String
  62.     ' name of the mailslot
  63.     mailslotname = "\\" + PopTo + "\mailslot\messngr"
  64.     msgtxt = PopFrom + Chr(0) + PopTo + Chr(0) + MsgText + Chr(0)
  65.     mshandle = CreateFile(mailslotname, GENERIC_WRITE, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, -1)
  66.     rc = WriteFile(mshandle, msgtxt, Len(msgtxt), byteswritten, 0)
  67.     rc = CloseHandle(mshandle)
  68. End Function
  69. Private Function ReadToWinPoPup()
  70. Dim NextSize As Long
  71. Dim Waiting As Long
  72. Dim Buffer() As Byte
  73. Dim ReadSize As Long
  74. Dim FHandle As Long
  75. Dim TempsWaiting As Long
  76. Dim tempo As String
  77. Dim x As Integer
  78. Dim passe As Integer
  79. Dim FromTo As String
  80. Dim message As String
  81. TempsWaiting = MAILSLOT_WAIT_FOREVER
  82. ' look for message
  83.  FHandle = GetMailslotInfo(MHandle, 10, NextSize, Waiting, TempsWaiting)
  84.  
  85.  'if message go read this
  86.  If Waiting <> 0 Then
  87.     If m_MessageFrom(UBound(m_MessageFrom)) <> "" Then
  88.         ReDim Preserve m_MessageFrom(UBound(m_MessageFrom) + 1)
  89.         ReDim Preserve m_MessageText(UBound(m_MessageText) + 1)
  90.     End If
  91.     ReDim Buffer(NextSize)
  92.     FHandle = ReadFile(MHandle, Buffer(1), NextSize, ReadSize, ByVal 0&)
  93.     passe = 1
  94.     For x = 1 To UBound(Buffer)
  95.         If Buffer(x) <> 0 Then
  96.             tempo = tempo & Chr(Buffer(x))
  97.         Else
  98.             Select Case passe
  99.                 Case 1
  100.                     m_MessageFrom(UBound(m_MessageFrom)) = tempo
  101.                     passe = 2
  102.                 Case 2
  103.                     passe = 3
  104.                 Case 3
  105.                     m_MessageText(UBound(m_MessageText)) = tempo
  106.             End Select
  107.             tempo = ""
  108.         End If
  109.     Next
  110.     RaiseEvent MessageWaiting(UBound(m_MessageFrom))
  111. End If
  112. End Function
  113.  
  114. Private Sub Timer1_Timer()
  115.     ReadToWinPoPup
  116. End Sub
  117. Public Sub Initialisation()
  118. Dim MaxMessage As Long
  119. Dim MesssageTimer As Long
  120. Dim t As SECURITY_ATTRIBUTES
  121.     t.nLength = Len(t)
  122.     t.bInheritHandle = False
  123.     MaxMessage = 0
  124.     MesssageTimer = MAILSLOT_WAIT_FOREVER
  125.     MHandle = CreateMailslot("\\.\mailslot\messngr", MaxMessage, MesssageTimer, t)
  126.     ReDim m_MessageFrom(1)
  127.     ReDim m_MessageText(1)
  128.     m_MessageFrom(1) = m_def_MessageFrom
  129.     m_MessageText(1) = m_def_MessageText
  130.     m_MailSlotHandle = MHandle
  131.     Timer1.Enabled = True
  132. End Sub
  133.  
  134. Public Property Get MessageFrom(index As Integer) As String
  135.     MessageFrom = m_MessageFrom(index)
  136. End Property
  137. Public Property Get MessageText(index As Integer) As String
  138.     MessageText = m_MessageText(index)
  139. End Property
  140. Public Sub ClearMessage(index As Integer)
  141. Dim tempo() As String
  142. Dim tempo2() As String
  143. Dim x As Integer
  144. Dim y As Integer
  145. Dim z As Integer
  146.     If UBound(m_MessageFrom) = 1 Then
  147.         m_MessageFrom(1) = ""
  148.         m_MessageText(1) = ""
  149.         Exit Sub
  150.     End If
  151.     ReDim tempo(UBound(m_MessageFrom) - 1)
  152.     ReDim tempo2(UBound(m_MessageFrom) - 1)
  153.     y = 1
  154.     z = 1
  155.     For x = 1 To UBound(m_MessageFrom)
  156.         If x <> index Then
  157.             MsgBox "10"
  158.             MsgBox UBound(m_MessageFrom)
  159.             MsgBox "y=" & y
  160.             tempo(z) = m_MessageFrom(y)
  161.             MsgBox "11"
  162.             tempo2(z) = m_MessageText(y)
  163.             MsgBox "12"
  164.             z = z + 1
  165.         End If
  166.         MsgBox "13"
  167.         y = y + 1
  168.         MsgBox "14"
  169.     Next
  170.     MsgBox "15"
  171.     ReDim m_MessageFrom(UBound(tempo))
  172.     MsgBox "16"
  173.     ReDim m_MessageText(UBound(tempo2))
  174.     MsgBox "17"
  175.     For x = 1 To UBound(tempo)
  176.     MsgBox "18"
  177.         m_MessageFrom(x) = tempo(x)
  178.         MsgBox "19"
  179.         m_MessageText(x) = tempo2(x)
  180.         MsgBox "20"
  181.     Next
  182. End Sub
  183. Public Sub CloseSimulator()
  184.      Timer1.Enabled = False
  185.      CloseHandle MHandle
  186. End Sub
  187.  
  188. Public Property Get MailSlotHandle() As Long
  189.     MailSlotHandle = m_MailSlotHandle
  190. End Property
  191.  
  192.     
  193.  
  194.