Sunday, December 27, 2015

MsgBoxTimeOut function module

'//MsgBoxTimeOut module
'//Author          : s0ft
'//Contact         :
'//Blog            :
'//Usage Example   : MsgBoxTimeOut "Sample msgbox content",vbOkOnly,"Title",5000,500 'timeout of 5 seconds with initial delay of 0.5 seconds
'//Compile type    : P-Code. A lot of problems with CreateThread API in Native mode
'//Date/Time       : 2015/12/27 - 10:12 PM

Option Explicit

Private Declare Function CreateThread Lib "kernel32.dll" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByRef lpParameter As Any, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function TerminateThread Lib "kernel32.dll" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long

Dim strContent_ As String
Dim boxType_ As Long
Dim strTitle_ As String
Dim TimeOut_ As Long
Dim initialDelay_ As Long

Public Sub MsgBoxTimeOut(ByVal strContent As String, ByVal boxType As Long, ByVal strTitle As String, ByVal TimeOut As Long, ByVal initialDelay As Long)
strContent_ = strContent
boxType_ = boxType
strTitle_ = strTitle
TimeOut_ = TimeOut
initialDelay_ = initialDelay
Dim threadID As Long
CreateThread ByVal 0&, ByVal 0&, AddressOf step1, ByVal 0&, ByVal 0&, threadID
End Sub

Private Sub step1()
Dim threadID As Long
Dim hThread As Long
Sleep initialDelay_ '//the initial delay must be here, not inside the msgbox thread. that would be silly
hThread = CreateThread(ByVal 0&, ByVal 0&, AddressOf step2, ByVal 0&, ByVal 0&, threadID)
Sleep TimeOut_
TerminateThread hThread, 0
End Sub

Private Sub step2()
MessageBox 0, strContent_, strTitle_, boxType_
End Sub