'********************
' Copyright (c) 2008
'         by
'   Kenneth Sweet
'********************
On Error Resume Next

'Message text to be displayed to the user
MsgText = "This Message will be displayed to the user." & vbCrLf & "Please click on the OK button."
'Title of message window
MsgTitle = "Message Window Title"

'How long to display the message window in number of seconds
'Setting MsgDelay to 0 will display the message till the user responds / clicks on a button
MsgDelay = 300

'How long to show message before updating the countdown time in the message displayed to the user
'if MsgDelay is set to 0 then CDDelay must also be set to 0
'if MsgDelay is set to ano other value CDDelay must either be equal to MsgDelay so that the countdown time does not update
'  or less than MsgDelay so the countdown time updates on a regular basis
'if MsgDelay if greater than 0 then CDDelay can not be set to 0
CDDelay = 10

'Settings for how message window looks. Add values to get total
'Select one value from each group. Buttons, Icon, Default Button, Msg Window Modal and add them togeather
'MsgType
'Buttons
Const vbOKOnly = 0 'Display OK button only.
Const vbOKCancel = 1 'Display OK and Cancel buttons.
Const vbAbortRetryIgnore = 2 'Display Abort, Retry, and Ignore buttons.
Const vbYesNoCancel = 3 'Display Yes, No, and Cancel buttons.
Const vbYesNo = 4 'Display Yes and No buttons.
Const vbRetryCancel = 5 'Display Retry and Cancel buttons.
'Icon
Const vbCritical = 16 'Display Critical Message icon.
Const vbQuestion = 32 'Display Warning Query icon.
Const vbExclamation = 48 'Display Warning Message icon.
Const vbInformation = 64 'Display Information Message icon.
'Default Button
Const vbDefaultButton1 = 0 'First button is the default.
Const vbDefaultButton2 = 256 'Second button is the default.
Const vbDefaultButton3 = 512 'Third button is the default.
Const vbDefaultButton4 = 768 'Fourth button is the default.
'Msg Window Modal
Const vbApplicationModal = 0 'Application modal. The user must respond to the message box before continuing work in the current application.
Const vbSystemModal = 4096 'System modal. On Win16 systems, all applications are suspended until the user responds to the message box. On Win32 systems, this constant provides an application modal message box that always remains on top of any other programs you may have running.
'Use vbOKOnly (buttons) when calling ShowUserMsgProcess
MsgType = vbOKOnly + vbExclamation + vbDefaultButton1 + vbSystemModal

'used in ShowUserMsgProcess only
'Name of process to look for
ProName = "cmd.exe"
'Kill the proccess after count down or if user clicks OK
KillPro = True 'True or False


' *****************************************************************************
' * Start Sample Code Un-Rem one of the 2 lines below
' *****************************************************************************
'If a user is logged on show them a message
TempReturn = ShowUserMsg(MsgText, MsgTitle, MsgDelay, CDDelay, MsgType)

'If a user is logged on show them a message if a process is running
'TempReturn = ShowUserMsgProcess(MsgText, MsgTitle, MsgDelay, CDDelay, MsgType, ProName, KillPro)

'Exit script with Returned value
WScript.Quit TempReturn
' *****************************************************************************
' * End Sample Code
' *****************************************************************************

' *****************************************************************************
' * Display a mesg to user is anyone is logged on
' *****************************************************************************
'Return Values
'0 No user was logged on
'vbOK 1 OK button was clicked.
'vbCancel 2 Cancel button was clicked.
'vbAbort 3 Abort button was clicked.
'vbRetry 4 Retry button was clicked.
'vbIgnore 5 Ignore button was clicked.
'vbYes 6 Yes button was clicked.
'vbNo 7 No button was clicked.
'Custom 8 Timed out, automaticly closed
'Custom 9 Proccess failed to terminate

Function ShowUserMsgProcess(ByVal MsgText, ByVal MsgTitle, ByVal MsgDelay, ByVal CDDelay, ByVal MsgType, ByVal ProName, ByVal KillPro)
  'Will show a logged on user a message if a user is currently logged on and a specific proccess is running
  On Error Resume Next
  TempReturn = 0
  If MsgDelay > 0 And CDDelay = 0 Then
    CDDelay = 10
  ElseIf MsgDelay = 0 Then
    CDDelay = 0
  End If
  Set MsgShell = WScript.CreateObject("WScript.Shell")
  Do
    ProRunning = FindProcess(".", ProName)
    If ProRunning Then
      If UserLoggedOn(".", UserName) Then
        Do
          If MsgDelay < CDDelay Then
            CDDelay = MsgDelay
          End If
          TempReturn = MsgShell.Popup(MsgDelayText(MsgDelay, MsgText), CDDelay, MsgTitle, MsgType)
          MsgDelay = MsgDelay - CDDelay
        Loop While TempReturn = -1 And MsgDelay > 0
        If KillPro Then
          If Not(KillProcess(CompName, ProName)) Then
            TempReturn = 9
          End If
        Else
          TempReturn = 9
        End If
      Else
        If KillPro Then
          If Not (KillProcess(CompName, ProName)) Then
            TempReturn = 9
          End If
        Else
          TempReturn = 9
        End If
      End If
    End If
  Loop While ProRunning And TempReturn <> 9 And MsgDelay > 0
  If TempReturn = -1 Then
    TempReturn = 8
  End If
  ShowUserMsgProcess = TempReturn
End Function

Function ShowUserMsg(ByVal MsgText, ByVal MsgTitle, ByVal MsgDelay, ByVal CDDelay, ByVal MsgType)
  'Will show a logged on user a message if a user is currently logged on, displayed message will have a timmer that will count down
  On Error Resume Next
  TempReturn = 0
  If MsgDelay > 0 And CDDelay = 0 Then
    CDDelay = 10
  ElseIf MsgDelay = 0 Then
    CDDelay = 0
  End If
  Set MsgShell = WScript.CreateObject("WScript.Shell")
  If UserLoggedOn(".", UserName) Then
    Do
      If MsgDelay < CDDelay Then
        CDDelay = MsgDelay
      End If
      TempReturn = MsgShell.Popup(MsgDelayText(MsgDelay, MsgText), CDDelay, MsgTitle, MsgType)
      MsgDelay = MsgDelay - CDDelay
    Loop While TempReturn = -1 And MsgDelay > 0
  End If
  If TempReturn = -1 Then
    TempReturn = 8
  End If 
  ShowUserMsg = TempReturn
End Function

Function MsgDelayText(ByVal MsgDelay, ByVal MsgText)
  'Returns Message text with remaining time added on to the end
  TempReturn = MsgText
  If MsgDelay > 0 Then
    MsgHour = Int(MsgDelay / 3600)
    MsgDelay = MsgDelay Mod 3600
    MsgMin = Int(MsgDelay / 60)
    MsgSec = MsgDelay Mod 60
    TempReturn = TempReturn & vbCrLf & vbCrLf & "This message will automaticly close in " & RetTime(MsgHour, MsgMin, MsgSec)
  End If
  MsgDelayText = TempReturn
End Function

Function RetTime(ByVal TempHour, ByVal TempMin, ByVal TempSec)
  'Returns imputed time as a string Hours, Minutes, and Seconds - 00:00:00
  RetTime = Num2Str(TempHour) & ":" & Num2Str(TempMin) & ":" & Num2Str(TempSec)
End Function

Function Num2Str(ByVal TempNum)
  'Returns number as a 2 character string
  Num2Str = Right("00" + CStr(TempNum), 2)
End Function

Function UserLoggedOn(ByVal CompName, ByRef UserName)
  'Return Values
  '-1 or True - A User is logged on
  '0 or False - No user was logged on
  On Error Resume Next
  TempReturn = False
  UserName = Null
  If ConnectWMI(CompName, "root\CIMV2", "", "", WMIConnection) Then
    Set ComputerInfo = WMIConnection.ExecQuery("SELECT UserName FROM Win32_ComputerSystem",, 48)
    For Each User In ComputerInfo
      If Not IsNull(User.UserName) Then
        UserName = User.UserName
        TempReturn = True
      End If
    Next
  End If
  UserLoggedOn = TempReturn
End Function

Function KillProcess(ByVal CompName, ByVal ProName)
  On Error Resume Next
  TempReturn = False
  If ConnectWMI(CompName, "root\CIMV2", "", "", WMIConnection) Then
    TempReturn = True
    'Get collection of all ProcessIDs where the name matches ProName
    Set ProcessList = WMIConnection.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & ProName & "'",, 48)
    'Loop through entire collection
    For Each TempProcess In ProcessList
      If TempProcess.Terminate() = 0 Then
        WScript.Sleep(1000)
        If FindProcess(CompName, ProName) Then
          TempReturn = TempReturn And False
        Else
          TempReturn = TempReturn And True
        End If
      Else
        TempReturn = TempReturn And False
      End If
    Next
  End If
  KillProcess = TempReturn
End Function

Function FindProcess(ByVal CompName, ByVal ProName)
  On Error Resume Next
  TempReturn = False
  If ConnectWMI(CompName, "root\CIMV2", "", "", WMIConnection) Then
    TempReturn = False
    'Get collection of all ProcessIDs where the name matches ProName
    Set ProcessList = WMIConnection.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & ProName & "'",, 48)
    'Loop through entire collection
    For Each TempProcess In ProcessList
      If LCase(TempProcess.Name) = ProName Then
        TempReturn = True
      End If
    Next
  End If
  FindProcess = TempReturn
End Function

Function ConnectWMI(ByVal CompName, ByVal NameSpace, ByVal UserName, ByVal Password, ByRef WMIConnection)
  On Error Resume Next
  Set WSNetwork = CreateObject("Wscript.Network")
  If LCase(CompName) = LCase(WSNetwork.ComputerName) Then
    UserName = ""
    Password = ""
  End If
  Set SWbemLocator = CreateObject("WbemScripting.SWbemLocator")
  If Err.number = 0 Then
    Set WMIConnection = SWbemLocator.ConnectServer(CompName, NameSpace, UserName, Password)
    If Err.number = 0 Then
      WMIConnection.Security_.impersonationlevel = 3
      ConnectWMI = True
    Else
      Err.Clear
      ConnectWMI = False
    End If
  Else
    Err.Clear
    ConnectWMI = False
  End If
End Function