home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / free_security / msshared / Shared_Computer_Toolkit_ENU.msi / FileInclude006 < prev    next >
Encoding:
Text (UTF-16)  |  2005-09-02  |  94.6 KB  |  1,207 lines
  1. ' ***
  2. ' *** ------------------------------------------------------------------------------
  3. ' *** Filename:        clsRestrictions.vbs
  4. ' *** ------------------------------------------------------------------------------
  5. ' *** Description:        Restriction Class
  6. ' *** ------------------------------------------------------------------------------
  7. ' *** Version:        1.0
  8. ' *** Notes:        Used by Restrict.hta and Restrict.wsf
  9. ' *** ------------------------------------------------------------------------------
  10. ' *** Copyright (C) Microsoft Corporation 2005, All Rights Reserved
  11. ' *** ------------------------------------------------------------------------------
  12. ' ***
  13.  
  14. ' ~~~ 
  15. ' ~~~ Force variables to be declared and turn off script error messages unless in DEBUG mode
  16. ' ~~~ 
  17. Option Explicit
  18. If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  19.  
  20. Class Restriction
  21.     ' ~~~ 
  22.     ' ~~~ declare variables and constants
  23.     ' ~~~ 
  24.     Dim bLogging, sUid, sTemplateXML, sUserXML,oLog
  25.     Dim sRootKeyE, sRootKeyS, bChangeLockFolder, bProfileDriveNTFS
  26.  
  27.     ' ~~~ 
  28.     ' ~~~ public properties
  29.     ' ~~~ 
  30.     
  31.     ' ***
  32.     ' *** ------------------------------------------------------------------------------
  33.     ' *** Property:    Logging
  34.     ' *** ------------------------------------------------------------------------------
  35.     ' *** Purpose:    Turns on logging, property must be set to a logging object
  36.     ' *** ------------------------------------------------------------------------------
  37.     ' ***
  38.     Public Property Get Logging
  39.         Logging = bLogging
  40.     End Property    
  41.  
  42.     Public Property Let Logging(oObject)
  43.         If VarType(oObject) = vbObject Then
  44.             bLogging = True
  45.             Set oLog = oObject
  46.         End If
  47.     End Property
  48.  
  49.     ' ***
  50.     ' *** ------------------------------------------------------------------------------
  51.     ' *** Property:    User
  52.     ' *** ------------------------------------------------------------------------------
  53.     ' *** Purpose:    Username of account modify
  54.     ' *** ------------------------------------------------------------------------------
  55.     ' ***
  56.     Public Property Get User
  57.         User = sUid
  58.     End Property    
  59.  
  60.     Public Property Let User(sUser)
  61.         sUid = sUser
  62.     End Property
  63.  
  64.     ' ***
  65.     ' *** ------------------------------------------------------------------------------
  66.     ' *** Property:    ChangeLockFolder
  67.     ' *** ------------------------------------------------------------------------------
  68.     ' *** Purpose:    Stores whether the name of a folder for a locked profile should be  
  69.     ' ***         profile.orig or profile.number.orig in order to prevent conflicts
  70.     ' ***         with other folders that might already exist on the computer.
  71.     ' *** ------------------------------------------------------------------------------
  72.     ' ***
  73.     Public Property Get ChangeLockFolder
  74.         ChangeLockFolder = bChangeLockFolder 
  75.     End Property
  76.     
  77.     Public Property Let ChangeLockFolder(bRenameLockFolder)
  78.         bChangeLockFolder = bRenameLockFolder
  79.     End Property
  80.     
  81.     ' ***
  82.     ' *** ------------------------------------------------------------------------------
  83.     ' *** Property:    IsProfileDriveNTFS
  84.     ' *** ------------------------------------------------------------------------------
  85.     ' *** Purpose:    Stores whether the profile of the user account exists in a NTFS 
  86.     ' ***         file system or not
  87.     ' *** ------------------------------------------------------------------------------
  88.     ' ***
  89.     Public Property Get IsProfileDriveNTFS
  90.         IsProfileDriveNTFS =  bProfileDriveNTFS
  91.     End Property
  92.     
  93.     Public Property Let IsProfileDriveNTFS(IsDriveNTFS)
  94.         bProfileDriveNTFS = IsDriveNTFS
  95.     End Property
  96.     
  97.     ' ***
  98.     ' *** ------------------------------------------------------------------------------
  99.     ' *** Property:    UserXML
  100.     ' *** ------------------------------------------------------------------------------
  101.     ' *** Purpose:    Full path to the users restrictions file
  102.     ' *** ------------------------------------------------------------------------------
  103.     ' ***
  104.     Public Property Get UserXML
  105.         If sUserXML = "" Then
  106.             If User="" Then
  107.                 UserXML = ""
  108.             Else
  109.                 UserXML = GetRootFolder & "\xml\User." & User & ".xml"
  110.             End If
  111.         Else
  112.             UserXML = sUserXML
  113.         End If
  114.     End Property    
  115.  
  116.     Public Property Let UserXML(sUserXMLFile)
  117.         sUserXML = sUserXMLFile
  118.     End Property
  119.     
  120.         ' ***
  121.     ' *** ------------------------------------------------------------------------------
  122.     ' *** Property:    TemplateXML
  123.     ' *** ------------------------------------------------------------------------------
  124.     ' *** Purpose:    Full path to the restrictions template file
  125.     ' *** ------------------------------------------------------------------------------
  126.     ' ***
  127.     Public Property Get TemplateXML
  128.         TemplateXML = sTemplateXML
  129.     End Property    
  130.  
  131.     Public Property Let TemplateXML(sTemplateXMLFile)
  132.         sTemplateXML = sTemplateXMLFile
  133.     End Property
  134.  
  135.     ' ~~~ 
  136.     ' ~~~ public methods
  137.     ' ~~~ 
  138.  
  139.     ' ***
  140.     ' *** ------------------------------------------------------------------------------
  141.     ' *** Name:        CreateXML
  142.     ' *** ------------------------------------------------------------------------------
  143.     ' *** Purpose:    Creates an XML file containing all of the specified users current
  144.     ' ***            restriction settings.
  145.     ' *** ------------------------------------------------------------------------------
  146.     ' ***
  147.     Public Function CreateXML
  148.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  149.         Dim oXML, bOK, bIdleLogoff, bDefault, strScr, oNode, bUnicode
  150.  
  151.         ' ~~~ Turn on error handling
  152.         On Error Resume Next
  153.         
  154.         bIdleLogoff = True
  155.         bDefault = True        
  156.  
  157.         ' ~~~ write log
  158.         If bLogging Then oLog.Write "clsRestrictions : CreateXML() : Entry"
  159.         If bLogging Then oLog.Write "clsRestrictions : CreateXML() : User Name     : " & User
  160.         If bLogging Then oLog.Write "clsRestrictions : CreateXML() : Template File : " & TemplateXML
  161.         If bLogging Then oLog.Write "clsRestrictions : CreateXML() : User XML File : " & UserXML
  162.         
  163.         ' ~~~ load reg hive and xml file
  164.         bOK = LoadUser(User)
  165.         
  166.         Set oXML = OpenXMLFile(TemplateXML)
  167.         
  168.         ' ~~~ if got xml, cycle through nodes, updating and save when complete
  169.         If bOK and Not(oXML is Nothing) Then
  170.             If bLogging Then oLog.Write "clsRestrictions : CreateXML() : User hive loaded and template xml file opened"
  171.             
  172.             For Each oNode In oXML.getElementsByTagName("poke")
  173.                 ' ~~~ determine if this is chkSharedAccount, if it is we need to process differently
  174.                 If oNode.Attributes.GetNamedItem("resid").Text = "chkSharedAccount" Then
  175.                     If AccountLocked(User) Then
  176.                         oNode.Text = oNode.Attributes.GetNamedItem("on").Text
  177.                     Else
  178.                         oNode.Text = oNode.Attributes.GetNamedItem("off").Text
  179.                     End If
  180.                 ElseIf oNode.Attributes.GetNamedItem("resid").Text = "chkDisableInternet" Then
  181.                     If RegReadANSI(sRootKeyS & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer" , "") = "NoInternetAccess" Then
  182.                         oNode.Text = oNode.Attributes.GetNamedItem("on").Text
  183.                     Else
  184.                         oNode.Text = oNode.Attributes.GetNamedItem("off").Text
  185.                     End If
  186.                 ElseIf oNode.Attributes.GetNamedItem("resid").Text = "txtLogoffInactive" Then
  187.                     If oNode.Attributes.GetNamedItem("regkey").Text = "Control Panel\Desktop\ScrnSave.exe" Then
  188.                         sCurrentScrSvr = RegReadANSI(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, "")    
  189.                         If sCurrentScrSvr <> "" Then sCurrentScrSvr = Mid(sCurrentScrSvr, InStrRev(sCurrentScrSvr,"\")+1,15)  
  190.                     End If
  191.                     If bIdleLogoff = True Then
  192.                         oNode.Text = ReadIdleLogOff(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, oNode.Attributes.GetNamedItem("off").Text)
  193.                         If oNode.Text = "" and oNode.Attributes.GetNamedItem("regkey").Text = "Software\Microsoft\Shared Computer Toolkit\IdleLogoff" Then
  194.                             bIdleLogoff = False
  195.                         End If
  196.                     Else
  197.                         If  bDefault = True Then
  198.                             strScr = RegReadANSI(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, "")    
  199.                             If Mid(strScr,InStrRev(strScr,"\")+1,15) = "ForceLogoff.exe" Then
  200.                                 bDefault = False
  201.                                 oNode.Text = SetDefaultScr(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, oNode.Attributes.GetNamedItem("off").Text)
  202.                             Else
  203.                                 oNode.Text = strScr
  204.                             End If
  205.                         Else
  206.                             oNode.Text = SetDefaultScr(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, oNode.Attributes.GetNamedItem("off").Text)
  207.                         End If 
  208.                     End If
  209.                 Else 
  210.                     Err.Clear        
  211.                     bUnicode = oNode.Attributes.GetNamedItem("unicode").Value 
  212.                     If Err.Number = 0 Then
  213.                         oNode.Text = RegRead(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text)
  214.                     Else
  215.                         oNode.Text = RegReadANSI(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, oNode.Attributes.GetNamedItem("off").Text)
  216.                     End If
  217.                 End If
  218.                 
  219.                 If bLogging Then oLog.Write "clsRestrictions : CreateXML() : " & oNode.Attributes.GetNamedItem("resid").Text & " " & sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text & " " & oNode.Text
  220.             Next
  221.             
  222.             Call oXML.save(UserXML)
  223.             
  224.         Else
  225.             If bLogging Then oLog.Write "clsRestrictions : CreateXML() : Failed to load user hive or open template xml file"
  226.             bOK = False
  227.         End If
  228.  
  229.         ' ~~~ destroy xml object and unload reg hive
  230.         Set oXML = nothing
  231.         Call UnLoadUser()
  232.         ' ~~~ return result        
  233.         CreateXML = bOK
  234.     End Function
  235.  
  236.     ' ***
  237.     ' *** ------------------------------------------------------------------------------
  238.     ' *** Name:        ApplyXML
  239.     ' *** ------------------------------------------------------------------------------
  240.     ' *** Purpose:    Applys the restrictions in a populated XML file to the specified user
  241.     ' *** ------------------------------------------------------------------------------
  242.     ' ***
  243.     Public Function ApplyXML
  244.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  245.         
  246.         Dim oXML, bOK, bLockAccount, bLockTagExist, oNode, bForceRestart, sCentralProfilePath, sProfileImagePath, oAccount
  247.         Dim strShellStartMenu, bInternetDisabled, sUnicode, sNoIntAccess, bProxyEnable, sRegValue, aElements, i
  248.         
  249.         ' ~~~ Turn on error handling
  250.         On Error Resume Next
  251.         
  252.         ' ~~~ write log
  253.         If bLogging Then oLog.Write "clsRestrictions : ApplyXML() : Entry"
  254.         If bLogging Then oLog.Write "clsRestrictions : ApplyXML() : User Name     : " & User
  255.         If bLogging Then oLog.Write "clsRestrictions : ApplyXML() : User XML File : " & UserXML
  256.  
  257.         bLockTagExist = False
  258.         ' ~~~ load reg hive and xml file
  259.         bOK = LoadUser(User)
  260.         Set oXML = OpenXMLFile(UserXML)
  261.         
  262.         ' ~~~ if got xml, cycle through nodes, updating registry
  263.         If bOK and Not(oXML is Nothing) Then
  264.             If bLogging Then oLog.Write "clsRestrictions : ApplyXML() : User hive loaded and user xml file opened"
  265.             
  266.             sNoIntAccess = RegReadANSI(sRootKeyS & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer", "") 
  267.             bProxyEnable = RegReadANSI(sRootKeyS & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 0 ) 
  268.             For Each oNode In oXML.getElementsByTagName("poke")
  269.                 If bLogging Then oLog.Write "clsRestrictions : ApplyXML() : " & oNode.Attributes.GetNamedItem("resid").Text & " " & sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text & " " & oNode.Text & " " & oNode.Attributes.GetNamedItem("type").Text
  270.  
  271.             ' ~~~ wrap in quotes certain environment values
  272.                 Select Case oNode.Attributes.GetNamedItem("regkey").Text
  273.                     Case "Software\Microsoft\Windows\CurrentVersion\Run\Logoff" 
  274.                         sRegValue = chr(34) & Replace(oNode.text," ",chr(34) & " " & chr(34)) & chr(34)
  275.                     Case Else 
  276.                         SRegValue = oNode.Text
  277.                 End Select
  278.                 
  279.                 Err.clear
  280.                 sUnicode = oNode.Attributes.GetNamedItem("unicode").Value 
  281.                 If Err.Number = 0 Then
  282.                     If oNode.Attributes.GetNamedItem("regkey").Text = "Control Panel\Desktop\ScrnSave.exe" Then
  283.                         SRegValue = oShell.ExpandEnvironmentStrings(SRegValue)
  284.                         If UCase(Mid(SRegValue , InStrRev(SRegValue ,"\")+1, 15)) = "FORCELOGOFF.EXE" Then  
  285.                             Call RegWrite(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, sRegValue, "REG_EXPAND_SZ")
  286.                         Else
  287.                             Call RegDelete(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text)
  288.                             Call RegWrite(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, sRegValue, oNode.Attributes.GetNamedItem("type").Text)    
  289.                         End If
  290.                     Else
  291.                         Call RegWrite(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, sRegValue, oNode.Attributes.GetNamedItem("type").Text)
  292.                     End If
  293.                     
  294.                 Else
  295.                     Call RegWriteANSI(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text, sRegValue, oNode.Attributes.GetNamedItem("type").Text)
  296.                 End If
  297.  
  298.                 Select Case oNode.Attributes.GetNamedItem("delete").Text
  299.                     Case "on"
  300.                         If oNode.Attributes.GetNamedItem("on").Text=oNode.Text Then
  301.                             Call RegDelete(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text)
  302.                         End If
  303.                     Case "off"
  304.                         If oNode.Attributes.GetNamedItem("off").Text=oNode.Text Then
  305.                             Call RegDelete(sRootKeyS & "\" & oNode.Attributes.GetNamedItem("regkey").Text)
  306.                         End If
  307.                 End Select
  308.  
  309.                 ' ~~~ shared account lock poke?
  310.                 If oNode.Attributes.GetNamedItem("resid").Text = "chkSharedAccount" Then
  311.                     bLockTagExist = True
  312.                     If oNode.Attributes.GetNamedItem("on").Text = oNode.Text Then
  313.                         bLockAccount = True
  314.                     Else
  315.                         bLockAccount = False
  316.                     End If
  317.                 End If
  318.                 
  319.                 ' ~~~ Create Log Off shorcut
  320.                 If oNode.Attributes.GetNamedItem("resid").Text = "chkForceRestart" Then    
  321.                     If oNode.Attributes.GetNamedItem("on").Text = oNode.Text Then
  322.                         bForceRestart = True                        
  323.                     Else
  324.                         bForceRestart = False                        
  325.                     End If
  326.                 End If
  327.                 ' ~~~ Disable Internet access from IE
  328.                 If oNode.Attributes.GetNamedItem("resid").Text = "chkDisableInternet" Then    
  329.                     If oNode.Attributes.GetNamedItem("on").Text = oNode.Text Then
  330.                         bInternetDisabled = True                        
  331.                     Else
  332.                         bInternetDisabled = False                        
  333.                     End If
  334.                 End If
  335.                 ' ~~~ To Store the changed screen saver of the user
  336.                 If oNode.Attributes.GetNamedItem("resid").Text = "txtLogoffInactive" Then
  337.                     If oNode.Attributes.GetNamedItem("regkey").Text = "Control Panel\Desktop\ScrnSave.exe" Then
  338.                         If oNode.Text = "" Then
  339.                             sCurrentScrSvr = "" 
  340.                         Else    
  341.                             sCurrentScrSvr = Mid(oNode.Text, InStrRev(oNode.Text,"\")+1, 15)  
  342.                         End If
  343.                     End If
  344.                 End If
  345.             Next
  346.         Else
  347.             If bLogging Then oLog.Write "clsRestrictions : ApplyXML() : Failed to load user hive or open template xml file"
  348.             bOK = False
  349.         End If
  350.             
  351.         strShellStartMenu = RegRead(  sRootKeyS & "\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Start Menu")
  352.         strShellStartMenu = oShell.ExpandEnvironmentStrings( strShellStartMenu )
  353.         
  354.         If bInternetDisabled Then
  355.             Call DisableInternet( "disable" , sNoIntAccess, bProxyEnable )
  356.         Else
  357.             Call DisableInternet( "enable" , sNoIntAccess, bProxyEnable )
  358.         End If
  359.  
  360.         ' ~~~ destroy xml object and unload reg hive
  361.         Set oXML = nothing
  362.         Call UnLoadUser()
  363.         
  364.         If bLockTagExist Then
  365.             ' ~~~ now process shared accounts lock
  366.             If bLockAccount and Not(AccountLocked(User)) Then Call LockSharedAccount(User)
  367.             If Not(bLockAccount) and AccountLocked(User) Then Call UnLockSharedAccount(User)
  368.         End If
  369.         
  370.         If bForceRestart Then
  371.             Call RestartShortcut("create", strShellStartMenu)
  372.         Else
  373.             Call RestartShortcut("delete", strShellStartMenu)
  374.         End If
  375.         
  376.         
  377.         
  378.         ' ~~~ Copy the ntuser.dat in central profile to normal profile folder after modifying the restrictions
  379.         Set oAccount = GetObject("WinNT://" & sComputer & "/" & User)
  380.         sCentralProfilePath = oAccount.Profile
  381.         Set oAccount = Nothing
  382.         
  383.         sProfileImagePath = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\"& GetUserSID(User) &"\ProfileImagePath")
  384.         sProfileImagePath = oShell.expandenvironmentstrings(sProfileImagePath )
  385.         
  386.         If oFso.FolderExists ( sCentralProfilePath ) and oFso.FolderExists( sProfileImagePath ) Then
  387.             If oFso.FileExists( sCentralProfilePath & "\ntuser.dat" ) Then
  388.                 If oFso.FileExists( sProfileImagePath & "\ntuser.dat") Then Call oFso.DeleteFile( sProfileImagePath & "\ntuser.dat", True)
  389.                 If oFso.FileExists( sProfileImagePath & "\ntuser.man") Then Call oFso.DeleteFile( sProfileImagePath & "\ntuser.man", True)
  390.                 
  391.                 ' ~~~ Copy the ntuser.dat in .orig folder to normal profile folder
  392.                 Call oFso.CopyFile( sCentralProfilePath & "\ntuser.dat", sProfileImagePath & "\ntuser.dat")
  393.             End If
  394.         End If
  395.         
  396.         ' ~~~ return result
  397.         ApplyXML = bOK
  398.     End Function
  399.  
  400.     ' ***
  401.     ' *** ------------------------------------------------------------------------------
  402.     ' *** Name:        Accounts(bHTML)
  403.     ' *** ------------------------------------------------------------------------------
  404.     ' *** Purpose:    Returns a string containing an account list
  405.     ' ***            If bHTML return a string that can be inserted into a dd list
  406.     ' *** ------------------------------------------------------------------------------
  407.     ' ***
  408.     Public Function Accounts(bHTML)
  409.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  410.         
  411.         Dim oUser, oAccounts, sHTML
  412.         
  413.         ' ~~~ get a list of user accounts on the local machine
  414.         Set oAccounts = GetObject("WinNT://" & sComputer)
  415.         oAccounts.Filter = Array("user")
  416.         
  417.         ' ~~~ add all the user accounts to the array
  418.         For Each oUser in oAccounts
  419.             If (GetProfilePath(oUser.Name) <> "") AND (oUser.Name <> oNetwork.UserName) AND (Right(GetUserSID( oUser.Name ), 4) <> "-500") Then
  420.                 If IsUserLoggedOn(oUser.Name) = False Then
  421.                     If bHTML Then
  422.                         sHTML = sHTML & "<option value=""" & oUser.Name & """>" & oUser.Name & "</option>" & vbCrLF
  423.                     Else
  424.                         sHTML = sHTML & oUser.Name & vbCrLF
  425.                     End If 
  426.                 End If
  427.             End If
  428.         Next
  429.     
  430.         ' ~~~ destroy objects
  431.         Set oUser     = Nothing
  432.         Set oAccounts = Nothing
  433.         
  434.         ' ~~~ return html strings
  435.         Accounts = sHTML
  436.     End Function
  437.  
  438.     ' ***
  439.     ' *** ------------------------------------------------------------------------------
  440.     ' *** Name:            OpenXMLFile(sXMLFile)
  441.     ' *** ------------------------------------------------------------------------------
  442.     ' *** Purpose:        Returns the entire xml document
  443.     ' *** ------------------------------------------------------------------------------
  444.     ' ***
  445.     Public Function OpenXMLFile(sXMLFile)
  446.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  447.         
  448.         Dim oXML
  449.         
  450.         ' ~~~ create xml object and open document
  451.         Set oXML = CreateObject("MSXML2.DomDocument")
  452.         Call oXML.Load(sXMLFile)
  453.     
  454.         If oXML.parseError.errorCode <> 0 Then
  455.             ' ~~~ error occured, return nothing
  456.             Set OpenXMLFile = Nothing
  457.         Else
  458.             Set OpenXMLFile = oXML
  459.         End If
  460.     End Function
  461.  
  462.     ' ***
  463.     ' *** ------------------------------------------------------------------------------
  464.     ' *** Name:            LockSharedAccount(sUser)
  465.     ' *** ------------------------------------------------------------------------------
  466.     ' *** Purpose:        Locks a shared acoount by making the profile mandatory
  467.     ' *** ------------------------------------------------------------------------------
  468.     ' ***
  469.     Public Function LockSharedAccount(sUser)
  470.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  471.         
  472.         Dim sProfilePath, sProfileNew, oAccount
  473.     
  474.         ' ~~~ turn on error handling
  475.         If Not(DEBUG) Then On Error Resume Next
  476.         
  477.         ' ~~~ write log entry
  478.         If bLogging Then oLog.Write "clsRestrictions : LockSharedAccount() : " & sUser
  479.  
  480.         ' ~~~ Do not lock if the file system is not NTFS
  481.         If NOT bProfileDriveNTFS Then
  482.             Exit Function
  483.         End If
  484.         
  485.         ' ~~~ Get the profilepath from the account properties
  486.         sProfilePath = ""
  487.         Set oAccount = GetObject("WinNT://" & sComputer & "/" & sUser)
  488.         sProfilePath = oAccount.Profile
  489.         
  490.         If bLogging Then oLog.Write "clsRestrictions : LockSharedAccount() : New Profile Path : " & sProfileNew
  491.  
  492.         ' ~~~ If the Account ProfilePath is blank, set it to ".orig", rename the folder, and make the profile mandatory
  493.         If sProfilePath = "" Then
  494.             ' ~~~ Get the new profile path by adding ".orig" to the profilepath from the registry
  495.             
  496.             sProfilePath = GetProfilePath(sUser)
  497.             sProfileNew = sProfilePath & ".orig"
  498.             
  499.             If oFso.FolderExists( sProfileNew ) Then
  500.                 If ChangeLockFolder Then
  501.                     ' ~~~ Get a new .orig folder name
  502.                     sProfileNew = LockProfileFolder(sProfilePath)    
  503.                 Else
  504.                     ' ~~~ Delete the .orig folder
  505.                     oFso.DeleteFolder sProfileNew , True
  506.                 End If
  507.             End If
  508.             
  509.             If bLogging Then oLog.Write "clsRestrictions : First Time Lock : " & sProfilePath & " -> " & sProfileNew
  510.             
  511.             ' ~~~ rename profile folder to match the new roaming location
  512.             Call oFso.MoveFolder(sProfilePath, sProfileNew)
  513.                         
  514.             If oFso.FolderExists(sProfileNew) then
  515.                 ' ~~~ Update the profile path attribute the account to reflect the new roaming location
  516.                 oAccount.Profile = sProfileNew
  517.                 oAccount.SetInfo
  518.             Else
  519.                 LockSharedAccount = False
  520.             End If
  521.             
  522.             ' ~~~ rename ntuser.dat to make the roaming profile a mandatory profile
  523.             If oFso.FileExists(sProfileNew & "\ntuser.dat") Then Call oFso.MoveFile(sProfileNew & "\ntuser.dat", sProfileNew & "\ntuser.man")
  524.  
  525.             If bLogging Then oLog.Write "clsRestrictions : LockSharedAccount() : User Account Profile Attribute : " & sProfileNew
  526.         Else
  527.         ' ~~~ If the Account ProfilePath is not blank it is a roaming profile (likely locked before); make it a mandatory profile
  528.             If oFso.FileExists(sProfilePath & "\ntuser.dat") Then 
  529.                 If bLogging Then oLog.Write "clsRestrictions : Profile Re-Lock : " & sProfilePath
  530.                 Call oFso.MoveFile(sProfilePath & "\ntuser.dat", sProfilePath & "\ntuser.man")
  531.             End If
  532.         End If
  533.         
  534.         If ( oFso.FileExists(sProfilePath & "\ntuser.man") or oFso.FileExists(sProfileNew & "\ntuser.man") ) Then
  535.             LockSharedAccount = True
  536.             ' ~~~ Change the owner of the profile folder
  537.             Call ChangeProfileOwner(sUser)
  538.         Else
  539.             LockSharedAccount = False
  540.         End If
  541.  
  542.         ' ~~~ turn off error handling
  543.         If Not(DEBUG) Then On Error Goto 0
  544.     End Function
  545.  
  546.     ' ***
  547.     ' *** ------------------------------------------------------------------------------
  548.     ' *** Name:            UnLockSharedAccount(sUser)
  549.     ' *** ------------------------------------------------------------------------------
  550.     ' *** Purpose:        Unlocks a mandatory account by changing the profile to roaming
  551.     ' *** ------------------------------------------------------------------------------
  552.     ' ***
  553.     Public Function UnLockSharedAccount(sUser)
  554.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  555.         
  556.         Dim sProfilePath, oAccount, sProfile, sCommand, sProfileImgPath  
  557.     
  558.         ' ~~~ turn on error handling
  559.         On Error Resume Next
  560.  
  561.         ' ~~~ write log entry
  562.         If bLogging Then oLog.Write "clsRestrictions : UnlockSharedAccount() : " & sUser
  563.  
  564.         ' ~~~ Get the profilepath from the account properties
  565.         sProfilePath = ""
  566.         Set oAccount = GetObject("WinNT://" & sComputer & "/" & sUser)
  567.         sProfilePath = oAccount.Profile
  568.  
  569.         ' ~~~ If the ProfilePath is non-blank, and ntuser.man is in it, we have a mandatory user profile to change to a roaming user profile.
  570.         If ( sProfilePath <> "" ) AND ( oFso.FileExists(sProfilePath & "\ntuser.man") ) Then 
  571.             Call oFso.MoveFile(sProfilePath & "\ntuser.man", sProfilePath & "\ntuser.dat")
  572.             If bLogging Then oLog.Write "clsRestrictions : Unlocked Profile : " & sProfilePath
  573.         Else
  574.             UnlockSharedAccount = False
  575.             Exit Function
  576.         End If
  577.         
  578.         ' ~~~ return error code
  579.         If Err.number=0 Then
  580.             ' ~~~ Reset the ACL that was set during Locking a profile
  581.             sProfile = GetProfilePath(sUser)
  582.             sCommand = Chr(34) & GetRootFolder & "\bin" & "\DenyAccess.exe" & Chr(34) & sUser & "," & "1" & "," 
  583.             Call SetPermission(sProfile,sCommand)
  584.             
  585.             UnlockSharedAccount = True
  586.         Else
  587.             UnlockSharedAccount = False
  588.         End If
  589.  
  590.         ' ~~~ turn off error handling
  591.         If Not(DEBUG) Then On Error Goto 0
  592.         
  593.         If sProfilePath <> "" Then 
  594.             ' ~~~ To delete ntuser.dat , created during logon when the account is locked
  595.             sProfileImgPath = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\"& GetUserSID(sUser) &"\ProfileImagePath")
  596.             sProfileImgPath = oShell.expandenvironmentstrings(sProfileImgPath )
  597.             If oFso.FolderExists(sProfileImgPath ) Then
  598.                 If oFso.FileExists(sProfileImgPath & "\ntuser.dat") Then Call oFso.DeleteFile(sProfileImgPath & "\ntuser.dat", True)
  599.                 If oFso.FileExists(sProfileImgPath & "\ntuser.man") Then Call oFso.DeleteFile(sProfileImgPath & "\ntuser.man", True)
  600.                 
  601.                 ' ~~~ Copy the ntuser.dat in .orig folder to normal profile folder
  602.                 Call oFso.CopyFile(sProfilePath & "\ntuser.dat", sProfileImgPath & "\ntuser.dat")
  603.             End If
  604.         End If
  605.  
  606.     End Function
  607.  
  608.     ' ***
  609.     ' *** ------------------------------------------------------------------------------
  610.     ' *** Name:            AccountLocked(sUser)
  611.     ' *** ------------------------------------------------------------------------------
  612.     ' *** Purpose:        Returns true if the specified account has a locked profile
  613.     ' *** ------------------------------------------------------------------------------
  614.     ' ***
  615.     Public Function AccountLocked(sUser)
  616.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  617.         
  618.         Dim oAccount, sProfilePath
  619.  
  620.         ' ~~~ turn on error handling 
  621.         On Error Resume Next
  622.         
  623.         ' ~~~ look at profile path in the account properties
  624.         sProfilePath = ""
  625.         Set oAccount = GetObject("WinNT://" & sComputer & "/" & sUser)
  626.         sProfilePath = oAccount.Profile
  627.  
  628.         AccountLocked = False
  629.  
  630.         ' ~~~ If the Account ProfilePath is non-blank and ntuser.man exists within, then we have a locked account
  631.         If sProfilePath <> "" Then 
  632.             If oFSo.FileExists(sProfilePath & "\ntuser.man") Then 
  633.                 AccountLocked = True
  634.             End If
  635.         End If
  636.         
  637.         ' ~~~ turn off error handling
  638.         On Error Goto 0
  639.     End Function
  640.  
  641.     ' ***
  642.     ' *** ------------------------------------------------------------------------------
  643.     ' *** Name:            IsUserLoggedOn(strUser)
  644.     ' *** ------------------------------------------------------------------------------
  645.     ' *** Purpose:        Returns true if the specified account is logged on
  646.     ' *** ------------------------------------------------------------------------------
  647.     ' ***
  648.     Public Function  IsUserLoggedOn(strUser)
  649.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  650.  
  651.         Dim sNTUser, oFile, oFileStream, strProfImgPath
  652.     
  653.         Const FORAPPENDING  = 8
  654.         Const TRISTATEUSEDEFAULT = -2
  655.     
  656.         IsUserLoggedOn = False
  657.  
  658.         If AccountLocked(strUser) = True Then
  659.             sNTUser = "\NTUSER.MAN"
  660.         Else
  661.             sNTUser = "\NTUSER.DAT"
  662.         End If 
  663.  
  664.         ' ~~~ We need to control error handling for the rest of this function
  665.         On Error Resume Next
  666.         
  667.         strProfImgPath = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & GetUserSID(strUser) & "\ProfileImagePath")
  668.         strProfImgPath = oShell.ExpandEnvironmentStrings( strProfImgPath )
  669.         
  670.         Set oFile = oFso.GetFile( strProfImgPath  & sNTUser)
  671.         ' ~~~ If we can't find the NTUSER file then it doesn't exist - so the user cannot be logged on
  672.         If Err.Number <> 0 Then    Exit Function 
  673.  
  674.         Set oFileStream = oFile.OpenAsTextStream(FORAPPENDING, TRISTATEUSEDEFAULT)
  675.         ' ~~~ If we can't open the NTUSER file exclusively, then someone must already be using it
  676.         If Err.Number <> 0 Then    IsUserLoggedOn = True 
  677.  
  678.     End Function
  679.  
  680.     ' ***
  681.     ' *** ------------------------------------------------------------------------------
  682.     ' *** Name:            GetUserSID(sUID)
  683.     ' *** ------------------------------------------------------------------------------
  684.     ' *** Purpose:        Returns the users SID
  685.     ' *** ------------------------------------------------------------------------------
  686.     ' ***
  687.     Public Function GetUserSID(sUID)
  688.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  689.         
  690.         Dim oAccount
  691.  
  692.         ' ~~~ turn on error handling
  693.         On Error Resume Next
  694.  
  695.         ' ~~~ create wmi object & get sid
  696.         Set oAccount    = oWMIService.Get("Win32_UserAccount.Name='" & sUID & "',Domain='" & oNetwork.ComputerName & "'")
  697.  
  698.         ' ~~~ return the sid
  699.         GetUserSID = oAccount.SID
  700.         
  701.     End Function
  702.  
  703.     ' ***
  704.     ' *** ------------------------------------------------------------------------------
  705.     ' *** Name:            GetProfilePath(sUID)
  706.     ' *** ------------------------------------------------------------------------------
  707.     ' *** Purpose:        Returns the path to the user profile
  708.     ' ***                If no profile exists, returns null
  709.     ' *** ------------------------------------------------------------------------------
  710.     ' ***
  711.     public Function GetProfilePath(sUID)
  712.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  713.         
  714.         Dim oAccount, sProfilePath
  715.  
  716.         ' ~~~ turn on error handling
  717.         On Error Resume Next
  718.         ' ~~~ first look for locked profiles
  719.         sProfilePath = ""
  720.         Set oAccount = GetObject("WinNT://" & sComputer & "/" & sUID)
  721.  
  722.         sProfilePath = oAccount.Profile
  723.  
  724.         ' ~~~ if profile path is still blank, it is not locked so get profile path using sid 
  725.         If sProfilePath = "" Then 
  726.             sProfilePath = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\"& GetUserSID(sUID) &"\ProfileImagePath")
  727.         End If
  728.         ' ~~~ return path
  729.         GetProfilePath = oShell.ExpandEnvironmentStrings(sProfilePath)
  730.  
  731.     End Function
  732.     
  733.     ' ***
  734.     ' *** ------------------------------------------------------------------------------
  735.     ' *** Name:        LoadUser(sUser)
  736.     ' *** ------------------------------------------------------------------------------
  737.     ' *** Purpose:    Loads a users private registry hive
  738.     ' *** ------------------------------------------------------------------------------
  739.     ' ***
  740.     Public Function LoadUser(sUser)
  741.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  742.         
  743.         Dim sProfilePath
  744.  
  745.         LoadUser = False
  746.         
  747.         sProfilePath = ""
  748.         sProfilePath = GetProfilePath(sUser)
  749.  
  750.         If ( sProfilePath <> "" ) AND (oFso.FileExists( sProfilePath & "\NTuser.dat") OR oFso.FileExists( sProfilePath & "\NTuser.man") ) Then
  751.             ' ~~~ load registry hive
  752.             If AccountLocked(sUser) Then
  753.                 oShell.Run "REG LOAD " & sRootKeyE & " """ & sProfilePath & "\ntuser.man""", 0, True
  754.             Else
  755.                 oShell.Run "REG LOAD " & sRootKeyE & " """ & sProfilePath & "\ntuser.dat""", 0, True
  756.             End If
  757.  
  758.             LoadUser = True
  759.         End If
  760.  
  761.     End Function
  762.  
  763.     ' ***
  764.     ' *** ------------------------------------------------------------------------------
  765.     ' *** Name:        UnLoadUser()
  766.     ' *** ------------------------------------------------------------------------------
  767.     ' *** Purpose:    Unloads the currently loaded registry hive
  768.     ' *** ------------------------------------------------------------------------------
  769.     ' ***
  770.     public Function UnLoadUser()
  771.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  772.         Dim bResult
  773.         bResult = oShell.Run("reg unload " & sRootKeyE, 0, True)
  774.  
  775.         ' ~~~ return status
  776.         If bResult = 0 Then
  777.             UnLoadUser = True
  778.         Else
  779.             UnLoadUser = False
  780.         End If
  781.     End Function
  782.     
  783.     
  784.     ' ***
  785.     ' *** ------------------------------------------------------------------------------
  786.     ' *** Name:            IsFileSystemNTFS()
  787.     ' *** ------------------------------------------------------------------------------
  788.     ' *** Purpose:        Checks the filesystem of the drive in which the user's 
  789.     ' ***            profile exists. 
  790.     ' ***            Returns True if it is NTFS, else False
  791.     ' *** ------------------------------------------------------------------------------
  792.     ' ***
  793.     Public Function IsFileSystemNTFS()
  794.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0    
  795.         
  796.         Dim colDisks, oDisk, sProfileDrive
  797.         
  798.         Const HARD_DISK = 3 ' ~~~ To check whether the drive is a hard disk
  799.         
  800.         IsFileSystemNTFS = True
  801.         
  802.         sProfileDrive = GetProfilePath(User)
  803.         sProfileDrive = oShell.ExpandEnvironmentStrings( sProfileDrive )
  804.         sProfileDrive = Left(sProfileDrive ,1)
  805.         sProfileDrive = UCase(sProfileDrive)
  806.         
  807.         Set colDisks = oWmiService.ExecQuery("Select * from Win32_LogicalDisk where DriveType =" & HARD_DISK & "" )
  808.         
  809.         For Each oDisk in colDisks
  810.             If UCase(Left(oDisk.DeviceID,1)) = sProfileDrive Then
  811.                 If UCase(oDisk.Filesystem) <> "NTFS" Then 
  812.                     IsFileSystemNTFS = False
  813.                     Exit For
  814.                 End If
  815.             End If
  816.         Next
  817.         
  818.     End Function
  819.  
  820.  
  821.     ' ~~~
  822.     ' ~~~ private methods
  823.     ' ~~~ 
  824.  
  825.     ' ***
  826.     ' *** ------------------------------------------------------------------------------
  827.     ' *** Name:        Class_Initialize
  828.     ' *** ------------------------------------------------------------------------------
  829.     ' *** Purpose:    Used internally by the class when it is created.
  830.     ' ***            Declared as private because it must not be called directly.
  831.     ' *** ------------------------------------------------------------------------------
  832.     ' ***
  833.     Private Sub Class_Initialize
  834.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  835.         
  836.         ' ~~~ set default values for properties
  837.         bLogging = True
  838.         bChangeLockFolder = False
  839.         bProfileDriveNTFS = True
  840.         
  841.         ' ~~~ defined to simplify code. two versions are required becauase the exe and script method of processing the registry is different
  842.         sRootKeyE  = "HKU\SSW"                ' EXE
  843.         sRootKeyS  = "HKEY_USERS\SSW"        ' SCRIPT
  844.     End Sub
  845.  
  846.     ' ***
  847.     ' *** ------------------------------------------------------------------------------
  848.     ' *** Name:        Class_Terminate
  849.     ' *** ------------------------------------------------------------------------------
  850.     ' *** Purpose:    Used internally by the class when it is destroyed.
  851.     ' ***            Declared as private because it must not be called directly.
  852.     ' *** ------------------------------------------------------------------------------
  853.     ' ***
  854.     Private Sub Class_Terminate
  855.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  856.     End Sub
  857.  
  858.     ' ***
  859.     ' *** ------------------------------------------------------------------------------
  860.     ' *** Name:            RegReadANSI(sRegKey, sValueOff)
  861.     ' *** ------------------------------------------------------------------------------
  862.     ' *** Purpose:        Reads ANSI only registry keys. Deals with non-existent keys.
  863.     ' ***                 Used only for registry keys not containing UNICODE (e.g Policy Settings)
  864.     ' *** ------------------------------------------------------------------------------
  865.     ' ***
  866.     Private Function RegReadANSI(sRegKey, sValueOff)
  867.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  868.         
  869.         Dim sValue
  870.  
  871.         ' ~~~ turn on error handling to capture registry handling errors
  872.         On Error Resume Next
  873.  
  874.         ' ~~~ read value from registry - MUST use oShell.RegRead... DO NOT REMOVE!
  875.         sValue = oShell.RegRead(sRegKey)
  876.  
  877.         ' ~~~ if error, key does not exist, value=off
  878.         If err.number <> 0 Then
  879.             sValue = sValueOff
  880.             err.Clear
  881.         End If
  882.  
  883.         ' ~~~ turn off error handling
  884.         On Error Goto 0
  885.  
  886.         ' ~~~ return result
  887.         RegReadANSI = sValue
  888.     End Function
  889.     
  890.     ' ***
  891.     ' *** ------------------------------------------------------------------------------
  892.     ' *** Name:            RegWriteANSI(sRegKey, sValue, sType)
  893.     ' *** ------------------------------------------------------------------------------
  894.     ' *** Purpose:        Writes ANSI value registry keys.
  895.     ' ***                 Used only for registry keys not containing UNICODE (e.g Policy Settings)
  896.     ' *** ------------------------------------------------------------------------------
  897.     ' ***
  898.     Private Function RegWriteANSI(sRegKey, sValue, sType)
  899.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  900.         
  901.         ' ~~~ Turn on error 'handling'
  902.         On Error Resume Next
  903.  
  904.         If (sType="REG_SZ") or (sType="REG_EXPAND_SZ") Then
  905.             Call oShell.RegWrite(sRegKey, sValue, sType)    
  906.         Else
  907.             If Not(IsNumeric(sValue)) Then sValue="0"
  908.             Call oShell.RegWrite(sRegKey, Int(sValue), sType)
  909.         End If
  910.  
  911.         ' ~~~ Turn off error handling
  912.         On Error Goto 0
  913.  
  914.         RegWriteANSI = Err.Number
  915.         Err.Clear
  916.  
  917.     End Function
  918.  
  919.     ' ***
  920.     ' *** ------------------------------------------------------------------------------
  921.     ' *** Name:            ReadIdlelogOff(sRegKey, sValueOff)
  922.     ' *** ------------------------------------------------------------------------------
  923.     ' *** Purpose:        Reads a registry key. Deals with non-existent keys.
  924.     ' *** ------------------------------------------------------------------------------
  925.     ' ***
  926.     Private Function ReadIdlelogOff(sRegKey, sValueOff)
  927.         If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  928.         Dim sAppDir
  929.  
  930.         ' ~~~ Do not attempt to use GetRootFolder here... called from WSF file.
  931.         sAppDir   = RegRead(TOOLKITKEY & "TargetDir")    
  932.         
  933.         Dim sValue
  934.         select case sRegKey
  935.             case sRootKeyS & "\Software\Microsoft\Shared Computer Toolkit\IdleLogoff"
  936.                 sValue = RegReadANSI(sRegKey, sValueOff) 
  937.             case sRootKeyS & "\Control Panel\Desktop\ScreenSaveTimeOut"
  938.                 sValue = RegReadANSI("Software\Microsoft\Shared Computer Toolkit\IdleLogoff", sValueOff)
  939.             case sRootKeyS & "\Control Panel\Desktop\ScreenSaveActive"
  940.                 sValue = 1
  941.             case sRootKeyS & "\Control Panel\Desktop\ScreenSaverIsSecure"
  942.                 sValue = 0
  943.             case sRootKeyS & "\Control Panel\Desktop\NoAutoReturnToWelcome"
  944.                 sValue = 1
  945.             case sRootKeyS & "\Control Panel\Desktop\ScrnSave.exe"
  946.                 sValue = chr(34) & sAppDir & "bin\ForceLogoff.exe" & chr(34)
  947.         End select
  948.  
  949.         ' ~~~ return result
  950.         ReadIdlelogOff = sValue
  951.     End Function
  952.     
  953. ' ***
  954. ' *** ------------------------------------------------------------------------------
  955. ' *** Name:            SetDefaultScr()
  956. ' *** ------------------------------------------------------------------------------
  957. ' *** Purpose:        If there is no scr and forcelogoff set the default scr is applied
  958. ' *** ------------------------------------------------------------------------------
  959. ' ***
  960.  
  961. Private Function SetDefaultScr(sRegKey, sValueOff)
  962.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  963.     
  964.     Dim sValue
  965.     select case sRegKey
  966.         case sRootKeyS & "\Control Panel\Desktop\ScrnSave.exe"
  967.             sValue = oShell.ExpandEnvironmentStrings("%WinDir%\System32\logon.scr")
  968.         case sRootKeyS & "\Control Panel\Desktop\ScreenSaveTimeOut"
  969.             sValue = 600
  970.         case sRootKeyS & "\Control Panel\Desktop\ScreenSaveActive"
  971.             sValue = 1
  972.         case sRootKeyS & "\Control Panel\Desktop\ScreenSaverIsSecure"
  973.             sValue = 0
  974.         case sRootKeyS & "\Control Panel\Desktop\NoAutoReturnToWelcome"
  975.             sValue = 1
  976.     End select
  977.  
  978.     SetDefaultScr = sValue
  979. End Function
  980.  
  981. ' ***
  982. ' *** ------------------------------------------------------------------------------
  983. ' *** Name:            ChangeProfileOwner(sUserName)
  984. ' *** ------------------------------------------------------------------------------
  985. ' *** Purpose:        Changes the owner of the folder to administrators
  986. ' *** ------------------------------------------------------------------------------
  987. ' ***
  988. Private Function ChangeProfileOwner(sUserName)
  989.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  990.     Dim Profile, sCommand
  991.  
  992.     Profile = GetProfilePath(sUserName)
  993.     sCommand = Chr(34) & GetRootFolder & "\bin" & "\DenyAccess.exe" & Chr(34) & sUserName & ",0," 
  994.     
  995.     ' ~~~ Change the ACL's on the root folder, subfolders and files
  996.     Call SetPermission(Profile,sCommand)
  997.  
  998. End Function
  999.  
  1000. ' ***
  1001. ' *** ------------------------------------------------------------------------------
  1002. ' *** Name:            SetPermission(Profile,sCommand)
  1003. ' *** ------------------------------------------------------------------------------
  1004. ' *** Purpose:        Changes the file/folder permissions
  1005. ' *** ------------------------------------------------------------------------------
  1006. ' ***
  1007. private Function SetPermission(Profile,sCommand)
  1008.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  1009.     
  1010.     Dim folders, folder, files, file, oDacl
  1011.  
  1012.     If oFso.FolderExists(Profile) Then
  1013.         ' ~~~ Set different ACL's for folders
  1014.         oShell.Run sCommand & "0," & Profile ,0,false
  1015.         
  1016.         For Each file In oFso.GetFolder(Profile).Files
  1017.             ' ~~~ Different ACL for files
  1018.             oShell.Run sCommand & "1," & file ,0,false
  1019.         Next
  1020.  
  1021.         For Each folder In oFso.getFolder(Profile).SubFolders
  1022.             Call SetPermission(oFso.GetAbsolutePathName(folder),sCommand)
  1023.         Next
  1024.     End If        
  1025. End Function
  1026.  
  1027. ' ***
  1028. ' *** ------------------------------------------------------------------------------
  1029. ' *** Name:        RestartShortcut(bCreate, sShellStartMenu)
  1030. ' *** ------------------------------------------------------------------------------
  1031. ' *** Purpose:        Creates logoff shortcut which restarts the computer while logoff
  1032. ' *** ------------------------------------------------------------------------------
  1033. ' ***
  1034. private Function RestartShortcut(bCreate, sShellStartMenu)
  1035.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  1036.  
  1037.     Dim strStartmenuFld, oShortcut, strUserFolder, scentralProfilePath, oAccount, sProfilePath, sProfileDrive 
  1038.     Dim iCharPos, strOrigFolder, strLeftStartMenuFld, strRightStartMenuFld
  1039.     strStartmenuFld = ""
  1040.     scentralProfilePath = ""
  1041.     sProfilePath = ""
  1042.  
  1043.     ' ~~~ Get the profile path of the user
  1044.     sProfilePath = GetProfilePath( User )
  1045.     sProfilePath = oShell.ExpandEnvironmentStrings( sProfilePath )
  1046.     sProfileDrive = Left( sProfilePath , 1)
  1047.         
  1048.     ' ~~~ Get the profile path from profile attribute if the profile is roaming
  1049.     Set oAccount = GetObject("WinNT://" & sComputer & "/" & User)
  1050.     scentralProfilePath = oAccount.Profile
  1051.     scentralProfilePath  = oShell.ExpandEnvironmentStrings( scentralProfilePath )
  1052.     Set oAccount = Nothing
  1053.     
  1054.     ' ~~~ Get the startmenu folder from ShellFolders 
  1055.     strStartmenuFld = sShellStartMenu
  1056.         
  1057.     If UCase(Left(strStartmenuFld ,1)) <> UCase(sProfileDrive) Then
  1058.         strStartmenuFld = sProfileDrive & Mid( strStartmenuFld , 2)
  1059.     End If
  1060.     
  1061.     If scentralProfilePath <> "" and oFso.FolderExists( scentralProfilePath ) Then
  1062.         ' ~~~ Extract the orig folder name
  1063.         iCharPos = 0
  1064.         iCharPos = InstrRev( scentralProfilePath , "\" )
  1065.         strOrigFolder = Mid( scentralProfilePath , iCharPos + 1)
  1066.         
  1067.         iCharPos = 0
  1068.         ' ~~~ Get the first occurence of \ and store the string before that position
  1069.         iCharPos = InstrRev( strStartmenuFld , "\" )
  1070.         strRightStartMenuFld = Mid ( strStartmenuFld , iCharPos )
  1071.         
  1072.         ' ~~~ Get the second occurence of \ and store the string after that position
  1073.         iCharPos = InstrRev( strStartmenuFld , "\" , iCharPos - 1 )
  1074.         strLeftStartMenuFld  = Left( strStartmenuFld , iCharPos )
  1075.         
  1076.         ' ~~~ Concatenate the two extracted strings and the orig folder name
  1077.         strStartmenuFld = strLeftStartMenuFld &  strOrigFolder & strRightStartMenuFld 
  1078.     End If
  1079.     
  1080.     Select Case bCreate
  1081.         Case "create"
  1082.             If oFso.FolderExists( strStartmenuFld ) Then
  1083.                 Set oShortcut = oShell.CreateShortcut(strStartmenuFld & "\" & L_sLogOffLink_TEXT & ".lnk")
  1084.                 Call oShell.Run("CMD /C COPY " &  Chr(34) & GetRootFolder & "\bin\shortcut\" & "LogOff.lnk" & Chr(34) & " " & Chr(34) & strStartmenuFld & "\" & L_sLogOffLink_TEXT & ".lnk" & Chr(34), 0, True)            
  1085.  
  1086.                 ' ~~~ To deny the delete permission for the user
  1087.                 oShell.Run Chr(34) & GetRootFolder & "\bin" & "\DenyAccess.exe" & Chr(34) & User & "," & "0" & "," & "1" & strStartmenuFld & "\" & L_sLogOffLink_TEXT & ".lnk" 
  1088.             End If
  1089.             
  1090.         Case "delete"
  1091.             If oFso.FileExists(strStartmenuFld & "\" & L_sLogOffLink_TEXT & ".lnk") Then
  1092.                 oFso.DeleteFile strStartmenuFld & "\" & L_sLogOffLink_TEXT & ".lnk" , True
  1093.             End If
  1094.     End Select
  1095.         
  1096. End Function
  1097.  
  1098. ' ***
  1099. ' *** ------------------------------------------------------------------------------
  1100. ' *** Name:            LockProfileFolder(strProfileImgPath)
  1101. ' *** ------------------------------------------------------------------------------
  1102. ' *** Purpose:        Checks for the existence of the .orig before locking
  1103. ' ***            an "unlocked" account and returns the profile folder
  1104. ' ***            as user.1.orig
  1105. ' *** ------------------------------------------------------------------------------
  1106. ' ***
  1107. Private Function LockProfileFolder(strProfileImgPath)
  1108.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  1109.     
  1110.     Dim iCount, strNewLockFolder, bFolderExists
  1111.     
  1112.     iCount = 1
  1113.     bFolderExists = False
  1114.     
  1115.     Do
  1116.         strNewLockFolder = strProfileImgPath & "." & iCount & ".orig"
  1117.         
  1118.         If oFso.FolderExists( strNewLockFolder ) Then
  1119.             iCount = iCount + 1
  1120.         Else
  1121.             bFolderExists = True
  1122.         End If
  1123.         
  1124.     Loop Until bFolderExists = True
  1125.     
  1126.     LockProfileFolder = strNewLockFolder
  1127. End Function    
  1128.  
  1129. ' ***
  1130. ' *** ------------------------------------------------------------------------------
  1131. ' *** Name:            DisableInternet( bDisableIE, sProxyServer, bProxyEnable )
  1132. ' *** ------------------------------------------------------------------------------
  1133. ' *** Purpose:        Changes the registry entry for checking/unchecking
  1134. ' ***            automatically detect settings checkbox in IE options
  1135. ' *** ------------------------------------------------------------------------------
  1136. ' ***
  1137. Private Function DisableInternet(bDisableIE, sProxyServer, bProxyEnable  ) 
  1138.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  1139.     
  1140.     Dim sRegpath, bResult, sDefaultConnValue , sUncheckAutoDetect, iByteCount, sCurrentIntConn
  1141.  
  1142.     Dim sIEConnRegPath , sAutoConfig , sAutoConfigURL , sProxyServervalue, iProxyEnable, bRegread
  1143.     
  1144.     Const HKEY_USERS = &H80000003
  1145.     
  1146.     If ((sProxyServer = "NoInternetAccess" and bDisableIE = "disable" ) or (sProxyServer <> "NoInternetAccess" and bDisableIE = "enable") ) Then
  1147.         Exit Function
  1148.     End If    
  1149.     
  1150.     sIEConnRegPath = "\Software\Microsoft\Shared Computer Toolkit\InternetSettings\"
  1151.  
  1152.     sRegpath = "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
  1153.         
  1154.     sUncheckAutoDetect = Array( 60,0,0,0,3,0,0,0,3,0,0,0,16,0,0,0,78,111,73,110,_
  1155.                     116,101,114,110,101,116,65,99,99,101,115,115,0,0,0,0,0,0,0,_
  1156.                     0,0,0,0,0,27,0,0,0,104,116,116,112,58,47,47,78,111,73,110,_
  1157.                     116,101,114,110,101,116,65,99,99,101,115,115,32,0,0,0,0,0,0,0,_
  1158.                     0,0,0,0,0,0,0,0,0,0,0,0,0 )
  1159.     
  1160.     On Error Resume Next
  1161.  
  1162.     bResult = oWmiReg.GetBinaryValue( HKEY_USERS, "SSW" & sRegpath & "Connections" , "DefaultConnectionSettings" , sDefaultConnValue )
  1163.     
  1164.     bregread = oWmiReg.GetExpandedStringValue( HKEY_USERS, "SSW" & sRegpath , "AutoConfigURL" , sAutoConfig )
  1165.     If bregread <> 0 Then     sAutoConfig = ""    
  1166.  
  1167.     If IsArray(sDefaultConnValue) Then
  1168.         ReDim Preserve  sDefaultConnValue(uBound(sDefaultConnValue))
  1169.         
  1170.         If bDisableIE = "disable" Then
  1171.             ' ~~~ Store the current internet settings in a separate Reg hive Internet Settings
  1172.             RegWrite sRootKeyS & sIEConnRegPath & "CurrentIntConn" , sDefaultConnValue , "REG_BINARY"
  1173.             RegWrite sRootKeyS & sIEConnRegPath & "ProxyServer" , sProxyServer , "REG_EXPAND_SZ"            
  1174.             RegWrite sRootKeyS & sIEConnRegPath & "AutoConfigURL" , sAutoConfig , "REG_EXPAND_SZ"
  1175.             RegWrite sRootKeyS & sIEConnRegPath & "ProxyEnable" , bProxyEnable  , "REG_DWORD"
  1176.             
  1177.             RegWrite sRootKeyS & sRegpath & "AutoConfigURL" , "" , "REG_SZ"
  1178.             RegWrite sRootKeyS & sRegpath & "ProxyEnable" , 1 , "REG_DWORD"
  1179.             RegWrite sRootKeyS & sRegpath & "MigrateProxy" , 1 , "REG_DWORD"            
  1180.             RegWrite sRootKeyS & sRegpath & "Connections\DefaultConnectionSettings" , sUncheckAutoDetect , "REG_BINARY"    
  1181.                         
  1182.         Else
  1183.             oWmiReg.GetBinaryValue HKEY_USERS, "SSW" & sIEConnRegPath  ,"CurrentIntConn" ,sCurrentIntConn 
  1184.             sAutoConfigURL = RegRead ( sRootKeyS & sIEConnRegPath & "AutoConfigURL" )
  1185.             sProxyServervalue = RegRead ( sRootKeyS & sIEConnRegPath & "ProxyServer" )
  1186.             iProxyEnable = RegRead ( sRootKeyS & sIEConnRegPath & "ProxyEnable" )
  1187.             
  1188.             RegWrite sRootKeyS & sRegpath & "Connections\DefaultConnectionSettings" , sCurrentIntConn , "REG_BINARY"    
  1189.             RegWrite sRootKeyS & sRegpath & "AutoConfigURL" , sAutoConfigURL  , "REG_EXPAND_SZ"    
  1190.             RegWrite sRootKeyS & sRegpath & "ProxyServer" , sProxyServervalue  , "REG_EXPAND_SZ"    
  1191.             RegWrite sRootKeyS & sRegpath & "ProxyEnable" , iProxyEnable  , "REG_DWORD"
  1192.         End If
  1193.     Else
  1194.         RegWrite sRootKeyS & sIEConnRegPath & "CurrentIntConn" , sUncheckAutoDetect , "REG_BINARY"
  1195.         RegWrite sRootKeyS & sIEConnRegPath & "ProxyServer" , "" , "REG_EXPAND_SZ"            
  1196.         RegWrite sRootKeyS & sIEConnRegPath & "AutoConfigURL" , "" , "REG_EXPAND_SZ"
  1197.         RegWrite sRootKeyS & sIEConnRegPath & "ProxyEnable" , 1 , "REG_DWORD"
  1198.         RegWrite sRootKeyS & sRegpath & "MigrateProxy" , 1 , "REG_DWORD"
  1199.         RegWrite sRootKeyS & sRegpath & "Connections\" & "DefaultConnectionSettings"  , sUncheckAutoDetect , "REG_BINARY"    
  1200.     End If
  1201.             
  1202. End Function
  1203.     
  1204. End Class    
  1205.  
  1206.  
  1207.