[THIN] Fwd: Mandatory > Roaming Spoofing Script

From: James Scanlon <scanjam@xxxxxxxxxxx>
To: thin@xxxxxxxxxxxxx
Date: Thu, 20 Jan 2011 15:09:11 +0000

This script fools the OS into running like a roaming user even though the user points to mandatory profile. Worked for our certificate import issues. (sourced originally from appsense)

.

Need the registry permissions added as listed in the script, needs to run for the user everytime if they are going to be importing certificates regularly..

worked for us!

woot

James

' ***************************************************************************** 
' Notes: Security certificates are not saved to the user's profile if the OS 
detects a mandatory profile.
' This script alters a binary bit to spoof the OS so that certificates can be 
saved.
' ***************************************************************************** 

' ***************************************************************************** 
' Pre-requirements:
'
' Users need to be give the 'Special Permissions' of 'Delete' & 'Set Value' to 
'  
' HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList. 
' 
' ***************************************************************************** 
' ***************************************************************************** 
' 
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, 
' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED 
' WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. 
' 
' ***************************************************************************** 

Option Explicit

Dim strUserSid, oShell, oWMI, colItems, oItem, strState, oWMIReg, i, intLen
Dim oWshNetwork
Const HKLM = &H80000002

' ***************************************************************************** 
' Gets the username of the logged on user.
Set oShell = WScript.CreateObject("WScript.Shell")
Set oWshNetwork = CreateObject("WScript.Network") 

' This section uses WMI to get the users sid.
Set oWMI = GetObject("winmgmts:\\.\root\CIMV2") _ 
.Get("Win32_UserAccount.Domain='" & oWshNetwork.UserDomain & "'" _ 
& ",Name='" & oWshNetwork.UserName & "'") 

strUserSid = oWMI.SID

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

' This section gets the decimal value of the State DWORD Value.
Set oWMIReg = GetObject("winmgmts:\\.\root\default:StdRegProv") 

oWMIReg.GetDWORDValue HKLM, "Software\Microsoft\Windows 
NT\Currentversion\Profilelist\" & strUserSid, "State", strState

'Calls DecToBin Function to convert the decimal value to a binary value.
strState = DecToBin(strState)

' Checks if the last bit is not equal to 0 
If Right(strState, 1) <> 0 Then

' This changes the last bit to 0. Mandatory profiles are spoofed to roaming.
      intLen = Len(strState)-1
      strState = Left(strState,intLen) 
      strState = strState & 0
      
'Calls DecToBin Function to convert the decimal value to a binary value
      strState = BinToDec(strState)


' This writes the new State DWORD Value.
      oWMIReg.SetDWORDValue HKLM, "Software\Microsoft\Windows 
NT\Currentversion\Profilelist\" & strUserSid, "State", strState

End If 

WScript.Quit

'End of VBScript

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

'This function converts a decimal value to a string containing a binary 
respresentation of the value. It is limited to a maximum value of 65536 (1111 
1111 1111 1111 in binary). 
Function DecToBin(intDec)
  Dim strResult
  Dim intValue
  Dim intExp

' This section backs up the origional state DWORD Value.
oWMIReg.SetDWORDValue HKLM, "Software\Microsoft\Windows 
NT\Currentversion\Profilelist\" & strUserSid, "OldState", intDec

  strResult = ""

  intValue = intDEC
  intExp = 65536
  while intExp >= 1
    if intValue >= intExp then
      intValue = intValue - intExp
      strResult = strResult & "1"
    else
      strResult = strResult & "0"
    end if
    intExp = intExp / 2
  wend

  DecToBin = strResult
End Function

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

' This function converts a binary value represented by a string of ones and 
zeros into a decimal value. 
Function BinToDec(strBin)
  Dim lngResult
  Dim intIndex
  Dim strDigit

  lngResult = 0
  for intIndex = len(strBin) to 1 step -1
    strDigit = mid(strBin, intIndex, 1)
    select case strDigit
      case "0"
        ' do nothing
      case "1"
        lngResult = lngResult + (2 ^ (len(strBin)-intIndex))
      case else
        ' invalid binary digit, so the whole thing is invalid
        lngResult = 0
        intIndex = 0 ' stop the loop
    end select
  next

  BinToDec = lngResult
End Function

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

[THIN] Fwd: Mandatory > Roaming Spoofing Script

Other related posts: