Option Explicit
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function killtimer Lib "user32" Alias "KillTimer" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName _
As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, _
ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private lTimerID As Long
Public Sub Disable(Optional Password As Variant)
Dim bVBEIsEnabled As Boolean
Dim sRet As String
'\ignore error in case reg value:'VBEIsDisabled' doesn't exist
On Error Resume Next
bVBEIsEnabled = CBool(GetSetting("VBEDisablerClass", "Values", "VBEIsDisabled"))
On Error GoTo 0
'\handle each password scenario
Select Case True
Case bVBEIsEnabled
GoTo AlreadyDisabled
Case IsMissing(Password)
sRet = InputBox("Enter an optional password to enable the VBE. ", _
"Disabling the VBE. ")
If StrPtr(sRet) = 0 Then
GoTo DisableVBENow
Else
Password = sRet
End If
End Select
SavePassword:
SaveSetting "VBEDisablerClass", "Values", "Password", CStr(Password)
SaveSetting "VBEDisablerClass", "Values", "PasswordExists", CStr(True)
DisableVBENow:
Call DisableVBE
Exit Sub
AlreadyDisabled:
MsgBox "The VBE is already disabled. ", vbExclamation
Cancelled:
End Sub
Public Sub Enable(Optional Password As Variant)
Dim bPasswordExists As Boolean
Dim sSavedPassWord As String
Dim sRet As String
'\ignore error in case reg value: 'PasswordExists' doesn't exist
On Error Resume Next
bPasswordExists = CBool(GetSetting("VBEDisablerClass", "Values", "PasswordExists"))
'\if password exists, retrieve it from the registry
If bPasswordExists Then
sSavedPassWord = GetSetting("VBEDisablerClass", "Values", "Password")
'\compare the stored password with the entered password
Select Case True
Case IsMissing(Password)
sRet = InputBox("Enter the password to enable the VBE. ", "Enabling the VBE. ")
If StrPtr(sRet) = 0 Then
GoTo Cancelled
ElseIf UCase(sRet) <> UCase(sSavedPassWord) Then
GoTo WrongPassword
End If
Case UCase(Password) <> UCase(sSavedPassWord)
GoTo WrongPassword
Case UCase(Password) = UCase(sSavedPassWord)
GoTo EnableVBENow
End Select
End If
EnableVBENow:
Call EnableVBE
Exit Sub
WrongPassword:
MsgBox "Wrong password. ", vbExclamation
Cancelled:
End Sub
Private Sub DisableVBE()
Dim lBtnHwnd As Long
Dim lVBEhwnd As Long
Const VBE_Class = "wndclass_desked_gsk"
'\create an invisible dummy window to parent the VBE window
'\this is so the VBE remains hidden and won't be activated !
lBtnHwnd = CreateWindowEx(0, "BUTTON", vbNullString, 0, _
0, 0, 0, 0, 0, 0, 0, 0)
'\save all these variables in the registry for later use.
'\saving the variables in the registry instead of saving
'\them in public variables is necessary because all variables
'\go out of scope when trying to activate the VBE or
'\when entering Design Mode by the user!!
lVBEhwnd = FindWindow(VBE_Class, Application.VBE.MainWindow.Caption)
SaveSetting "VBEDisablerClass", "Values", "VBEhwnd", lVBEhwnd
SaveSetting "VBEDisablerClass", "Values", "BtnHwnd", lBtnHwnd
SetParent lVBEhwnd, lBtnHwnd
SaveSetting "VBEDisablerClass", "Values", "VBEIsDisabled", True
VBA.AppActivate Application.Caption
'\start a timer to display a message whenever the user
'\VBE tries activating the VBE.
Call StartVBEWatch
SaveSetting "VBEDisablerClass", "Values", "TimerID", lTimerID
End Sub
Private Sub EnableVBE()
'\cleanup
Call StopVBEWatch
SetParent Val(GetSetting("VBEDisablerClass", "Values", "VBEhwnd")), 0
DestroyWindow Val(GetSetting("VBEDisablerClass", "Values", "BtnHwnd"))
DeleteSetting "VBEDisablerClass"
Application.VBE.MainWindow.Visible = True
Application.VBE.MainWindow.Visible = False
End Sub
Private Sub StartVBEWatch()
lTimerID = SetTimer(0, 0, 250, AddressOf TimerCallBack)
End Sub
Private Sub StopVBEWatch()
killtimer 0, Val(GetSetting("VBEDisablerClass", "Values", "TimerID"))
End Sub
