home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / free_security / msshared / Shared_Computer_Toolkit_ENU.msi / FileInclude018 < prev    next >
Encoding:
Text (UTF-16)  |  2005-09-02  |  32.4 KB  |  481 lines
  1. ' ***
  2. ' *** --------------------------------------------------------------------------
  3. ' *** Filename:        ProfileMgr.vbs
  4. ' *** --------------------------------------------------------------------------
  5. ' *** Description:    Code for the User Profiles HTA
  6. ' *** --------------------------------------------------------------------------
  7. ' *** Version:        1.0
  8. ' *** Notes:        
  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. ' ~~~ 
  21. ' ~~~ Declare global variables
  22. ' ~~~ 
  23. Dim oProfileMgr, oLog
  24.  
  25. ' ***
  26. ' *** --------------------------------------------------------------------------
  27. ' *** Name:        Init
  28. ' *** --------------------------------------------------------------------------
  29. ' *** Purpose:        This function is initiated by Main, which is called by 
  30. ' ***             OnLoad
  31. ' *** --------------------------------------------------------------------------
  32. ' ***
  33. Sub Init()
  34.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  35.     
  36.     ' ~~~ Turn on error handling
  37.     On Error Resume Next
  38.     
  39.     Set oProfileMgr = New ProfileMgr
  40.     Set oLog          = New Logging
  41.     oLog.Open(GetRootFolder & "\log\ProfileMgr.hta.log")
  42.     oLog.write("ProfileMgr.hta : Started")
  43.     oProfileMgr.Logging = oLog
  44.     
  45. End Sub
  46.  
  47. ' ***
  48. ' *** --------------------------------------------------------------------------
  49. ' *** Name:        Load
  50. ' *** --------------------------------------------------------------------------
  51. ' *** Purpose:        This function is initiated by Main to Load the UI.
  52. ' *** --------------------------------------------------------------------------
  53. ' ***
  54. Sub Load()
  55.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  56.     
  57.     ' ~~~ Call the Sub to create the drive lists
  58.     Call CreateDrivelist()
  59.     
  60.     ' ~~~ To add the drives
  61.     Call PopulateDrives()
  62.     
  63.     ' ~~~ Call the sub to enable body 
  64.     Call BodyDisable(False) 
  65.     
  66.     ' ~~~ disabling the controls 
  67.     ddDrives.disabled = true
  68.     UserPass.disabled = true
  69.     txtAccount.readonly = True
  70.     btnSelectAccounts.setactive()
  71. End Sub
  72.  
  73. ' ***
  74. ' *** ------------------------------------------------------------------------------
  75. ' *** Name:            Validate()
  76. ' *** ------------------------------------------------------------------------------
  77. ' *** Purpose:        This function is executed before a wizard page is exited
  78. ' ***            If this function returns True The page is ready to close.
  79. ' *** ------------------------------------------------------------------------------
  80. ' ***
  81. Function Validate()
  82.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  83.     Validate = True
  84. End Function
  85.  
  86. ' ***
  87. ' *** ------------------------------------------------------------------------------
  88. ' *** Name:            Action()
  89. ' *** ------------------------------------------------------------------------------
  90. ' *** Purpose:        This function is executed when enter key/close button is pressed
  91. ' ***            There is no action for close button
  92. ' *** ------------------------------------------------------------------------------
  93. ' ***
  94. Function Action()
  95.     
  96. End Function
  97.  
  98. ' ***
  99. ' *** ------------------------------------------------------------------------------
  100. ' *** Name:            UserAccounts_Click()
  101. ' *** ------------------------------------------------------------------------------
  102. ' *** Purpose:        This subroutine is executed on the click of CreateUserAccounts button
  103. ' *** ------------------------------------------------------------------------------
  104. ' ***
  105. Sub UserAccounts_Click()
  106.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  107.     
  108.     oLog.write("UserAccounts: Started")
  109.     oProfileMgr.CreateUserAccounts()
  110.     ' ~~~ If an account is deleted remove the account if it is currently selected.
  111.     If oProfileMgr.GetUserSID(document.all("txtAccount").value) = "" Then
  112.         document.all("txtAccount").value = ""
  113.         RefreshAccount ""
  114.     End If
  115. End Sub
  116.  
  117. ' ***
  118. ' *** ------------------------------------------------------------------------------
  119. ' *** Name:            CreateProfiles_Click()
  120. ' *** ------------------------------------------------------------------------------
  121. ' *** Purpose:        Creates the profile for the selected user
  122. ' *** ------------------------------------------------------------------------------
  123. ' ***
  124. Sub CreateProfiles_Click()
  125.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  126.  
  127.     Dim sUser
  128.  
  129.     bProcessing = True
  130.     
  131.     oLog.write("ProfileMgr.hta - CreateProfile: Started")
  132.     
  133.     If txtAccount.value <> "" Then
  134.         sUser = Mid(oProfileMgr.UserSelected,4)
  135.         If IsValidAccount(sUser) = False then    
  136.             MsgBox sUser & " " & NoUserAcc.innerHTML, vbOKOnly+vbCritical, sTitle
  137.             oLog.write("ProfileMgr.hta - CreateProfile: Account does not exist")
  138.             Exit Sub
  139.         End If
  140.         Call ToggleClose(True)        
  141.         oLog.write("ProfileMgr.hta - CreateProfile for user: " & sUser)
  142.         if oProfileMgr.CreateProfiles  (sUser, Trim(UserPass.value),".", ddDrives.Value) = "0" Then
  143.         
  144.             MsgBox CreateSuccess.innerHTML, vbOKOnly+vbInformation, sTitle
  145.             oLog.write("ProfileMgr.hta - CreateProfile: Success")
  146.             
  147.             Call ToggleClose(False)
  148.             
  149.             ' ~~~ Clear the password field
  150.             UserPass.Value=""
  151.             RefreshAccount Mid(oProfileMgr.UserSelected,4)
  152.         Else
  153.             MsgBox CreateFailed.innerHTML, vbOKOnly+vbCritical, sTitle
  154.             oLog.write("ProfileMgr.hta - CreateProfile: Error - Wrong Password or username")
  155.             oLog.write("ProfileMgr.hta - CreateProfile: Failed")
  156.             Call ToggleClose(False)
  157.             
  158.             ' ~~~ Clear the password field
  159.             UserPass.Value = ""
  160.         End If
  161.         
  162.     Else
  163.         MsgBox UserAcc.innerHTML, vbOKOnly+vbCritical, sTitle
  164.     End If
  165.     
  166.     oLog.write("ProfileMgr.hta - CreateProfile: Completed")
  167.     
  168.     bProcessing = False
  169. End Sub
  170.  
  171. ' ***
  172. ' *** ------------------------------------------------------------------------------
  173. ' *** Name:            DeleteProf_Click()
  174. ' *** ------------------------------------------------------------------------------
  175. ' *** Purpose:        Deletes the selected user's profile
  176. ' *** ------------------------------------------------------------------------------
  177. ' ***
  178. Sub DeleteProf_Click()
  179.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  180.  
  181.     Dim sUser
  182.  
  183.     bProcessing = True
  184.  
  185.         oLog.write("ProfileMgr.hta - DeleteProfile: Started")
  186.     
  187.     ' ~~~ Call the DeleteProfiles function in the class
  188.     If txtAccount.value <> "" Then 
  189.         sUser = Mid(oProfileMgr.UserSelected,4)
  190.         If Msgbox ( DeleteWarningText.innerHTML , VbYesNo+vbQuestion ,  DeleteWarningTitle.innerHTML & " " & txtAccount.value) = VbYes Then
  191.             If IsValidAccount(sUser) = False then    
  192.                 MsgBox sUser & " " & NoUserAcc.innerHTML, vbOKOnly+vbCritical, sTitle
  193.                 bProcessing = False
  194.                 oLog.write("ProfileMgr.hta - DeleteProfile: Account does not exist")
  195.                 Exit Sub
  196.             End If
  197.             oLog.write("ProfileMgr.hta - DeleteProfile for user: " & sUser)
  198.             Call ToggleClose(True)         
  199.             if oProfileMgr.DeleteProfiles (sUser, "") = "0" Then
  200.                 MsgBox DeleteSuccess.innerHTML, vbOKOnly+vbInformation, sTitle
  201.                 oLog.write("ProfileMgr.hta - DeleteProfile: Success")
  202.                 Call ToggleClose(False)
  203.  
  204.                 ' ~~~ Clear the password field
  205.                 UserPass.Value=""
  206.                 RefreshAccount Mid(oProfileMgr.UserSelected,4)
  207.             Else 
  208.                 MsgBox DeleteFailed.innerHTML, vbOKOnly+vbCritical, sTitle
  209.                 oLog.write("ProfileMgr.hta - DeleteProfile: Failed")
  210.                 Call ToggleClose(False)
  211.  
  212.                 ' ~~~ Clear the password field
  213.                 UserPass.Value = ""
  214.             End If
  215.         End If
  216.     Else
  217.         MsgBox UserAcc.innerHTML, vbOKOnly+vbCritical, sTitle
  218.     End If
  219.     oLog.write("ProfileMgr.hta - DeleteProfile: Completed")
  220.     bProcessing = False
  221. End Sub
  222.  
  223. ' ***
  224. ' *** ------------------------------------------------------------------------------
  225. ' *** Name:            CreateDrivelist()
  226. ' *** ------------------------------------------------------------------------------
  227. ' *** Purpose:        This subroutine is executed to create an empty drive list
  228. ' *** ------------------------------------------------------------------------------
  229. ' ***
  230. Sub CreateDrivelist()
  231.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  232.     
  233.     Dim sId, sStyle, sDefault
  234.     
  235.     ' ~~~ populate drive drop-down list
  236.     sId      = "id=""ddDrives"" "
  237.     sStyle   = "style="" width=100%;"""
  238.     tdDrives.innerHTML = "<select " & sId & sStyle & ">" &  "</select>"
  239.     
  240. End Sub
  241.  
  242. ' ***
  243. ' *** ------------------------------------------------------------------------------
  244. ' *** Name:            add_option(sValue)
  245. ' *** ------------------------------------------------------------------------------
  246. ' *** Purpose:        This subroutine is executed to add the drive ID 
  247. ' ***            to the drop down lists
  248. ' *** ------------------------------------------------------------------------------
  249. ' ***
  250. Sub add_option(sValue)
  251.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  252.     
  253.     Dim oOption
  254.     
  255.     Set oOption = document.CreateElement("OPTION")
  256.         
  257.     oOption.text = sValue
  258.     oOption.Value = sValue
  259.     ddDrives.add(oOption)
  260.     
  261.     Set oOption = Nothing
  262. End Sub
  263.  
  264. ' ***
  265. ' *** ------------------------------------------------------------------------------
  266. ' *** Name:            RefreshAccount(strUserName)
  267. ' *** ------------------------------------------------------------------------------
  268. ' *** Purpose:        This subroutine is executed when a user's profile is deleted/created
  269. ' ***            and also while changing the user
  270. ' *** ------------------------------------------------------------------------------
  271. ' ***
  272. Sub RefreshAccount(strUserName)
  273.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  274.     
  275.     Dim ProfilePath, sUser    
  276.     
  277.     if strUserName <> "" Then
  278.         sUser = strUserName
  279.         ProfilePath = oProfileMgr.GetProfilePath(sUser)
  280.         UserPass.Value = ""
  281.  
  282.         ddDrives.disabled = false
  283.         UserPass.disabled = false
  284.  
  285.         If ProfilePath = "" Then
  286.             ' ~~~ Set the default display in the drives ddlist
  287.             ddDrives.Value = Defaultdrive.innerHTML
  288.             btnCreateProfiles.Style.Visibility = "Visible"
  289.             btnDeleteProfiles.Style.Visibility = "hidden"
  290.             ' ~~~ disable
  291.             btnDeleteProfiles.disabled = true
  292.             btnCreateProfiles.disabled = false
  293.         Else
  294.             ' ~~~ Extract the drive of the Profile
  295.             ProfilePath = UCase(Left(ProfilePath,2))
  296.         
  297.             ' ~~~ Display the drive of the profile in drives dd list 
  298.             ddDrives.Value = ProfilePath 
  299.             btnCreateProfiles.Style.Visibility = "hidden"
  300.             btnDeleteProfiles.Style.Visibility = "Visible"
  301.             ' ~~~ disable 
  302.             btnDeleteProfiles.disabled = false
  303.             btnCreateProfiles.disabled = true
  304.             ddDrives.disabled = true
  305.             UserPass.disabled = true
  306.  
  307.         End If
  308.     Else
  309.         ddDrives.Value = Defaultdrive.innerHTML
  310.         UserPass.Value = ""
  311.         
  312.         btnCreateProfiles.Style.Visibility = "Visible"
  313.         btnDeleteProfiles.Style.Visibility = "Visible"
  314.         
  315.         ' ~~~ disable the buttons
  316.         ddDrives.disabled = true
  317.         UserPass.disabled = true
  318.         btnCreateProfiles.disabled = false
  319.         btnDeleteProfiles.disabled = false
  320.     End If
  321. End Sub
  322.  
  323. ' ***
  324. ' *** ------------------------------------------------------------------------------
  325. ' *** Name:            SelectAccount()
  326. ' *** ------------------------------------------------------------------------------
  327. ' *** Purpose:        To select the user account from the user account list
  328. ' *** ------------------------------------------------------------------------------
  329. ' ***
  330. Sub SelectAccount()
  331.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  332.  
  333.     Dim strUser, arrReturnValue
  334.  
  335.     bProcessing = True
  336.  
  337.     ' ~~~ get the username from the modal dialog
  338.     arrReturnValue = Window.ShowModalDialog("UserAccounts.hta", "ProfileMgr", "dialogWidth:15;dialogHeight:10;Center:Yes;help:No;Resizable:No;")
  339.     
  340.     If NOT IsEmpty(arrReturnValue) Then
  341.                 
  342.         ' ~~~ display the user name
  343.         txtAccount.value = arrReturnValue(1)
  344.         
  345.         ' ~~~ Extract the account name from 
  346.         strUser = arrReturnValue(0)
  347.         
  348.         ' ~~~ Set the UserSelected property
  349.         oProfileMgr.UserSelected = strUser 
  350.     
  351.         ' ~~~ Set the userdisabled property
  352.         If Left(strUser,3) = "dis" Then
  353.             oProfileMgr.IsUserDisabled = True
  354.         Else
  355.             oProfileMgr.IsUserDisabled = False
  356.         End If
  357.     
  358.         oLog.write("ProfileMgr.hta - Name of the account selected: " & Mid(strUser,4))
  359.         ' ~~~ call the onchange user function
  360.         RefreshAccount Mid(strUser,4)    
  361.     End If
  362.     bProcessing = False
  363. End Sub
  364.  
  365. ' ***
  366. ' *** ------------------------------------------------------------------------------
  367. ' *** Name:            ToggleClose(bToggle)
  368. ' *** ------------------------------------------------------------------------------
  369. ' *** Purpose:        This subroutine is executed to toggle the close button.
  370. ' *** ------------------------------------------------------------------------------
  371. ' ***
  372. Sub ToggleClose(bToggle)
  373.     
  374.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  375.     
  376.     If bToggle = True Then
  377.         btnFinish.disabled = True
  378.         btnFinish.style.cursor = "auto"
  379.         ' ~~~ To change the cursor to wait icon
  380.         BodyDisable(True)
  381.         
  382.     Else
  383.         btnFinish.disabled = False
  384.         btnFinish.style.cursor = "hand"
  385.         ' ~~~ To change the cursor to default
  386.         BodyDisable(False)
  387.     End If
  388. End Sub
  389.  
  390. ' ***
  391. ' *** ------------------------------------------------------------------------------
  392. ' *** Name:            CloseTxtClick()
  393. ' *** ------------------------------------------------------------------------------
  394. ' *** Purpose:        This subroutine is executed on the click of Close Text
  395. ' *** ------------------------------------------------------------------------------
  396. ' ***
  397. Sub CloseTxtClick()
  398.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  399.     
  400.     If Not(btnFinish.IsDisabled) Then
  401.         Self.Close
  402.     End If
  403. End Sub
  404.  
  405. ' ***
  406. ' *** ------------------------------------------------------------------------------
  407. ' *** Name:            HTAKeyDown()
  408. ' *** ------------------------------------------------------------------------------
  409. ' *** Purpose:        This is the handler function for tool specific key controls
  410. ' *** ------------------------------------------------------------------------------
  411. ' ***
  412. Sub HTAKeyDown()
  413.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0    
  414. End Sub
  415.  
  416. ' ***
  417. ' *** ------------------------------------------------------------------------------
  418. ' *** Name:        PopulateDrives()
  419. ' *** ------------------------------------------------------------------------------
  420. ' *** Purpose:    Returns a collection of drives in the system
  421. ' *** ------------------------------------------------------------------------------
  422. ' ***
  423. Function PopulateDrives()
  424.         
  425.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  426.     
  427.     Dim colDiskDrives, oDisks   
  428.     
  429.     const HARD_DISK = 3 ' ~~~ To check whether the drive is a hard disk
  430.     
  431.     Set colDiskDrives = oWMIService.ExecQuery _    
  432.         ("Select * from Win32_LogicalDisk where DriveType =" & HARD_DISK & "" )
  433.  
  434.     For Each oDisks in colDiskDrives 
  435.         ' ~~~ Do not display the drive if it is not formatted 
  436.         If oDisks.FileSystem <> "" Then
  437.             ' ~~~ Call the sub routine to add the driveID
  438.             add_option oDisks.DeviceID 
  439.         End If
  440.     Next
  441.  
  442.     Set colDiskDrives = Nothing
  443.     
  444. End Function
  445.  
  446. ' ***
  447. ' *** ------------------------------------------------------------------------------
  448. ' *** Name:            IsValidAccount(userName)
  449. ' *** ------------------------------------------------------------------------------
  450. ' *** Purpose:        Returns true if the user account exists or returns false
  451. ' *** ------------------------------------------------------------------------------
  452. ' ***
  453. Function IsValidAccount(userName)
  454.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0    
  455.     Dim oAccounts, oUser
  456.  
  457.     IsValidAccount = False
  458.     ' ~~~ get a list of user accounts on the local machine
  459.     Set oAccounts = GetObject("WinNT://" & sComputer)
  460.     oAccounts.Filter = Array("user")
  461.     For Each oUser in oAccounts 
  462.         If oUser.Name = userName Then
  463.             IsValidAccount = True                    
  464.             Exit Function
  465.         End If
  466.     Next
  467. End Function
  468.  
  469. ' ***
  470. ' *** ------------------------------------------------------------------------------
  471. ' *** Name:            HTAUnLoad()
  472. ' *** ------------------------------------------------------------------------------
  473. ' *** Purpose:        This method unloads all the objects 
  474. ' ***            created within the scope of the HTA
  475. ' *** ------------------------------------------------------------------------------
  476. ' ***
  477. Sub HTAUnLoad()
  478.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  479.     Set oProfileMgr = Nothing
  480.     Set oLog = Nothing
  481. End Sub