' This script will launch the PaperCut pc-client-local-cache.exe client during
' login for members of the following groups:
' - All-Students
' - All-Affiliate-Students
' - All-Staff
' - All-Affiliate-Staff
' - All-Affiliate-Visitors
' - All-Temporary-Accounts
' - All-IT-Admins
'
' The script will not launch the PaperCut client during login for members of the
' following groups:
' - Domain Admins (unless they are in the All-IT-Admins group)
' - All-Deny-Printing
'
' Use the inclusion and exclusion arrays to manage the launching of the client
' outside of these default groups.
'
' It launches...
' - normally for Students, and will open in the top right hand corner by default
' - minimized to the taskbar for Staff
' - minimized to the taskbar for Visitors
' - minimized to the taskbar for Temporary Accounts
' - minimized to the taskbar for IT Admin Accounts
' - minimized to the taskbar for any user accounts listed in the arrIncludeUsers
'   array.
' - minimized to the taskbar for any user groups listed in the arrIncludeUserGroups
'   array.
'
' The --minimized option tells the client to start minimized. On windows the
' client will be minimized to the task tray.
'
' The --cache <cache directory> option can be used to specify a location of the
' globally writable cache directory on the system's local hard drive. The cache
' is used to minimize network traffic on future launches. The default location is
' C:\Cache. Standard users will require WRITE and READ access to this directory. 

' The User Client configuration options are documented here:
' http://www.papercut.com/products/ng/manual/apdx-tools-user-client.html
'
' The PaperCut documentation suggests that executing the client during the login
' process may actually result in it being terminated before or shortly after login,
' especially if the "Run logon scripts synchronously" group policy setting is
' enabled. So instead we write a value to the HKEY_CURRENT_USER "Run" key that will
' execute the client after login as expected.
'
' Release 1.6
' Written by Dave Rutherford and Jeremy@jhouseconsulting.com on 6th February 2012.
'------------------------------------------------------------------------------
'			History Section
'------------------------------------------------------------------------------
'Date		|Changed By	|Comments
'------------------------------------------------------------------------------
'06/02/2012	J Saunders	Added functions to test for group membership
'07/02/2012	J Saunders	Added function to test running process in current
'				session.
'09/02/2012	D Rutherford	Changed from running the .exe to writing the .exe
'				path to the Run key in HKCU.
'16/02/2012	J Saunders	Added an array of users that don't fit into the
'				default groups.
'				Added a function for checking the array members.
'10/09/2012	J Saunders	Enhanced the code so that it flows better.
'                               Added some "include" and "exclude" arrays to make
'                               the script far more flexible.
'---------- End History Section -----------------------------------------------

Option Explicit

Dim objShell, objFSO, strCommand, strPath, strEXE, strParameters, objNetwork
Dim strComputerName, strComputerDN, strUser, objSysInfo, strUserDN, strGroupTokens
Dim strGroup, strKey, strValue, arrIncludeUsers, arrIncludeUserGroups
Dim arrExcludeUserGroups, arrExcludeUsers, arrExcludeComputerGroups
Dim arrExcludeComputers, blnDeleteValue, blnDebug, blnLaunchWithoutParameters
Dim blnLaunchWithParameters

'******************* Variables to set *************************

strPath = "\\mydomain.com\data\moe\AppSource\PaperCutClient\client\win\"
strEXE = "pc-client-local-cache.exe"
strCommand = strPath & strEXE
strParameters = " --minimized"

' Value placed in the Run key
strValue = "PaperCutClient"

' This is an array of individual user accounts that don't fit into the default
' group framework, but should still execute the client at login, minimized to
' the taskbar.
arrIncludeUsers = Array("")

' This is an array of user groups that don't fit into the default framework, but
' should still execute the client at login, minimized to the taskbar.
arrIncludeUserGroups = Array("")

' This is an array of user groups that should not launch the PaperCut client
' when the user logs in.
arrExcludeUserGroups = Array("")

' This is an array of users that should not launch the PaperCut client when
' they log in.
arrExcludeUsers = Array("")

' This is an array of computers groups that should not launch the PaperCut client
' when any users log in.
arrExcludeComputerGroups = Array("")

' This is an array of computers that should not launch the PaperCut client when
' any users log in.
arrExcludeComputers = Array("")

blnDebug = False

'**************************************************************

If isProcessRunning(strEXE) Then
  wscript.quit(0)
ENd If

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(strCommand) Then

' Get current user and computer information
  set objNetwork = createobject("wscript.network")
  strComputerName = objNetwork.ComputerName
  strUser = objNetwork.Username
  Set objSysInfo = CreateObject("ADSystemInfo")
  strUserDN = objSysInfo.UserName
  strComputerDN = objSysInfo.ComputerName

' Get tokens of member groups
  strGroupTokens = GetTokenGroups(strUserDN)  

  strKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Run"

'************** Process the default groups ********************

  If TokenListFindSid(strGroupTokens, GetSidByID("Domain Admins")) Then
    blnDeleteValue = True
    blnLaunchWithoutParameters = False
    blnLaunchWithParameters = False
  End If

  If TokenListFindSid(strGroupTokens, GetSidByID("All-Students")) OR _
     TokenListFindSid(strGroupTokens, GetSidByID("All-Affiliate-Students")) Then
    blnDeleteValue = False
    blnLaunchWithoutParameters = True
    blnLaunchWithParameters = False
  End If

  If TokenListFindSid(strGroupTokens, GetSidByID("All-Affiliate-Visitors")) OR _
     TokenListFindSid(strGroupTokens, GetSidByID("All-Temporary-Accounts")) Then
    blnDeleteValue = False
    blnLaunchWithoutParameters = False
    blnLaunchWithParameters = True
  End If

  If TokenListFindSid(strGroupTokens, GetSidByID("All-Staff")) OR _
     TokenListFindSid(strGroupTokens, GetSidByID("All-Affiliate-Staff")) Then
    blnDeleteValue = False
    blnLaunchWithoutParameters = False
    blnLaunchWithParameters = True
  End If

  If TokenListFindSid(strGroupTokens, GetSidByID("All-Kiosk-Accounts")) Then
    blnDeleteValue = True
    blnLaunchWithoutParameters = False
    blnLaunchWithParameters = False
  End If

  If TokenListFindSid(strGroupTokens, GetSidByID("All-Deny-Printing")) Then
    blnDeleteValue = True
    blnLaunchWithoutParameters = False
    blnLaunchWithParameters = False
  End If

  If TokenListFindSid(strGroupTokens, GetSidByID("All-IT-Admins")) Then
    blnDeleteValue = False
    blnLaunchWithoutParameters = False
    blnLaunchWithParameters = True
  End If

'************* Process the inclusion arrays *******************

  If IsArray(arrIncludeUserGroups) Then
    If Trim(arrIncludeUserGroups(0)) <> "" Then
      For Each strGroup in arrIncludeUserGroups
        If TokenListFindSid(strGroupTokens, GetSidByID(strGroup)) Then
          blnDeleteValue = False
          blnLaunchWithoutParameters = False
          blnLaunchWithParameters = True
        End If
      Next
    End If
  End If

  If IsArray(arrIncludeUsers) Then
    If InArray(strUser,arrIncludeUsers) Then
      blnDeleteValue = False
      blnLaunchWithoutParameters = False
      blnLaunchWithParameters = True
    End If
  End If

'************* Process the exclusion arrays *******************

  If IsArray(arrExcludeUserGroups) Then
    If Trim(arrExcludeUserGroups(0)) <> "" Then
      For Each strGroup in arrExcludeUserGroups
        If TokenListFindSid(strGroupTokens, GetSidByID(strGroup)) Then
          blnDeleteValue = True
          blnLaunchWithoutParameters = False
          blnLaunchWithParameters = False
        End If
      Next
    End If
  End If

  If IsArray(arrExcludeUsers) Then
    If InArray(strUser,arrExcludeUsers) Then
      blnDeleteValue = True
      blnLaunchWithoutParameters = False
      blnLaunchWithParameters = False
    End If
  End If

  If IsArray(arrExcludeComputerGroups) Then
    If Trim(arrExcludeComputerGroups(0)) <> "" Then
      For Each strGroup in arrExcludeComputerGroups
        If IsMemberOf(strComputerDN, GetDNByID(Trim(strGroup))) Then
          blnDeleteValue = True
          blnLaunchWithoutParameters = False
          blnLaunchWithParameters = False
        End If
      Next
    End If
  End If

  If IsArray(arrExcludeComputers) Then
    If InArray(strComputerName,arrExcludeComputers) Then
      blnDeleteValue = True
      blnLaunchWithoutParameters = False
      blnLaunchWithParameters = False
    End If
  End If

'*********** Set or delete the registry value *****************

  If blnLaunchWithoutParameters Then
    'Write the exe path to the HKCU\...\Run key
    objShell.RegWrite strKey & "\" & strValue, chr(34) & strCommand & chr(34)
    'objShell.Run chr(34) & strCommand & chr(34),0,False
    If blnDebug Then
      wscript.echo chr(34) & strCommand & chr(34)
    End If
  End If

  If blnLaunchWithParameters Then
    'Write the exe path to the HKCU\...\Run key
    objShell.RegWrite strKey & "\" & strValue, chr(34) & strCommand & chr(34) & strParameters
    'objShell.Run chr(34) & strCommand & chr(34) & strParameters,0,False
    If blnDebug Then
      wscript.echo chr(34) & strCommand & chr(34) & strParameters
    End If
  End If

  If blnDeleteValue Then
    If RegValueExists(strKey & "\" & strValue) Then
      objShell.RegDelete strKey & "\" & strValue
      If blnDebug Then
        wscript.echo "Deleting the " & strValue & " value."
      End If
    End If
  End If

'**************************************************************

  Set objNetwork = Nothing
  Set objSysInfo = Nothing

Else

  If blnDebug Then
    wscript.echo "The program does not exist"
  End If

End If

Set objShell = Nothing
Set objFSO = Nothing

wscript.quit(0)

' Function to check if a process is running in the current session
Function isProcessRunning(byval strProcessName)

  Dim strComputer, objWMIService, colProcesses, objProcess
  Dim ProcessId, colLogonSessions, LogonSession, strLogonID

  strComputer = "."

  Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
  Set colProcesses = objWMIService.ExecQuery( _
    "Select * from Win32_Process " _
    & "Where Name = '" & strProcessName & "'")

  For Each objProcess in colProcesses
    ProcessId = objProcess.ProcessId
    Set colLogonSessions = objWMIService.ExecQuery _
       ("Associators of {Win32_Process='" _
       & ProcessId & "'} Where" _
       & " Resultclass = Win32_LogonSession" _
       & " Assocclass = Win32_SessionProcess", "WQL", 48)
    isProcessRunning = false
    For Each LogonSession in colLogonSessions
      strLogonID = LogonSession.LogonId
      isProcessRunning = true
    Next
  Next

  Set objWMIService = Nothing
  Set colProcesses = Nothing
  Set colLogonSessions = Nothing

End Function

Function InArray(item,myarray)
  Dim i
  For i=0 To UBound(myarray) Step 1
    If strcomp(item,myarray(i),1) = 0 Then
      InArray=True
      Exit Function
    End If
  Next
  InArray=False
End Function

Function RegValueExists(sRegValue)
' Returns True or False based of the existence of a registry value.
  Dim oShell, RegReadReturn 
  Set oShell = CreateObject("WScript.Shell") 
  RegValueExists = True  ' init value 
  On Error Resume Next 
  RegReadReturn = oShell.RegRead(sRegValue) 
  If Err.Number <> 0 Then 
    RegValueExists = False 
  End if 
  On Error Goto 0 
  Set oShell = Nothing
End Function 

' =====================================
' Token query routines
' =====================================
 
' Is DN a member of security group?
' Usage: <bool> = IsMemberOf(<DN of object>, <DN of group>)
Function IsMemberOf(dnObject, dnGroup)
   IsMemberOf = TokenListFindSid(GetTokenGroups(dnObject), GetSidByDN(dnGroup))
End Function
 
' Gets tokenGroups attribute from the provided DN
' Usage: <Array of tokens> = GetTokenGroups(<DN of object>)
Function GetTokenGroups(dnObject)
   Dim adsObject
 
   ' Setup query of tokenGroup SIDs from dnObject
   Set adsObject = GetObject(LdapUri(dnObject))
   adsObject.GetInfoEx Array("tokenGroups"), 0
   GetTokenGroups = adsObject.GetEx("tokenGroups")
End Function
 
' Checks if the SID of a DN is found in an array of tokens.
' Usage: <bool> = TokenListFindSid(<Array of tokens>, <Object SID Byte()>)
Function TokenListFindSid(arrTokens, objectSid)
   Dim nSidSize, vSidHex, e
   TokenListFindSid = False
 
   If TypeName(objectSid) = "Byte()" Then
      ' Scan token array for object SID
      nSidSize = UBound(objectSid)
      vSidHex = ByteArrToHexString(objectSid)
      For Each e in arrTokens
         If UBound(e) = nSidSize Then
            If ByteArrToHexString(e) = vSidHex Then
               TokenListFindSid = True
               Exit For
            End If
         End If
      Next
   End If
End Function
 
' Encode Byte() to hex string
Function ByteArrToHexString(bytes)
   Dim i
   ByteArrToHexString = ""
   For i = 1 to Lenb(bytes)
      ByteArrToHexString = ByteArrToHexString & Right("0" & Hex(Ascb(Midb(bytes, i, 1))), 2)
   Next
End Function
 
' Format a DN into a valid LDAP URI
Function LdapUri(DN)
   LdapUri = "LDAP://" & Replace(DN, "/", "\/")
End Function
 
 
' =====================================
' Query helper routines
' =====================================
 
' Get object's SID by DN
' Usage: <SID Byte()> = GetSidByDN(<DN>)
Function GetSidByDN(objectDN)
   On Error Resume Next
   GetSidByDN = GetObject(LdapUri(objectDN)).Get("objectSid")
   On Error GoTo 0
End Function
 
' Get object's SID by ID
' Usage: <SID Byte()> = GetSidByID(<Object ID>)
Function GetSidByID(ID)
   Dim rs
   Set rs = QueryLDAP(GetRootDN, "(sAMAccountName=" & ID & ")", "objectSid", "subtree")
   If Not rs.EOF Then GetSidByID = rs("objectSid")
   rs.Close
   Set rs = Nothing
End Function
 
' Get DN by sAMAccountName
' Usage: <DN> = GetDNByID(<User or Group ID>)
Function GetDNByID(ID)
   Dim rs
   Set rs = QueryLDAP(GetRootDN, "(sAMAccountName=" & ID & ")", "distinguishedName", "subtree")
   If Not rs.EOF Then GetDNByID = rs("distinguishedName")
   rs.Close
   Set rs = Nothing
End Function
 
' Get sAMAccountName by object's SID
' Usage: <sAMAccountName> = GetIDBySid(<SID Byte()>)
Function GetIDBySid(objectSid)
   If TypeName(objectSid) = "Byte()" Then
      GetIDBySid = GetObject("LDAP://<SID=" & ByteArrToHexString(objectSid) & ">").Get("sAMAccountName")
   End If
End Function
 
 
' =====================================
' LDAP routines
' =====================================
 
' Get Root DN of logged in domain (e.g. DC=yourdomain,DC=com)
' Usage: <DN> = GetRootDN
Function GetRootDN
   GetRootDN = GetObject("LDAP://RootDSE").Get("defaultNamingContext")
End Function
 
' Get/create singleton LDAP ADODB connection object
' Usage: <Connection object ref> = LDAPConnection
'    or: LDAPConnection.<property or method>
Dim l_LDAPConnection
Function LDAPConnection
   If IsEmpty(l_LDAPConnection) Then
      Set l_LDAPConnection = CreateObject("ADODB.Connection")
      l_LDAPConnection.Provider = "ADSDSOObject"
      l_LDAPConnection.Open "ADs Provider"
   End If
   Set LDAPConnection = l_LDAPConnection
End Function
 
' Close the LDAPConnection singleton object
' Usage: CloseLDAPConnection
Sub CloseLDAPConnection
   If IsObject(l_LDAPConnection) Then
      If l_LDAPConnection.State = 1 Then l_LDAPConnection.Close
   End If
   l_LDAPConnection = Empty
End Sub
 
' Query LDAP helper, return RecordSet
' Usage: <RecordSet object ref> = QueryLDAP(<DN>, <LDAP Filter>, <Attributes CSV>, <Scope>
' Scope can be: "subtree", "onelevel", or "base"
' Be sure to close the RecordSet object when done with it
Function QueryLDAP(DN, Filter, AttributeList, Scope)
   Set QueryLDAP = LDAPConnection.Execute("<" & LdapUri(DN) & ">;" & Filter & ";" & AttributeList & ";" & Scope)
End Function