Option Explicit
Dim exittes As Boolean, cekexit As Boolean
Dim wCaption As String
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Sub Form_Load()
exittes = False
cekexit = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Code for prevent close and windows shutdown
cekexit = True
If exittes = False Then
Cancel = 1
End If
End Sub
Private Sub Form_Timer()
'This code for closing screen dialog to force clossing the application in vista & 7
Dim WsShell
Set WsShell = CreateObject("WScript.Shell")
If (IsNull(wCaption)) And
(Isnull(GetFileName(GetHwndEXE(GetForegroundWindow())))) Then
Me.SetFocus
WsShell.SendKeys "{ESC}"
End If
If cekexit = True Then
Me.SetFocus
WsShell.SendKeys "{ESC}"
cekexit = False
End If
End Sub
Function GetWindowCaption()
Dim foreground_hwnd As Long
Dim Length As Long
foreground_hwnd = GetForegroundWindow()
wCaption= Space$(1024)
Length = GetWindowText(foreground_hwnd, wCaption, Len(txt))
wCaption= Left$(txt, Length)
End Function
Private Function CheckVersion() As Long
Dim tOS As OSVERSIONINFO
tOS.dwOSVersionInfoSize = Len(tOS)
Call GetVersionEx(tOS)
CheckVersion = tOS.dwPlatformId
End Function
Public Function GetHwndEXE(ByVal hWnd As Long) As String
Dim lProcessID As Long, lThread As Long
Dim lProcessHandle As Long
Dim sName As String, lModule As Long
Dim bMore As Boolean, tPROCESS As PROCESSENTRY32
Dim lSnapShot As Long
lThread = GetWindowThreadProcessId(hWnd, lProcessID)
If CheckVersion() = VER_PLATFORM_WIN32_WINDOWS Then
'Windows 9x
'Create a SnapShot of the Currently Running Processes
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If lSnapShot < 0 Then Exit Function
tPROCESS.dwSize = Len(tPROCESS)
'Enumerate those processes until we find a match
bMore = Process32First(lSnapShot, tPROCESS)
While bMore And tPROCESS.th32ProcessID <> lProcessID
bMore = Process32Next(lSnapShot, tPROCESS)
Wend
'If a match was found, get the EXE Path and Filename
If tPROCESS.th32ProcessID = lProcessID Then
sName = Left$(tPROCESS.szExeFile, InStr(tPROCESS.szExeFile, Chr(0)) - 1)
GetHwndEXE = sName
End If
Else
'Win NT
'Create an Instance of the Process
lProcessHandle = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0&, lProcessID)
'If the Process was successfully created, get the EXE
If lProcessHandle Then
'Just get the First Module, all we need is the Handle to get the Filename..
If EnumProcessModules(lProcessHandle, lModule, 4, 0&) Then
sName = Space(260)
Call GetModuleFileNameExA(lProcessHandle, lModule, sName, Len(sName))
GetHwndEXE = sName
End If
'Close the Process Handle
Call CloseHandle(lProcessHandle)
End If
End If
End Function
Public Function GetFileName(flname As String) As String
Dim posn As Integer, i As Integer
Dim fName As String
posn = 0
'find the position of the last "\" character in filename
For i = 1 To Len(flname)
If (Mid(flname, i, 1) = "\") Then posn = i
Next i
'get filename without path
fName = Right(flname, Len(flname) - posn)
GetFileName = fName
End Function
