User Account Control Message Box

Desktop Declarations

First, we create a module with API declarations related to desktop creation and desktop switching.

Private Const DESKTOP_SECURE As Long = 131527
Private Const DESKTOP_SWITCHDESKTOP As Long = 256
Private Const SND_ASYNC As Long = 1
Private Const SND_NOSTOP As Long = 16
Private Const SND_PURGE As Long = 64
Private Const SND_FILENAME As Long = 131072
Private Const SPI_SETDESKWALLPAPER As Long = 20
Private Const SPIF_UPDATEINIFILE As Long = 1
Private Const SPIF_SENDWININICHANGE As Long = 2
Private Const DESKTOP_LOGON As String = "Winlogon"
Private Const DESKTOP_WINSTATION0 As String = "WinSta0"
Private Const DESKTOP_DEFAULT As String = "Default"
Private Type SECURITY_ATTRIBUTES nLength As Long _
   lpSecurityDescriptor As Long _
   bInheritHandle As Long
End Type

Private Declare Function apiCloseDesktop Lib "user32" Alias _
   "CloseDesktop" (ByVal hDesktop As Long) As Long
Private Declare Function apiCreateDesktop Lib "user32" Alias _
   "CreateDesktopA" (ByVal lDesktop As String, ByVal lDevice _
   As Long, ByVal devmode As Long, ByVal dwFlags As Long, ByVal _
   desiredAccess As Long, ByRef secAttribute As _
   SECURITY_ATTRIBUTES) As Long
Private Declare Function apiGetCurrentThreadId Lib "kernel32" _
   Alias "GetCurrentThreadId" () As Long
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" _
   (ByVal hWnd As Long) As Long
Private Declare Function apiGetProcessWindowStation Lib "user32" _
   Alias "GetProcessWindowStation" () As Long
Private Declare Function apiGetSystemDirectory Lib "kernel32" _
   Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
   ByVal nSize As Long) As Long
Private Declare Function apiGetThreadDesktop Lib "user32" _
   Alias "GetThreadDesktop" (ByVal dwThread As Long) As Long
Private Declare Function apiGetWindowDC Lib "user32" _
   Alias "GetWindowDC" (ByVal hWnd As Long) As Long
Private Declare Function apiOpenInputDesktop Lib "user32" _
   Alias "OpenInputDesktop" (ByVal dwFlags As Long, _
   ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) _
   As Long
Private Declare Function apiPaintDesktop Lib "user32" Alias _
   "PaintDesktop" (ByVal hDC As Long) As Long
Private Declare Function apiPlaySound Lib "winmm" Alias _
   "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, _
   ByVal dwFlags As Long) As Long
Private Declare Function apiSetThreadDesktop Lib "user32" Alias _
   "SetThreadDesktop" (ByVal hDesktop As Long) As Long
Private Declare Function apiSwitchDesktop Lib "user32" Alias _
   "SwitchDesktop" (ByVal hDesktop As Long) As Long
Private Declare Function apiSystemParametersInfo Lib "user32" _
   Alias "SystemParametersInfoA" (ByVal uAction As Long, _
   ByVal uParam As Long, ByVal lParam As String, _
   ByVal fuWinIni As Long) As Long
Private Declare Function apiWaitForSingleObject Lib "kernel32" _
   Alias "WaitForSingleObject" (ByVal hHandle As Long, _
   ByVal dwMilliseconds As Long) As Long
Private oldDskThread As Long
Private oldDskInput As Long
Private hwnDsk As Long

Primary Functions

Next, we wrap up the primary APIs into convenient functions.

Public Function CreateDesktop(ByVal sDesktopName As String) _
      As Long
   On Error Resume
   Next
   Dim sa As SECURITY_ATTRIBUTES hwnDsk = _
      apiCreateDesktop(sDesktopName, ByVal 0, ByVal 0, 0, _
      DESKTOP_SECURE, sa)
   If hwnDsk = 0
      Then CreateDesktop = 0: Exit Function
   CreateDesktop = hwnDsk
End Function
Public Function SwitchToDeskTop() As Long
   On Error Resume
   Next
   Dim st As Long Dim sd As Long st = apiSetThreadDesktop(hwnDsk) _
      sd = apiSwitchDesktop(hwnDsk) If sd <> 0 Then _
      SwitchToDeskTop = 1
End Function
Public Sub CloseDeskTop()
   On Error Resume
   Next
   apiCloseDesktop (hwnDsk)
End Sub

Secure Desktop Prompt Message

Finally, we create a function that ties it all together. This function prompts the actual user at the keyboard/mouse with a question to authorize or deny privileges. Because applications are currently suspended on the default desktop, we can be sure that the user has clicked “Yes” to the question displayed on the Message Box.

Public Function PromptMessageUAC(ByVal message As String, _
      ByVal title As String, Optional ByVal timeout As Long) _
      As MB_RESULT
   On Error Resume
   Next
   DoEvents

   Dim dskname As String
   Dim rn As Long Randomize rn = Rnd * (2147483647 - 1) + 1 _
      dskname = CStr(rn) oldDskThread = apiGetThreadDesktop _
      (apiGetCurrentThreadId) oldDskInput = _
      apiOpenInputDesktop(0, False, DESKTOP_SWITCHDESKTOP)
   If CreateDesktop(dskname) = 0
      Then Exit Function
   SwitchToDeskTop PromptMessageUAC = MessageBoxShow(message, _
      title, MB_YES_NO_SECURE, 20000, 0) CloseDeskTop _
      apiSetThreadDesktop (oldDskThread) apiSwitchDesktop _
      (oldDskInput)
   DoEvents
End Function

Message Box API

In a separate module, we declare the API and constants for a Message Box with optional timeout, similar to that of the UAC dialog timeout.

Private Const MB_OK As Long = &H0;
Private Const MB_OKCANCEL As Long = &H1;
Private Const MB_ABORTRETRYIGNORE As Long = &H2;
Private Const MB_YESNOCANCEL As Long = &H3;
Private Const MB_YESNO As Long = &H4;
Private Const MB_RETRYCANCEL As Long = &H5;
Private Const MB_MAX_TIMEOUT As Long = &HFFFFFFFF;
Private Const MB_ICONERROR As Long = &H10;
Private Const MB_ICONQUESTION As Long = &H20;
Private Const MB_ICONWARNING As Long = &H30;
Private Const MB_ICONINFORMATION As Long = &H40;
Private Const MB_SERVICE_NOTIFICATION As Long = &H200000;

Public Const MB_YES_NO_SECURE As Long = MB_YESNO Or _
   MB_ICONQUESTION Or MB_SERVICE_NOTIFICATION

Public Enum MB_RESULT IOK = 1 ICANCEL = 2 IABORT = 3 IRETRY = 4 _
   IIGNORE = 5 IYES = 6 INO = 7 ITRYAGAIN = 10 ICONTINUE = 11
End Enum

Private Declare Function apiMessageBoxTimeOut Lib "user32" _
   Alias "MessageBoxTimeoutA" (ByVal prmlngWindowHandle As Long, _
   ByVal prmstrMessage As String, ByVal prmstrCaption As String, _
   ByVal prmlngType As Long, ByVal prmwLanguage As Integer, _
   ByVal prmdwMiliseconds As Long) As Long

Public Function MessageBoxShow(ByVal message As String, _
   ByVal Caption As String, ByVal flags As Long, _
   ByVal TimeOutMilliseconds As Long, ByVal hWnd As Long) _
   As MB_RESULT
   On Error GoTo poop MessageBoxShow = apiMessageBoxTimeOut(hWnd, _
      message, Caption, flags, 0, TimeOutMilliseconds)
   Exit Function poop: MessageBoxShow = -1
End Function

Usage

To use the main function, you would simply set the parameters of the function and read its return value. The following example sets the timeout to 20 seconds (i.e., 20000 milliseconds):

Private Sub Command1_Click() Dim o As MB_RESULT o = _
      PromptMessageUAC("Are you sure?", "Secure message _
      transaction", 20000)
   If o = MB_RESULT.IYES
      Then MsgBox "User is sure"
   ElseIf o = MB_RESULT.INO
      Then MsgBox "user is unsure"
   ElseIf o = 32000 Then MsgBox "User did not decide. _
      Message box has timed out"
   ElseIf IsNumeric(o) = False
      Then MsgBox o
   End If
End Sub

More by Author

Get the Free Newsletter!

Subscribe to Developer Insider for top news, trends & analysis

Must Read