home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / free_security / msshared / Shared_Computer_Toolkit_ENU.msi / FileInclude007 < prev    next >
Encoding:
Text (UTF-16)  |  2005-09-02  |  24.3 KB  |  372 lines
  1. ' ***
  2. ' *** ------------------------------------------------------------------------------
  3. ' *** Filename:        clsUserAccounts.vbs
  4. ' *** ------------------------------------------------------------------------------
  5. ' *** Description:    UserAccounts Class
  6. ' *** ------------------------------------------------------------------------------
  7. ' *** Version:        1.0
  8. ' *** Notes:        Drives the contents of the UserAccounts dialog
  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.  
  19. Class UserAccounts
  20.  
  21. ' ~~~ 
  22. ' ~~~ declare variables and constants
  23. ' ~~~ 
  24.  
  25. Dim bAdmin, bGuest, sLocalUserSID
  26.  
  27. ' ~~~ 
  28. ' ~~~ Start of public methods
  29. ' ~~~ 
  30.  
  31. ' ***
  32. ' *** ------------------------------------------------------------------------------
  33. ' *** Name:        ListAccounts(strTool)
  34. ' *** ------------------------------------------------------------------------------
  35. ' *** Purpose:    Returns a HTML string containing the user Accounts and creates 
  36. ' ***            the OPTION tag in the ddUserAcc dd list
  37. ' *** ------------------------------------------------------------------------------
  38. ' ***
  39. Public Function ListAccounts(strTool)
  40.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  41.     Dim oUser
  42.  
  43.     ' ~~~ get a list of user accounts on the local machine
  44.     oAccounts.Filter = Array("user")
  45.  
  46.     Select Case strTool
  47.         Case "ProfileMgr"
  48.             For Each oUser in oAccounts 
  49.                         sLocalUserSID = GetLocalSID(oUser.ObjectSID)
  50.                         If AddUserAccount(oUser) = True Then
  51.  
  52.                         Elseif oUser.Get("PasswordExpired") <> 0 Then
  53.  
  54.                         ElseIf oUser.AccountDisabled <> 0 Then
  55.                             AddUsers oUser.Name, 5 , GetDisplayName(oUser)
  56.  
  57.                         ElseIf IsUserLoggedOn(oUser) = True Then
  58.                             AddUsers oUser.Name, 3 , GetDisplayName(oUser)                            
  59.                             
  60.                         ElseIf IsAccountLocked(oUser) = True Then
  61.                             AddUsers oUser.Name, 4 , GetDisplayName(oUser)
  62.  
  63.                         Else
  64.                             AddUsers oUser.Name, 0 , GetDisplayName(oUser)
  65.                         End If
  66.             Next
  67.         Case "Restrictions"
  68.             For Each oUser in oAccounts 
  69.                 sLocalUserSID = GetLocalSID(oUser.ObjectSID)
  70.                 If AddUserAccount(oUser) = True Then
  71.                 elseIf (GetProfilePath(oUser) <> "" ) AND (oFso.FileExists( GetProfilePath(oUser) & "\NTuser.dat") OR oFso.FileExists( GetProfilePath(oUser) & "\NTuser.man") ) Then
  72.                         
  73.                         If IsUserLoggedOn(oUser) = True Then
  74.                             AddUsers oUser.Name , 3 , GetDisplayName(oUser)
  75.  
  76.                         ElseIf oUser.AccountDisabled <> 0 Then
  77.                             AddUsers oUser.Name, 5     , GetDisplayName(oUser)
  78.  
  79.                         ElseIf IsAccountLocked(oUser) = True Then
  80.                             AddUsers oUser.Name, 4 , GetDisplayName(oUser)
  81.                                                 
  82.                         Else
  83.                             AddUsers oUser.Name, 0 , GetDisplayName(oUser)
  84.                         End If
  85.                 Else
  86.                         '~~~ Accounts with no profile
  87.                         AddUsers oUser.Name, 6 , GetDisplayName(oUser)
  88.                 
  89.                 End If
  90.             Next
  91.     End Select
  92. End Function
  93.  
  94. ' ~~~ 
  95. ' ~~~ End of public methods
  96. ' ~~~ 
  97.  
  98. ' ~~~ 
  99. ' ~~~ Start of private methods
  100. ' ~~~ 
  101.  
  102. ' ***
  103. ' *** ------------------------------------------------------------------------------
  104. ' *** Name:        Class_Initialize
  105. ' *** ------------------------------------------------------------------------------
  106. ' *** Purpose:    Used internally by the class when it is created.
  107. ' ***            Declared as private because it must not be called directly.
  108. ' *** ------------------------------------------------------------------------------
  109. ' ***
  110. Private Sub Class_Initialize
  111.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  112. bAdmin = False
  113. bGuest = False
  114. End Sub
  115.  
  116. ' ***
  117. ' *** ------------------------------------------------------------------------------
  118. ' *** Name:        Class_Terminate
  119. ' *** ------------------------------------------------------------------------------
  120. ' *** Purpose:    Used internally by the class when it is destroyed.
  121. ' ***            Declared as private because it must not be called directly.
  122. ' *** ------------------------------------------------------------------------------
  123. ' ***
  124. Private Sub Class_Terminate
  125.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  126. End Sub
  127.  
  128. ' ***
  129. ' *** ------------------------------------------------------------------------------
  130. ' *** Name:            GetLocalSID(sLocUserSID)
  131. ' *** ------------------------------------------------------------------------------
  132. ' *** Purpose:        Returns the users SID
  133. ' *** ------------------------------------------------------------------------------
  134. ' ***
  135. Private Function GetLocalSID(sLocUserSID)
  136.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  137.  
  138.     Dim OctetToHexStr, HexStrToDecStr, arrbytSid, lngTemp, iByteCount
  139.     
  140.     ' ~~~ Convert the binary array of SID to Hexa value
  141.     OctetToHexStr = ""
  142.     For iByteCount = 1 To Lenb(sLocUserSID)
  143.         OctetToHexStr = OctetToHexStr & Right("0" & Hex(Ascb(Midb(sLocUserSID, iByteCount, 1))), 2)
  144.       Next
  145.       
  146.       ' ~~~ Convert the hexa Value of SID to a string
  147.       ReDim arrbytSid(Len(OctetToHexStr)/2 - 1)
  148.     
  149.     For iByteCount = 0 To UBound(arrbytSid)
  150.         arrbytSid(iByteCount) = CInt("&H" & Mid(OctetToHexStr, 2*iByteCount + 1, 2))
  151.     Next
  152.  
  153.     HexStrToDecStr = "S-" & arrbytSid(0) & "-" _
  154.     & arrbytSid(1) & "-" & arrbytSid(8)
  155.  
  156.     lngTemp = arrbytSid(15)
  157.     lngTemp = lngTemp * 256 + arrbytSid(14)
  158.     lngTemp = lngTemp * 256 + arrbytSid(13)
  159.     lngTemp = lngTemp * 256 + arrbytSid(12)
  160.  
  161.     HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
  162.  
  163.     lngTemp = arrbytSid(19)
  164.     lngTemp = lngTemp * 256 + arrbytSid(18)
  165.     lngTemp = lngTemp * 256 + arrbytSid(17)
  166.     lngTemp = lngTemp * 256 + arrbytSid(16)
  167.  
  168.     HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
  169.  
  170.     lngTemp = arrbytSid(23)
  171.     lngTemp = lngTemp * 256 + arrbytSid(22)
  172.     lngTemp = lngTemp * 256 + arrbytSid(21)
  173.     lngTemp = lngTemp * 256 + arrbytSid(20)
  174.  
  175.     HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
  176.  
  177.     lngTemp = arrbytSid(25)
  178.     lngTemp = lngTemp * 256 + arrbytSid(24)
  179.  
  180.     HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
  181.       
  182.       GetLocalSID = HexStrToDecStr
  183.       
  184. End Function
  185.  
  186.  
  187. ' ***
  188. ' *** ------------------------------------------------------------------------------
  189. ' *** Name:        GetProfilePath(objUser)
  190. ' *** ------------------------------------------------------------------------------
  191. ' *** Purpose:    Gets the profile path for the seleted user in the dd list        
  192. ' *** ------------------------------------------------------------------------------
  193. ' ***
  194. Private Function GetProfilePath(objUser)
  195.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  196.  
  197.     Dim sProfilePath
  198.  
  199.     sProfilePath = ""
  200.     sProfilePath = objUser.Profile
  201.     
  202.     ' ~~~ We need to ignore errors here... RegRead may fail and that's ok
  203.     On Error Resume Next
  204.  
  205.     ' ~~~ if profile path is still blank, it is not locked so get profile path using sid 
  206.     If sProfilePath = "" Then 
  207.         sProfilePath = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & sLocalUserSID & "\ProfileImagePath")
  208.     End If
  209.  
  210.     ' ~~~ return path
  211.     GetProfilePath = oShell.ExpandEnvironmentStrings(sProfilePath)
  212. End Function
  213.  
  214. ' ***
  215. ' *** ------------------------------------------------------------------------------
  216. ' *** Name:            IsAccountLocked(objUser)
  217. ' *** ------------------------------------------------------------------------------
  218. ' *** Purpose:        Returns true if the specified account has a locked profile
  219. ' *** ------------------------------------------------------------------------------
  220. ' ***
  221. Private Function IsAccountLocked(objUser)
  222.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  223.  
  224.     Dim sProfilePath
  225.  
  226.     IsAccountLocked = False
  227.  
  228.     sProfilePath = objUser.Profile
  229.  
  230.     ' ~~~ If ProfilePath is blank, this account is not roaming and cannot be locked.
  231.     If sProfilePath = "" Then Exit Function
  232.  
  233.     ' ~~~ Need error handling here - if the oFSo call below causes an error that's ok
  234.     On Error Resume Next
  235.  
  236.     ' ~~~ If the ntuser.man exists within, then we have a locked account
  237.     If oFSo.FileExists(sProfilePath & "\NTUSER.MAN") Then IsAccountLocked = True
  238. End Function
  239.  
  240. ' ***
  241. ' *** ------------------------------------------------------------------------------
  242. ' *** Name:            IsUserLoggedOn(objUser)
  243. ' *** ------------------------------------------------------------------------------
  244. ' *** Purpose:        Returns true if the specified account is logged on
  245. ' *** ------------------------------------------------------------------------------
  246. ' ***
  247. Private Function  IsUserLoggedOn(objUser)
  248.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  249.  
  250.     Dim sNTUser, oFile, oFileStream, strProfilePath
  251.     
  252.     Const FORAPPENDING  = 8
  253.     Const TRISTATEUSEDEFAULT = -2
  254.  
  255.     strProfilePath = ""
  256.     IsUserLoggedOn = False
  257.  
  258.     If IsAccountLocked(objUser) = True Then
  259.         sNTUser = "\NTUSER.MAN"
  260.     Else
  261.         sNTUser = "\NTUSER.DAT"
  262.     End If 
  263.  
  264.     ' ~~~ We need to control error handling for the rest of this function
  265.     On Error Resume Next
  266.  
  267.     ' ~~~ Get the profilepimagepath from the registry
  268.     
  269.     strProfilePath = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & sLocalUserSID & "\ProfileImagePath")
  270.     strProfilePath = oShell.ExpandEnvironmentStrings(strProfilePath)
  271.     
  272.     Set oFile = oFso.GetFile( strProfilePath & sNTUser)
  273.     ' ~~~ If we can't find the NTUSER file then it doesn't exist - so the user cannot be logged on
  274.     If Err.Number <> 0 Then    Exit Function 
  275.  
  276.     Set oFileStream = oFile.OpenAsTextStream(FORAPPENDING, TRISTATEUSEDEFAULT)
  277.     ' ~~~ If we can't open the NTUSER file exclusively, then someone must already be using it
  278.     If Err.Number <> 0 Then    IsUserLoggedOn = True 
  279. End Function
  280.  
  281. ' ***
  282. ' *** ------------------------------------------------------------------------------
  283. ' *** Name:        AddUserAccount(oUser)
  284. ' *** ------------------------------------------------------------------------------
  285. ' *** Purpose:    Checks if the user account is a system account,Admin,Guset
  286. ' *** Returns True or False         
  287. ' *** ------------------------------------------------------------------------------
  288. ' ***
  289. Private Function AddUserAccount(oUser)
  290.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  291.  
  292.     Dim sFive
  293.     
  294.     Dim sUserSID
  295.     AddUserAccount = False
  296.     sUserSID = ""
  297.     
  298.     Select Case UCase(oUser.Name)
  299.         Case "HELPASSISTANT"
  300.             AddUserAccount= True
  301.         Case "ASPNET"
  302.             AddUserAccount= True
  303.         Case "SUPPORT_388945A0"
  304.             AddUserAccount= True
  305.         Case "SQLDEBUGGER"
  306.             AddUserAccount= True
  307.         Case "ACTUSER"
  308.             AddUserAccount= True
  309.         Case "IUSR_" & UCase(oNetwork.ComputerName)
  310.             AddUserAccount= True
  311.         Case "IWAM_" & UCase(oNetwork.ComputerName)
  312.             AddUserAccount= True
  313.         Case "VUSR_" & UCase(oNetwork.ComputerName)
  314.             AddUserAccount= True
  315.         Case UCase(oNetwork.UserName)
  316.             AddUserAccount= True
  317.             AddUsers oUser.Name, 1 , GetDisplayName(oUser)
  318.         Case Else
  319.     
  320.             ' ~~~ Get the SID of the user if necessary
  321.             If not(bAdmin) or not(bGuest) then
  322.                 sUserSID = sLocalUserSID
  323.             End if
  324.     
  325.             If sUserSID <> "" AND Right(sUserSID,4) = "-500" Then
  326.             ' ~~~ Administrator account
  327.                 AddUserAccount= True
  328.                 AddUsers oUser.Name, 2 , GetDisplayName(oUser)
  329.                 bAdmin = True
  330.             End If    
  331.             If sUserSID <> "" AND Right(sUserSID,4) = "-501" Then
  332.             ' ~~~ Guest account
  333.                 AddUserAccount= True
  334.                 AddUsers oUser.Name, 7 , GetDisplayName(oUser)
  335.                 bGuest = True
  336.             End If
  337.     End Select
  338.     
  339.  
  340.     
  341. End Function
  342.  
  343. ' ***
  344. ' *** ------------------------------------------------------------------------------
  345. ' *** Name:        GetDisplayName(oUser)
  346. ' *** ------------------------------------------------------------------------------
  347. ' *** Purpose:    Returns the user account's fullname if it exists           
  348. ' *** ------------------------------------------------------------------------------
  349. ' ***
  350. Private Function GetDisplayName(oUser)
  351.     If NOT DEBUG Then On Error Resume Next Else On Error Goto 0
  352.     
  353.     Dim sAccName, sFullName
  354.     sAccName = ""
  355.     sFullName = ""
  356.     
  357.     sAccName = oUser.Name
  358.     sFullName = oUser.FullName
  359.     
  360.     GetDisplayName = sAccName
  361.     If sFullName <> "" Then
  362.         If UCase(sAccName) = UCase(sFullName) Then
  363.             GetDisplayName = sFullName 
  364.         Else
  365.             GetDisplayName = sFullName + " (" + sAccName + ")"
  366.         End If
  367.     End If
  368.     
  369. End Function
  370.  
  371. End Class
  372.