'Set to True if the current OS is WinNT.
'Tested in *every* shell function's proc via
'a call to CheckString.
Public bIsWinNT As Boolean
   
'------------------------------------------------------
Public Declare Function GetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" _
   (lpVersionInformation As OSVERSIONINFO) As Long
                                     
Public Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128 
End Type
   
Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2
   
'Handles overlapped source and 
'destination blocks
Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal ByteLen As Long)
   
Public Declare Function IsTextUnicode Lib "advapi32" _
  (lpBuffer As Any, _
   ByVal cb As Long, _
   lpi As Long) As Long
                               
Public Const IS_TEXT_UNICODE_ASCII16 = &H1
Public Const IS_TEXT_UNICODE_REVERSE_ASCII16 = &H10
Public Const IS_TEXT_UNICODE_STATISTICS = &H2
Public Const IS_TEXT_UNICODE_REVERSE_STATISTICS = &H20
Public Const IS_TEXT_UNICODE_CONTROLS = &H4
Public Const IS_TEXT_UNICODE_REVERSE_CONTROLS = &H40
Public Const IS_TEXT_UNICODE_SIGNATURE = &H8
Public Const IS_TEXT_UNICODE_REVERSE_SIGNATURE = &H80
Public Const IS_TEXT_UNICODE_ILLEGAL_CHARS = &H100
Public Const IS_TEXT_UNICODE_ODD_LENGTH = &H200
Public Const IS_TEXT_UNICODE_DBCS_LEADBYTE = &H400
Public Const IS_TEXT_UNICODE_NULL_BYTES = &H1000
Public Const IS_TEXT_UNICODE_UNICODE_MASK = &HF
Public Const IS_TEXT_UNICODE_REVERSE_MASK = &HF0
Public Const IS_TEXT_UNICODE_NOT_UNICODE_MASK = &HF00
Public Const IS_TEXT_UNICODE_NOT_ASCII_MASK = &HF000


Public Function IsWinNT() As Boolean

  'Returns True if the current operating system is WinNT
   Dim osvi As OSVERSIONINFO
   osvi.dwOSVersionInfoSize = Len(osvi)
   GetVersionEx osvi
   IsWinNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT)
   
End Function


Public Function CheckString(msg As String) As String

   If bIsWinNT Then
      CheckString = StrConv(msg, vbUnicode)
   Else
      CheckString = msg
   End If
   
End Function


Public Function GetStrFromPtr(lpszStr As Long, nBytes As Integer) As String

  'Returns string before first null char 
  'encountered (if any) from a string pointer.
  'lpszStr = memory address of first byte in string
  'nBytes = number of bytes to copy.
  'StrConv used for both ANSII and Unicode strings
  'BE CAREFUL!
   ReDim ab(nBytes) As Byte   'zero-based (nBytes + 1 elements)
   CopyMemory ab(0), ByVal lpszStr, nBytes
   GetStrFromPtr = GetStrFromBuffer(StrConv(ab(), vbUnicode))
  
End Function


Public Function GetStrFromBuffer(szStr As String) As String

  'Returns string before first null char encountered (if any)
  'from either an ANSII or Unicode string buffer.
   If IsUnicodeStr(szStr) Then szStr = StrConv(szStr, vbFromUnicode)
   
   If InStr(szStr, vbNullChar) Then
      GetStrFromBuffer = Left$(szStr, InStr(szStr, vbNullChar) - 1)
   Else
      GetStrFromBuffer = szStr
   End If

End Function


Public Function IsUnicodeStr(sBuffer As String) As Boolean

  'Returns True if sBuffer evaluates to a Unicode string
   Dim dwRtnFlags As Long
   dwRtnFlags = IS_TEXT_UNICODE_UNICODE_MASK
   IsUnicodeStr = IsTextUnicode(ByVal sBuffer, Len(sBuffer), dwRtnFlags)

End Function

'------------------------------------------------------
'The "System Settings Change" message box. 
'("You must restart your computer before the new 
'settings will take effect.")
Public Declare Function SHRestartSystemMB Lib "shell32" _
   Alias "#59" _
  (ByVal hOwner As Long, _
   ByVal sExtraPrompt As String, _
   ByVal uFlags As Long) As Long

'hOwner = Message box owner, specify 0 
'for desktop (will be top-level).
'sPrompt = Specified prompt string placed 
'above the default prompt.
'uFlags = Can be the following values:

'WinNT
'Appears to use ExitWindowsEx uFlags values 
'and behave accordingly:
Public Const EWX_LOGOFF = 0
'NT:needs SE_SHUTDOWN_NAME priv (no def prompt)
Public Const EWX_SHUTDOWN = 1 
Public Const EWX_REBOOT = 2   
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF = 8 

'Win95/98  
'Any Yes selection produces the equivalent to 
'ExitWindowsEx(EWX_FORCE, 0) (?)
'(i.e. no WM_QUERYENDSESSION or WM_ENDSESSION is sent!).
'Other than is noted below, it was found that any other 
'value shuts the system down (no reboot) and includes 
'the default prompt.

'Shuts the system down (no reboot) and does not include 
'the default prompt:
Public Const shrsExitNoDefPrompt = 1

'Reboots the system and includes the 
'default prompt.
Public Const shrsRebootSystem = 2 '= EWX_REBOOT

'Rtn vals: Yes = 6 (vbYes), No = 7 (vbNo)

'The Shut Down dialog via the Start menu
Public Declare Function SHShutDownDialog Lib "shell32" _
   Alias "#60" _
  (ByVal YourGuess As Long) As Long

'The Run dialog via the Start menu
Public Declare Function SHRunDialog Lib "shell32" _
   Alias "#61" _
  (ByVal hOwner As Long, _
   ByVal Unknown1 As Long, _
   ByVal Unknown2 As Long, _
   ByVal szTitle As String, _
   ByVal szPrompt As String, _
   ByVal uFlags As Long) As Long

'hOwner = Dialog owner, specify 0 for desktop 
'(will be top-level)
'Unknown1 = ?
'Unknown2 = ?, non-zero causes gpf! strings are ok...(?)
'szTitle = Dialog title, specify vbNullString for 
'default ("Run")
'szPrompt = Dialog prompt, specify vbNullString for 
'default ("Type the name...")
   
'If uFlags is the following constant, the string from 
'last program run will not appear in the dialog's 
'combo box (that's all I found...)
Public Const shrdNoMRUString = &H2   '2nd bit is set

'If there is some way to set & rtn the command 
'line, I didn't find it...
'Always returns 0 (?)

Option Explicit

Private Sub cmdEnd_Click()

   Unload Me
   
End Sub


Private Sub Form_Load()

  'We'll need this flag to determine if
  'strings should be converted to Unicode
   bIsWinNT = IsWinNT()
   
   Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
  
  'Setup the controls
   txtRunTitle = "Run This Puppy"
   txtRunPrompt = "Enter the name of a program to run, _
                   or select a file using the Browse button:"
   
   If bIsWinNT Then
   
      txtRestartPrompt = "its your call..." & vbCrLf & vbCrLf
      
      With cboRestartOp
         .AddItem "0 - EWX_LOGOFF"
         .AddItem "1 - EWX_SHUTDOWN" 'NT needs SE_SHUTDOWN_NAME prive"
         .AddItem "2 - EWX_REBOOT"   'NT needs SE_SHUTDOWN_NAME priv"
         .AddItem "4 - EWX_FORCE"
         .AddItem "8 - EWX_POWEROFF" 'NT needs SE_SHUTDOWN_NAME priv"
         .Text = ""
      End With
   
   Else   'Win95/98
   
      txtRestartPrompt = "Warning...!" & vbCrLf & _
      "  Clicking Yes will end the windows session and close" & vbCrLf & _
      "  all programs without any prompt to save changes...!" & vbCrLf & vbCrLf
      
      With cboRestartOp
         .AddItem "1 - exit (shutdown), no def prompt"
         .AddItem "2 - restart computer"
         .Text = ""
      End With
      
   End If
   
End Sub


Private Sub cmdRestartDlg_Click()

  '----------------------------------------------------
  'Restart system message box:
  'A Yes click will end the Windows session **immediately**!
  '----------------------------------------------------

   Dim sPrompt As String
   Dim uFlag As Long
   
   If chkRestartDefaults = 0 Then
   
      sPrompt = CheckString(txtRestartPrompt)
      
   End If
   
   
   Select Case cboRestartOp.ListIndex
      Case -1: uFlag = Val(cboRestartOp.Text)
      Case 0:  uFlag = shrsExitNoDefPrompt
      Case 1:  uFlag = shrsRebootSystem
   End Select
   
   
   If SHRestartSystemMB(hWnd, sPrompt, uFlag) = vbYes Then
      MsgBox "bye-bye..."     'Never gets here...!
   End If
   
End Sub


Private Sub cmdRunDlg_Click()

  '----------------------------------------------------
  'Windows 'Run' dialog
  '----------------------------------------------------

   Dim sTitle As String
   Dim sPrompt As String
   
   If chkRunDefaults Then
      
     'sets bit 2 if checked
      Call SHRunDialog(hWnd, 0, 0, vbNullString, vbNullString, -chkRunNoMRU)    
   
   Else
   
      sTitle = CheckString(txtRunTitle)
      sPrompt = CheckString(txtRunPrompt)
      
      Call SHRunDialog(hWnd, 0, 0, sTitle, sPrompt, -chkRunNoMRU)
   
   End If
   
End Sub


Private Sub cmdShutDown_Click()

  '----------------------------------------------------
  'Shut Down Windows dialog
  '----------------------------------------------------

  Call SHShutDownDialog(0)
   
End Sub