home *** CD-ROM | disk | FTP | other *** search
' *** ' *** ------------------------------------------------------------------------------ ' *** Filename: clsProfileMgr.vbs ' *** ------------------------------------------------------------------------------ ' *** Description: ProfileMgr Class ' *** ------------------------------------------------------------------------------ ' *** Version: 1.0 ' *** Notes: ' *** ------------------------------------------------------------------------------ ' *** Copyright (C) Microsoft Corporation 2005, All Rights Reserved ' *** ------------------------------------------------------------------------------ ' *** ' ~~~ ' ~~~ Force variables to be declared and turn off script error messages unless in DEBUG mode ' ~~~ Option Explicit Class ProfileMgr ' ~~~ ' ~~~ declare variables and constants ' ~~~ Dim bLogging, sUid, sTemplateXML, sUserXML,oLog Dim sRootKeyE, sRootKeyS Dim strSelUser, bUserDisabled Dim sRegLSA,sRegProfileList ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: Logging ' *** ------------------------------------------------------------------------------ ' *** Purpose: Turns on logging, property must be set to a logging object ' *** ------------------------------------------------------------------------------ ' *** Public Property Get Logging Logging = bLogging End Property Public Property Let Logging(oObject) If VarType(oObject) = vbObject Then bLogging = True Set oLog = oObject End If End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: UserSelected ' *** ------------------------------------------------------------------------------ ' *** Purpose: Stores the user selected from useraccounts.hta ' *** ------------------------------------------------------------------------------ ' *** Public Property Get UserSelected UserSelected = strSelUser End Property Public Property Let UserSelected(sSelUser) strSelUser = sSelUser End Property ' *** ' *** ------------------------------------------------------------------------------ ' *** Property: IsUserDisabled ' *** ------------------------------------------------------------------------------ ' *** Purpose: Stores whether the user is disabled or not ' *** ------------------------------------------------------------------------------ ' *** Public Property Get IsUserDisabled IsUserDisabled = bUserDisabled End Property Public Property Let IsUserDisabled(busrDisabled) bUserDisabled = busrDisabled End Property ' ~~~ ' ~~~ Start of public methods ' ~~~ ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: CreateProfiles(sUserName, sPassword, sDomain, sDrive) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Creates the profile for the user name and password in the specified drive ' *** ------------------------------------------------------------------------------ ' *** Public Function CreateProfiles(sUserName, sPassword, sDomain, sDrive) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim limitblankpasswd, defProfilePath, sdefaultPath Dim sRootDir,sNewProfile,sUserID If IsLocalUser(sUserName) Then If bLogging Then oLog.Write("clsProfileMgr - CreateProfiles(): The account " & sUserName & " is a local account") ' ~~~ Check if the local user is disabled If IsAccDisabled(sUserName) Then bUserDisabled = True If bLogging Then oLog.Write("clsProfileMgr - CreateProfiles(): The account " & sUserName & " is currently disabled") Call AccountDisable(sUserName, False) End If sUserID = GetUserSID(sUserName) Else If bLogging Then oLog.Write("clsProfileMgr - CreateProfiles(): The account " & sUserName & " is a domain account") sUserID = GetSID(sUserName) End If ' ~~~ Store the limitblankpassworduse registry value limitblankpasswd = RegRead(sRegLSA) ' ~~~ Set the limitblankpassworduse registry value to 0 to support for blank passwords RegWrite sRegLSA,0, "REG_DWORD" ' ~~~ Get the Default profiles directory and store it in a variable ' ~~~ Use WMI registry call defProfilePath = RegRead(sRegProfileList & "\ProfilesDirectory") ' ~~~ copy the default to another string sdefaultPath = defProfilePath ' ~~~ Get the systemroot directory sRootDir = Left(oShell.ExpandEnvironmentStrings (sdefaultPath) , 2) ' ~~~ Set domain to (.) if null If sDomain = "" Then sDomain = "." ' ~~~ Call the private function to create the profile CreateProfiles = MakeProfile(sUserName,sPassword,sDomain) If CreateProfiles = 0 Then If (sDrive <> "") AND (UCase(sDrive) <> UCase(sRootDir) ) Then ' ~~~ Copy the profile to the new location sNewProfile = MoveProfile(sdefaultPath , sDrive, sUserName ) ' ~~~ Change the profileimagepath of the user to the new location RegWrite sRegProfileList & "\"& sUserID &"\ProfileImagePath" , sNewProfile, "REG_EXPAND_SZ" End If End If ' ~~~ Disable the user account if already disabled If bUserDisabled Then Call AccountDisable(sUserName, True) End If ' ~~~ Reset the limitblankpassworduse registry value to 1 RegWrite sRegLSA,limitblankpasswd, "REG_DWORD" End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: CreateUserAccounts() ' *** ------------------------------------------------------------------------------ ' *** Purpose: Manage(create/delete/modify) user accounts. ' *** ------------------------------------------------------------------------------ ' *** Public Function CreateUserAccounts() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim systemDir ' ~~~ Get the system root directory systemDir = Getsystemroot if bDomainMember Then ' ~~~ Run the Control Panel Applet using the control.exe oShell.run systemDir & "\lusrmgr.msc",1,true Else ' ~~~ Run the Control Panel Applet using the control.exe oShell.run "control.exe " & systemDir & "\nusrmgr.cpl",1,true End If End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DeleteProfiles(sUser, sdomainname) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Deletes the profile of the selected user. ' *** ------------------------------------------------------------------------------ ' *** Public Function DeleteProfiles(sUser, sdomainname) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim oUser, strProfilepath, strProfileImgpath ' ~~~ Turn on error handling ... On Error Resume Next ' RegRead will fail if there is no regkey If sUser = "" Then DeleteProfiles = 1 Exit Function End If ' ~~~ Check the domainname, if null then change to local(.) ' ~~~ If username account exists in the machine If IsLocalUser(sUser) = True Then If bLogging Then oLog.Write("clsProfileMgr - DeleteProfiles(): The account " & sUser & " is a local account") ' ~~~ Check if the user account is disabled If IsAccDisabled(sUser) Then bUserDisabled = True ' ~~~ Enable the user account that is disabled Call AccountDisable(sUser, False) End If ' ~~~ get the profile path Set oUser = GetObject("WinNT://" & sComputer & "/" & sUser) strProfilepath = oUser.Profile strProfilepath = oShell.ExpandEnvironmentStrings( strProfilepath ) ' ~~~ Use WMI registry call strProfileImgpath = RegRead( sRegProfileList & "\"& GetUserSID(sUser) &"\ProfileImagePath") ' ~~~ if registry hive exists for the user strProfileImgpath = oShell.ExpandEnvironmentStrings( strProfileImgpath ) ' ~~~ Call the DelProfile private function DeleteProfiles = DelProfile(sUser, strProfileImgpath, strProfilepath) If DeleteProfiles = 0 Then ' ~~~ Reset the profilepath of the user to null oUser.Profile = "" oUser.SetInfo End If ' ~~~ Disable the user account if it was previously disabled If bUserDisabled Then Call AccountDisable(sUser, True) End If Else If bLogging Then oLog.Write("clsProfileMgr - DeleteProfiles(): The account " & sUser & " is a domain account") ' ~~~ The user account is not in the machine DeleteProfiles = DelDomainProfile(sUser,sdomainname) End If Set oUser = Nothing End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: GetProfilePath(sUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Gets the profile path for the seleted user ' *** ------------------------------------------------------------------------------ ' *** Public Function GetProfilePath(sUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim oAccount, sProfilePath ' ~~~ turn on error handling On Error Resume Next ' ~~~ first look for locked profiles sProfilePath = "" Set oAccount = GetObject("WinNT://" & sComputer & "/" & sUser) sProfilePath = oAccount.Profile ' ~~~ if profile path is still blank, it is not locked so get profile path using sid If sProfilePath = "" Then sProfilePath = RegRead(sRegProfileList & "\"& GetUserSID(sUser) &"\ProfileImagePath") End If ' ~~~ return path GetProfilePath = oShell.ExpandEnvironmentStrings(sProfilePath) End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: GetUserSID(sUID) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns the users SID ' *** ------------------------------------------------------------------------------ ' *** Public Function GetUserSID(sUID) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim oAccount ' ~~~ turn on error handling On Error Resume Next ' ~~~ create wmi object & get sid Set oAccount = oWMIService.Get("Win32_UserAccount.Name='" & sUID & "',Domain='" & oNetwork.ComputerName & "'") ' ~~~ return the sid GetUserSID = oAccount.SID Set oAccount = Nothing End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: ShowUserAndProfile() ' *** ------------------------------------------------------------------------------ ' *** Purpose: Shows the user and profile path in commandline ' *** ------------------------------------------------------------------------------ ' *** Public Function ShowUserAndProfile If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim oAccounts, oUser, sHTML,sUserPath,strProfilePath ' ~~~ get a list of user accounts on the local machine Set oAccounts = GetObject("WinNT://" & sComputer) oAccounts.Filter = Array("user") For Each oUser in oAccounts If IsInValidAccount(oUser) = False Then strProfilePath = GetProfilePath(oUser.Name) If strProfilePath <> "" Then wscript.Echo oUser.Name&" : " & strProfilePath Else Wscript.Echo oUser.Name & " : " End If End If Next Set oUser = Nothing Set oAccounts = Nothing End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: CheckArguments(sArgs) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Check the arguments that are passed to the /create option ' *** in the command line and returns the arguments. ' *** This function is called when only /create is entered in commandline ' *** ------------------------------------------------------------------------------ ' *** Public Function CheckArguments(sArgs) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim struser, strpassword, strdomain, strdrive struser = Trim(sArgs(0)) strpassword = Trim(sArgs(1)) strdomain = Trim(sArgs(2)) strdrive = Trim(sArgs(3)) If strdomain = "" Then strdomain = "." End If ' ~~~ Call the IsValidInputs function to validate the inputs CheckArguments = IsValidInputs( struser, strpassword, strdomain, strdrive ) If UBound(CheckArguments) <> 0 Then ' ~~~ Return the username,password,domain and drive as an array CheckArguments = Array(struser,strpassword,strdomain,strdrive) End If End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: CreateArgs(sCreateArgs) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Check the arguments that are passed to the /create option ' *** in the command line and returns the arguments. ' *** This function is called if arguements are also passed with the ' *** /create option ' *** ------------------------------------------------------------------------------ ' *** Public Function CreateArgs(sCreateArgs) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim struser, strpassword, strdomain, strdrive ' ~~~ Assign the username struser = sCreateArgs(0) strpassword = sCreateArgs(1) strdomain = sCreateArgs(2) strdrive = sCreateArgs(3) ' ~~~ Set the domain to local (.) if null If strdomain = "" Then strdomain = "." ' ~~~ Call the IsValidInputs function to validate the inputs CreateArgs = IsValidInputs( struser, strpassword, strdomain, strdrive ) If UBound(CreateArgs) <> 0 Then ' ~~~ Return the username,password,domain and drive as an array CreateArgs = Array(struser,strpassword,strdomain,strdrive) End If End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DelArguments(sDelArgs) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Check the arguments that are passed to the /delete option ' *** in the command line and returns the arguments. ' *** ------------------------------------------------------------------------------ ' *** Public Function DelArguments(sDelArgs) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sUserArg, sDomainArg, OUser sUserArg = Trim(sDelArgs(0)) sDomainArg = Trim(sDelArgs(1)) ' ~~~ Validations for the user and domain ' ~~~ Change the domain to (.) for local machine If sDomainArg = "" or UCase(sDomainArg) = UCase(oNetwork.ComputerName) Then sDomainArg = "." ' ~~~ If user name is not provided If sUserArg = "" Then DelArguments = Array("1") Exit Function Else ' ~~~ Check whether the user is logged on If oNetwork.UserDomain = oNetwork.ComputerName Then ' ~~~ check for the logged on local user If ( UCase(sUserArg) = UCase(oNetwork.UserName)) Then ' ~~~ return 2 to show the error message DelArguments = Array("2") Exit Function End If ' ~~~ Check for user logged on through fast-user-switching Set OUser = GetObject("WinNT://" & sComputer & "/" & sUserArg ) If IsUserLoggedOn(OUser) Then ' ~~~ return 3 to show the error message DelArguments = Array("3") Exit Function End If Else ' ~~~ check for the logged on domain user If UCase(sUserArg) = UCase(oNetwork.UserName) Then DelArguments = Array("2") Exit Function End If End If ' ~~~ Check for the valid user and valid domain specified for that user If IsLocalUser(sUserArg) = True Then ' ~~~ Check if the domain is valid for the local user If sDomainArg <> "" and sDomainArg <> oNetwork.ComputerName and sDomainArg <> "." Then DelArguments = Array("6") Exit Function End If ' ~~~ Check if profile exists for the local user If (IsProfileExists(sUserArg) = 0) Then ' ~~~ Set the return value as 7 to indicate the error DelArguments = Array("7") Exit Function End If ElseIf (sDomainArg <> "" and sDomainArg <> oNetwork.ComputerName and sDomainArg <> "." and IsLocalUser(sUserArg) = False) Then ' ~~~ Check if profile exists for the domain user If (GetSID(sUserArg) = "") Then ' ~~~ Set the return value as 7 to indicate the error DelArguments = Array("7") Exit Function End If Else DelArguments = Array("5") Exit Function End If End If ' ~~~ return the username and domain DelArguments = Array(sUserArg, sDomainArg) End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: AccountDisable(strdisUser, bDisable) ' *** ------------------------------------------------------------------------------ ' *** Purpose: This subroutine is executed to enable/disalbe user account ' *** ------------------------------------------------------------------------------ ' *** Public Function AccountDisable(strdisUser,bDisable) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim usr Set usr = GetObject("WinNT://" & sComputer & "/" & strdisUser ) If bDisable Then usr.AccountDisabled = True usr.SetInfo Else usr.AccountDisabled = False usr.SetInfo End If Set usr = Nothing End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsAccDisabled(sdisableUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: To check whether the user account is disabled or not. ' *** ------------------------------------------------------------------------------ ' *** Public Function IsAccDisabled(sdisableUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim usr IsAccDisabled = False Set usr = GetObject("WinNT://" & sComputer & "/" & sdisableUser ) If usr.AccountDisabled <> 0 Then IsAccDisabled = True Set usr = Nothing End Function ' ~~~ ------------------------------------------------------------------------- ' ~~~ End of public methods ' ~~~ ------------------------------------------------------------------------- ' ~~~ ------------------------------------------------------------------------- ' ~~~ Start of private methods ' ~~~ ------------------------------------------------------------------------- ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Class_Initialize ' *** ------------------------------------------------------------------------------ ' *** Purpose: Used internally by the class when it is created. ' *** Declared as private because it must not be called directly. ' *** ------------------------------------------------------------------------------ ' *** Private Sub Class_Initialize If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 bLogging = True sRootKeyE = "HKU\SSW" ' EXE sRootKeyS = "HKEY_USERS\SSW" ' SCRIPT sRegLSA = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Lsa\limitblankpassworduse" sRegProfileList = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList" End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Class_Terminate ' *** ------------------------------------------------------------------------------ ' *** Purpose: Used internally by the class when it is destroyed. ' *** Declared as private because it must not be called directly. ' *** ------------------------------------------------------------------------------ ' *** Private Sub Class_Terminate If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 End Sub ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: Getsystemroot() ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns the system root directory ' *** Used for running the control.exe ' *** ------------------------------------------------------------------------------ ' *** Private Function Getsystemroot() If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim systemDir systemDir = oShell.ExpandEnvironmentStrings("%SYSTEMROOT%") systemDir = systemDir & "\system32" ' ~~~ Return the root directory Getsystemroot = systemDir End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: MoveProfile(sSystemDir, sDesdrive, sCurrentUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: The profile created in default drive is moved to selected drive. ' *** ------------------------------------------------------------------------------ ' *** Private Function MoveProfile(sSystemDir , sDesdrive, sCurrentUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sCurrentLoc, sDesLocation, oFolder , iCharPosStart , iCharPosEnd, strPROFILEFOLDER Const OVERWRITEFILES = True ' ~~~ Expand the environment variables in the default profiles directory sSystemDir = oShell.ExpandEnvironmentStrings (sSystemDir) strPROFILEFOLDER = sDesdrive & Mid( sSystemDir , 3 ) ' ~~~ Get the last occurence of "\" iCharPosEnd = InstrRev( strPROFILEFOLDER , "\" ) ' ~~~ Get the first occurence of "\" iCharPosStart = Instr( strPROFILEFOLDER , "\" ) ' ~~~ Check whether all the parent folders exists, if not create them While iCharPosStart < iCharPosEnd ' ~~~ Get the occurence of "\" iCharPosStart = Instr( iCharPosStart , strPROFILEFOLDER , "\" ) If NOT oFso.FolderExists( Left( strPROFILEFOLDER , iCharPosStart - 1)) Then ' ~~~ Create the folder oFolder = oFso.CreateFolder( Left( strPROFILEFOLDER , iCharPosStart - 1) ) End If iCharPosStart = iCharPosStart + 1 Wend ' ~~~ Check for the existence of last folder in the destination path If NOT oFso.FolderExists( strPROFILEFOLDER ) Then ' ~~~ Create the folder oFolder = oFso.CreateFolder( strPROFILEFOLDER ) End If ' ~~~ Append the username to the profile path sCurrentLoc = sSystemDir & "\" & sCurrentUser sDesLocation = strPROFILEFOLDER & "\" & sCurrentUser ' ~~~ Copy the profile folder If oFso.FolderExists(sCurrentLoc) Then ' ~~~ Copy the profile folder from the default location to the selected drive oFso.CopyFolder sCurrentLoc, sDesLocation, OVERWRITEFILES ' ~~~ Delete the old profile folder oFso.DeleteFolder sCurrentLoc , True End If If bLogging Then oLog.Write("clsProfileMgr - MoveProfile(): The Profile for " & sCurrentUser & " is created in " & sDesdrive) ' ~~~ Return the new profile location MoveProfile = sDesLocation End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DelProfile(strUser, sprofileImgpath, sprofilepath) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Deletes the profile folder,orig folder if locked and registry ' *** ------------------------------------------------------------------------------ ' *** Private Function DelProfile(strUser, sprofileImgpath, sprofilepath) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim strUserSID, oUser DelProfile = 0 ' ~~~ Turn on error handling On Error Resume Next strUserSID = GetUserSID(strUser) err.clear If sprofileImgpath <> "" Then If oFso.FolderExists ( sprofileImgpath ) = True Then oFso.DeleteFolder sprofileImgpath , True If err.number = 0 Then DelProfile = 0 Else DelProfile = 1 Exit Function End If End If End If err.clear If sprofilepath <> "" Then If oFso.FolderExists ( sprofilepath ) = True Then oFso.DeleteFolder sprofilepath , True If err.number = 0 Then DelProfile = 0 Else DelProfile = 1 Exit Function End If End If End If oShell.RegDelete sRegProfileList & "\" & strUserSID & "\" End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: MakeProfile(StrUser, StrPassword, StrDomain) ' *** ------------------------------------------------------------------------------ ' *** Purpose: creates profile for the selected the user by using createprofile.exe ' *** Returns true on success else returns false ' *** ------------------------------------------------------------------------------ ' *** Private Function MakeProfile(StrUser, StrPassword, StrDomain) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim UserSID, bProfile, sCommand ' ~~~ Turn on error handling On Error Resume Next if StrUser = "" Then MakeProfile = 1 exit function End If If StrDomain = " " or UCase(StrDomain) = UCase(oNetwork.ComputerName) Then StrDomain = "." End If sCommand = Chr(34) & GetRootFolder & "\bin" & "\CreateProfile.exe" & Chr(34)_ & StrDomain & "," & StrUser & "," & StrPassword bProfile = oShell.Run (sCommand, 7, True) If bProfile = 1 Then ' ~~~ Profile created successfully MakeProfile = 0 Else MakeProfile = 1 End If Set oAccount = Nothing End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsUserLoggedOn(oUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns true if the specified account is logged on ' *** ------------------------------------------------------------------------------ ' *** Private Function IsUserLoggedOn(oUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sNTUser, oFile, oFileStream Const FORAPPENDING = 8 Const TRISTATEUSEDEFAULT = -2 IsUserLoggedOn = False If IsAccountLocked(oUser) = True Then sNTUser = "\NTUSER.MAN" Else sNTUser = "\NTUSER.DAT" End If ' ~~~ We need to control error handling for the rest of this function On Error Resume Next Set oFile = oFso.GetFile(GetProfilePath(oUser.Name) & sNTUser) ' ~~~ If we can't find the NTUSER file then it doesn't exist - so the user cannot be logged on If Err.Number <> 0 Then Exit Function Set oFileStream = oFile.OpenAsTextStream(FORAPPENDING, TRISTATEUSEDEFAULT) ' ~~~ If we can't open the NTUSER file exclusively, then someone must already be using it If Err.Number <> 0 Then IsUserLoggedOn = True End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsLocalUser(sLocUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns true if the specified account is a local user ' *** ------------------------------------------------------------------------------ ' *** Private Function IsLocalUser(sLocUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim colAccounts, oUser Set colAccounts = GetObject("WinNT://" & sComputer & "") colAccounts.Filter = Array("user") For Each oUser In colAccounts If UCase(sLocUser) = UCase(oUser.Name) Then IsLocalUser = True Exit For Else IsLocalUser = False End If Next End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: DelDomainProfile(sDomUser,sDomName) ' *** ------------------------------------------------------------------------------ ' *** Purpose: This function is used to delete the domain user pofiles ' *** ------------------------------------------------------------------------------ ' *** Private Function DelDomainProfile(sDomUser,sDomName) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim bRegResult, bRegDelete, strComputer, oReg, sDomUserSID, strKeyPath Dim strValueName, strValue ' ~~~ Turn on error handling On Error Resume Next const HKEY_LOCAL_MACHINE = &H80000002 strComputer = "." Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ strComputer & "\root\default:StdRegProv") sDomUserSID = GetSID(sDomUser) strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & sDomUserSID strValueName = "ProfileImagePath" bRegResult = oReg.GetStringValue (HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue) If bRegResult = 0 Then If oFso.FolderExists (strValue) = True Then oFso.DeleteFolder strValue , True End If err.clear oShell.RegDelete sRegProfileList & "\" & sDomUserSID & "\" End If If err.number = 0 Then DelDomainProfile = 0 Else DelDomainProfile = 1 End If ' ~~~ Turn off error handling on error goto 0 Set oReg = Nothing End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: GetSID(sdomUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Get the SID for the user whose account is not in the ' *** machine ' *** ------------------------------------------------------------------------------ ' *** Private Function GetSID(sdomUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ Turn on error handling On Error Resume Next Dim strComputer, oReg, strKeyPath, strProfImgPath, strValueName Dim arrSubKeys, subkey, strValue ' ~~~ To Get the SID from registry const HKEY_LOCAL_MACHINE = &H80000002 strComputer = "." Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ strComputer & "\root\default:StdRegProv") strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList" oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys strProfImgPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList" strValueName = "ProfileImagePath" ' ~~~ Loop through all the SID's in the registry For Each subkey In arrSubKeys oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey, strValueName, strValue strValue = Mid(strValue, InStrRev(strValue, "\") +1) If (UCase(strValue) = UCase(sdomUser)) Then ' ~~~ return the SID GetSID = subkey End If Next End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsValidDrive(sdriveID) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Checks whether the drive entered in the /create option ' *** is a valid drive ' *** ------------------------------------------------------------------------------ ' *** Private Function IsValidDrive(sdriveID) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim colDiskDrives, oDisks ' ~~~ To check whether the drive is a hard disk const HARD_DISK = 3 If Right(sdriveID,1) <> ":" Then sdriveID = sdriveID & ":" End If Set colDiskDrives = oWMIService.ExecQuery _ ("Select * from Win32_LogicalDisk where DriveType =" & HARD_DISK & "" ) For Each oDisks in colDiskDrives If oDisks.FileSystem <> "" Then If UCase(oDisks.DeviceID) = UCase(sdriveID) Then IsValidDrive = True End If End If Next End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsProfileExists(sLocalUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Checks whether profile exists for the local user before ' *** deleting. ' *** ------------------------------------------------------------------------------ ' *** Private Function IsProfileExists(sLocalUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim strProfilePath1, strProfilePath2, oUser strProfilePath1 = "" strProfilePath2 = "" ' ~~~ Need to ignore errors for a moment On Error Resume Next ' ~~~ get the profile path attribute from the account Set oUser = GetObject("WinNT://" & sComputer & "/" & sLocalUser) strProfilePath1 = oUser.Profile If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ Get the profile path attribute from the registry (if it exists) strProfilePath2 = RegRead( sRegProfileList & "\" & GetUserSID(sLocalUser) & "\ProfileImagePath" ) If (strProfilePath1 <> "") or (strProfilePath2 <> "") Then IsProfileExists = 1 Else IsProfileExists = 0 End If End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsValidInputs(strUSER, strPASS, strDOMAIN, strDRIVE) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Validates the inputs that are entered with the ' *** /create option ' *** ------------------------------------------------------------------------------ Private Function IsValidInputs(strUSER, strPASS, strDOMAIN, strDRIVE) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ Check for the validity of the user If strUSER = "" Then IsValidInputs = Array("1") Exit Function Else ' ~~~ Check the domain specified for the local user If IsLocalUser(strUSER) = True Then If strDOMAIN <> "" and strDOMAIN <> oNetwork.ComputerName and strDOMAIN <> "." Then IsValidInputs = Array("6") Exit Function End If If IsProfileExists(strUSER) = 1 Then IsValidInputs = Array("7") Exit Function End If ' ~~~ Domain profile creation through local machine login ElseIf (oNetwork.UserDomain = oNetwork.ComputerName and IsLocalUser(strUSER) = False and strDOMAIN <> "" and strDOMAIN <> oNetwork.ComputerName and strDOMAIN <> "." ) Then ' ~~~ Check if the profile exists for the domain user If (GetSID(strUSER) <> "") Then ' ~~~ Set the return value as 7 to indicate the error IsValidInputs = Array("7") Exit Function End If ' ~~~ Domain profile creation through domain account login ElseIf (strDOMAIN <> "" and strDOMAIN <> oNetwork.ComputerName and strDOMAIN <> "." and IsLocalUser(strUSER) = False) Then If IsDomainUser ( strUSER, strDOMAIN ) = False Then IsValidInputs = Array("8") Exit Function End If ' ~~~ Check if profile exists for the domain user If (GetSID(strUSER) <> "" ) Then ' ~~~ Set the return value as 7 to indicate the error IsValidInputs = Array("7") Exit Function End If Else ' ~~~ return error IsValidInputs = Array("5") Exit Function End If End If ' ~~~ Check for the drive validity If strDRIVE <> "" Then ' ~~~ Check if the drive is valid If IsValidDrive(strDRIVE) = False Then IsValidInputs = Array("4") Exit Function End If End If ' ~~~ return the inputs IsValidInputs = Array(strUSER, strPASS, strDOMAIN, strDRIVE) End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsDomainUser(sDOMUser,sDOMName) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns true if the user is a domain member ' *** ------------------------------------------------------------------------------ ' *** Private Function IsDomainUser(sDOMUser,sDOMName) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 ' ~~~ Turn on error handling On Error Resume Next Dim oAccount IsDomainUser = False ' ~~~ Account not in the machine, domain profile Set oAccount = oWMIService.Get("Win32_UserAccount.Name='" & sDOMUser & "',Domain='" & sDOMName & "'") If NOT IsEmpty(oAccount) Then IsDomainUser = True Set oAccount = Nothing End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsInValidAccount(oUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Checks if the user account is a valid account to be listed ' *** ------------------------------------------------------------------------------ ' *** Private Function IsInValidAccount(oUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sFive , sUserSID IsInValidAccount = False Select Case UCase(oUser.Name) Case "HELPASSISTANT" IsInValidAccount = True Case "ASPNET" IsInValidAccount = True Case "SUPPORT_388945A0" IsInValidAccount = True Case "SQLDEBUGGER" IsInValidAccount = True Case "ACTUSER" IsInValidAccount = True Case "IUSR_" & UCase(oNetwork.ComputerName) IsInValidAccount = True Case "IWAM_" & UCase(oNetwork.ComputerName) IsInValidAccount = True Case "VUSR_" & UCase(oNetwork.ComputerName) IsInValidAccount = True Case UCase(oNetwork.UserName) IsInValidAccount = True Case else If oUser.Get("PasswordExpired") <> 0 Then IsInValidAccount = True ElseIf IsUserLoggedOn(oUser) = True Then IsInValidAccount = True End If End Select ' ~~~ Get the user SID sUserSID = GetUserSID( oUser.Name ) If Left(sUserSID,6) = "S-1-5-" AND Right(sUserSID,4) = "-500" Then ' ~~~ Administrator account IsInValidAccount = True ElseIf Left(sUserSID,6) = "S-1-5-" AND Right(sUserSID,4) = "-501" Then ' ~~~ Guest account IsInValidAccount = True End If End Function ' *** ' *** ------------------------------------------------------------------------------ ' *** Name: IsAccountLocked(oUser) ' *** ------------------------------------------------------------------------------ ' *** Purpose: Returns true if the specified account has a locked profile ' *** ------------------------------------------------------------------------------ Private Function IsAccountLocked(oUser) If NOT DEBUG Then On Error Resume Next Else On Error Goto 0 Dim sProfilePath IsAccountLocked = False sProfilePath = oUser.Profile ' ~~~ If ProfilePath is blank, this account is not roaming and cannot be locked. If sProfilePath = "" Then Exit Function ' ~~~ Need error handling here - if the oFSo call below causes an error that's ok On Error Resume Next ' ~~~ If the ntuser.man exists within, then we have a locked account If oFSo.FileExists(sProfilePath & "\NTUSER.MAN") Then IsAccountLocked = True End Function End Class 
