Evolution

Powershell

Performs an LDAP Search Based on Given Criteria

'********************************************************************
'*
'* File:        SEARCH.VBS
'* Created:     August 1998
'* Version:     1.0
'*
'* Main Function: Performs an LDAP search based on given criteria.
'* Usage: SEARCH.VBS adspath [/C:criteria] [/S:scope] [/P:properties]
'*        [/O:outputfile] [/U:username] [/W:password] [/Q]
'*
'* Copyright (C) 1998 Microsoft Corporation
'*
'********************************************************************

OPTION EXPLICIT
ON ERROR RESUME NEXT

'Define constants
CONST CONST_ERROR                   = 0
CONST CONST_WSCRIPT                 = 1
CONST CONST_CSCRIPT                 = 2
CONST CONST_SHOW_USAGE              = 3
CONST CONST_PROCEED                 = 4

'Declare variables
Dim strOutputFile, intOpMode, blnQuiet, i
Dim strADsPath, strCriteria, strProperties,  strScope, strUserName, strPassword
ReDim strArgumentArray(0)

'Initialize variables
strArgumentArray(0) = ""
blnQuiet = False
strADsPath = ""
strCriteria = "ObjectCategory=*"
strProperties = "ADsPath;"
strScope = "OneLevel"
strUserName = ""
strPassword = ""
strOutputFile = ""

'Get the command line arguments
For i = 0 to Wscript.arguments.count - 1
    ReDim Preserve strArgumentArray(i)
    strArgumentArray(i) = Wscript.arguments.Item(i)
Next

'Check whether the script is run using CScript
Select Case intChkProgram()
    Case CONST_CSCRIPT
        'Do Nothing
    Case CONST_WSCRIPT
        WScript.Echo "Please run this script using CScript." & vbCRLF & _
            "This can be achieved by" & vbCRLF & _
            "1. Using ""CScript SEARCH.vbs arguments"" for Windows 95/98 or" & vbCRLF & _
            "2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
            "    using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
            "    ""SEARCH.vbs arguments"" for Windows NT."
        WScript.Quit
    Case Else
        WScript.Quit
End Select


'Parse the command line
intOpMode = intParseCmdLine(strArgumentArray, strADsPath, strCriteria, strProperties, _
            strScope, blnQuiet, strUserName, strPassword, strOutputFile)
If Err.Number then
    Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
    If Err.Description <> "" Then
        Print "Error description: " & Err.Description & "."
    End If
    WScript.Quit
End If

Select Case intOpMode
    Case CONST_SHOW_USAGE
        Call ShowUsage()
    Case CONST_PROCEED
        Call Search(strADsPath, strCriteria, strProperties, _
             strScope, strUserName, strPassword, strOutputFile)
    Case CONST_ERROR
        'Do nothing.
    Case Else                    'Default -- should never happen
        Print "Error occurred in passing parameters."
End Select

'********************************************************************
'*
'* Function intChkProgram()
'* Purpose: Determines which program is used to run this script.
'* Input:   None
'* Output:  intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
'*          and CONST_CSCRIPT.
'*
'********************************************************************

Private Function intChkProgram()

    ON ERROR RESUME NEXT

    Dim strFullName, strCommand, i, j

    'strFullName should be something like C:\WINDOWS\COMMAND\CSCRIPT.EXE
    strFullName = WScript.FullName
    If Err.Number then
        Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
        If Err.Description <> "" Then
            If Err.Description <> "" Then
                Print "Error description: " & Err.Description & "."
            End If
        End If
        intChkProgram =  CONST_ERROR
        Exit Function
    End If

    i = InStr(1, strFullName, ".exe", 1)
    If i = 0 Then
        intChkProgram =  CONST_ERROR
        Exit Function
    Else
        j = InStrRev(strFullName, "\", i, 1)
        If j = 0 Then
            intChkProgram =  CONST_ERROR
            Exit Function
        Else
            strCommand = Mid(strFullName, j+1, i-j-1)
            Select Case LCase(strCommand)
                Case "cscript"
                    intChkProgram = CONST_CSCRIPT
                Case "wscript"
                    intChkProgram = CONST_WSCRIPT
                Case Else       'should never happen
                    Print "An unexpected program is used to run this script."
                    Print "Only CScript.Exe or WScript.Exe can be used to run this script."
                    intChkProgram = CONST_ERROR
            End Select
        End If
    End If

End Function

'********************************************************************
'*
'* Function intParseCmdLine()
'* Purpose: Parses the command line.
'* Input:   strArgumentArray    an array containing input from the command line
'* Output:  strADsPath          ADsPath of the root of the search
'*          strCriteria         the search criteria
'*          strProperties       properties to be retrieved
'*          strScope            the search scope
'*          strUserName         name of the current user
'*          strPassword         password of the current user
'*          strOutputFile       an output file name
'*          blnQuiet            specifies whether to suppress messages
'*          intParseCmdLine     is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
'*
'********************************************************************

Private Function intParseCmdLine(strArgumentArray, strADsPath, strCriteria, _
        strProperties, strScope, blnQuiet, strUserName, strPassword, strOutputFile)

    ON ERROR RESUME NEXT

    Dim strFlag, i

    strFlag = strArgumentArray(0)

    If strFlag = "" then                'No arguments have been received
        Print "Arguments are required."
        intParseCmdLine = CONST_ERROR
        Exit Function
    End If

    If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
        OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
        intParseCmdLine = CONST_SHOW_USAGE
        Exit Function
    End If

    strADsPath = FormatProvider(strFlag)    'The first parameter must be the ADsPath.

    For i = 1 to UBound(strArgumentArray)
        strFlag = LCase(Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1))
        If Err.Number Then            'An error occurs if there is no : in the string
            Err.Clear
            If LCase(strArgumentArray(i)) = "/q" Then
                blnQuiet = True
            Else
                Print strArgumentArray(i) & " is not recognized as a valid input."
                intParseCmdLine = CONST_ERROR
                Exit Function
            End If
        Else
            Select Case strFlag
                Case "/c"
                    strCriteria = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
                Case "/p"
                    strProperties = Right(strArgumentArray(i), Len(strArgumentArray(i))-3) & ";"
                Case "/s"
                    strScope = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
                Case "/u"
                    strUserName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
                Case "/w"
                    strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
                Case "/o"
                    strOutputFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
                Case else
                    Print "Invalid flag " & """" & strFlag & """" & "."
                    Print "Please check the input and try again."
                    intParseCmdLine = CONST_ERROR
                    Exit Function
                End Select
        End If
    Next

    intParseCmdLine = CONST_PROCEED

End Function

'********************************************************************
'*
'* Sub ShowUsage()
'* Purpose: Shows the correct usage to the user.
'* Input:   None
'* Output:  Help messages are displayed on screen.
'*
'********************************************************************

Private Sub ShowUsage()

    Wscript.Echo ""
    Wscript.Echo "Performs an LDAP search based on a given criteria." & vbCRLF
    Wscript.Echo "SEARCH.VBS adspath [/C:criteria] [/S:scope] [/P:properties]"
    Wscript.Echo "[/O:outputfile] [/U:username] [/W:password] [/Q]"
    Wscript.echo "   /C, /S, /P, /O, /U, /W"
    Wscript.Echo "                 Parameter specifiers."
    Wscript.echo "   adspath       ADsPath of a user object container."
    Wscript.echo "   criteria      Criteria of the search."
    Wscript.echo "   scope         Sope of the search."
    Wscript.echo "   properties    Properties to be retrieved."
    Wscript.Echo "   outputfile    The output file name."
    Wscript.echo "   username      Username of the current user."
    Wscript.echo "   password      Password of the current user."
    Wscript.echo "   /Q            Suppresses all output messages." & vbCRLF
    Wscript.Echo "DEFAULT VALUES:"
    Wscript.Echo "   If /C is not specified the default is ObjectCategory=*."
    Wscript.Echo "   If /S is not specified the default is OneLevel."
    Wscript.Echo "   If /P is not specified the default is ADsPath." & vbCRLF
    Wscript.Echo "EXAMPLE:"
    Wscript.Echo "SEARCH.VBS ""LDAP://DC=FooFoo,DC=Foo,DC=Com"""
    Wscript.Echo "   /C:""&(ObjectCategory=user)(cn=b*)"" /P:Name /S:SubTree"
    Wscript.Echo "   lists names of all users in domain FooFoo with"
    Wscript.Echo "   cn starting with ""b""." & vbCRLF
    Wscript.Echo "NOTE:"
    Wscript.Echo "   This script requires an LDAP provider."

End Sub

'********************************************************************
'*
'* Sub Search()
'* Purpose: Performs an LDAP search based on a given criteria.
'* Input:   strADsPath      ADsPath of the root of the search
'*          strCriteria     the search criteria
'*          strProperties   properties to be retrieved
'*          strScope        the search scope
'*          strUserName     name of the current user
'*          strPassword     password of the current user
'*          strOutputFile   an output file name
'* Output:  Results of the search are either printed on screen or saved in strOutputFile.
'*
'********************************************************************

Private Sub Search(strADsPath, strCriteria, strProperties, _
    strScope, strUserName, strPassword, strOutputFile)

    ON ERROR RESUME NEXT

    Dim strProvider, strSearchPath, objConnect, objCommand
    Dim  objFileSystem, objOutputFile, objRecordSet, intResult

    'Make sure that the provide is LDAP
    strProvider = Left(strADsPath, InStr(1, strADsPath, ":"))
    If strProvider <> "LDAP:" then
        Print "The provider is not LDAP:."
        Wscript.Quit
    End If

    If strOutputFile = "" Then
        objOutputFile = ""
    Else
        'Create a filesystem object
        set objFileSystem = CreateObject("Scripting.FileSystemObject")
        If Err.Number then
            Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object."
            If Err.Description <> "" Then
                Print "Error description: " & Err.Description & "."
            End If
            Exit Sub
        End If
        'Open the file for output
        set objOutputFile = objFileSystem.OpenTextFile(strOutputFile, 8, True)
        If Err.Number then
            Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strOutputFile
            If Err.Description <> "" Then
                Print "Error description: " & Err.Description & "."
            End If
            Exit Sub
        End If
    End If

    strSearchPath =  "<" & strADsPath & ">;"
    strCriteria = "(" & strCriteria & ");"

    Set objConnect = CreateObject("ADODB.Connection")
    If Err.Number then
        Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in opening a connection."
        If Err.Description <> "" Then
            Print "Error description: " & Err.Description & "."
        End If
        Exit Sub
    End If

    Set objCommand = CreateObject("ADODB.Command")
    If Err.Number then
        Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in creating the command object."
        If Err.Description <> "" Then
            Print "Error description: " & Err.Description & "."
        End If
        Exit Sub
    End If

    objConnect.Provider = "ADsDSOObject"
    If strUserName = "" then
        objConnect.Open "Active Directory Provider"
    Else
        objConnect.Open "Active Directory Provider", strUserName, strPassword
    End If
    If Err.Number then
        Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred opening a provider."
        If Err.Description <> "" Then
            Print "Error description: " & Err.Description & "."
        End If
        Exit Sub
    End If

    Set objCommand.ActiveConnection = objConnect

    'Set the query string and other properties
    objCommand.CommandText  = strSearchPath & strCriteria & strProperties & strScope
    objCommand.Properties("Page Size") = 100000                    'reset search properties
    objCommand.Properties("Timeout") = 300000 'seconds
'    objCommand.Properties("SearchScope") = 2

    'After setting all the parameter now execute the search and display the results.
    intResult = intExecuteSearch(objRecordSet, objCommand, objOutputFile)

    If strOutputFile <> "" Then
        objOutputFile.Close
        If intResult > 0 Then
            Wscript.Echo "Results are saved in file " & strOutputFile & "."
        End If
    End If

End Sub

'********************************************************************
'*
'* Function intExecuteSearch()
'* Purpose: Performs an LDAP search based on given criteria
'* Input:   objRecordSet    a recordset to store the info returned
'*          objCommand      the query command object
'*          objOutputFile   an output file object
'* Output:  Results of the search are either printed on screen or saved in objOutputFile.
'*          intExecuteSearch is set to -1 if the search failed or the number of objects
'*          found if succeeded.
'*
'********************************************************************

Private Function intExecuteSearch(objRecordSet, objCommand, objOutputFile)

    ON ERROR RESUME NEXT

    Dim  intNumObjects, i, j , k, intUBound, strMessage

    intNumObjects = 0
    intUBound = 0
    intExecuteSearch = 0

    'Let the user know what is going on
    Print objCommand.CommandText

    'Execute the query
    Set objRecordSet = objCommand.Execute
    Print "Finished the query."
    If Err.Number then
        Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred during the query."
        If Err.Description <> "" Then
            Print "Error description: " & Err.Description & "."
        End If
        Err.Clear
        intExecuteSearch = -1        'failed
        Exit Function
    End If

    'Get the total number of objects found.
    objRecordSet.MoveLast
    intNumObjects = objRecordSet.RecordCount
    intExecuteSearch = intNumObjects    'Succeeded

    If intNumObjects Then                'If intNumObjects is not zero
        Wscript.Echo "Found " & intNumObjects & " objects."
        objRecordSet.MoveFirst
        k = 1
        While Not objRecordSet.EOF
            For i = 0 To objRecordSet.Fields.Count - 1
                intUBound = UBound(objRecordSet.Fields(i).Value)

                If Err.Number Then
                    'This means that it is a single valued property.
                    Err.Clear
                    strMessage = objRecordSet.Fields(i).Name & " " & k & " = " _
                        & objRecordSet.Fields(i).Value
                Else                            'It is a multivalued property.
                    If intUBound = 0 Then        'There is only one implemented
                        strMessage = objRecordSet.Fields(i).Name & " " & k & " = " _
                            & objRecordSet.Fields(i).Value(0)
                    Else                        'It is truely multivalued.
                        strMessage = objRecordSet.Fields(i).Name & " " & k
                        For j = 0 to intUBound
                            strMessage = strMessage & vbCRLF & "     " & j+1 & " " _
                                & objRecordSet.Fields(i).Value(j)
                        Next
                    End If
                End If
                WriteLine strMessage, objOutputFile
            Next
            objRecordSet.MoveNext
            k = k + 1
        Wend
    Else
        Wscript.Echo "No object satisfying the criteria has been found within " _
            & strADsPath & "."
    End If

End Function

'********************************************************************
'*
'* Sub WriteLine()
'* Purpose: Writes a text line either to a file or on screen.
'* Input:   strMessage  the string to print
'*          objFile     an output file object
'* Output:  strMessage is either displayed on screen or written to a file.
'*
'********************************************************************

Sub WriteLine(ByRef strMessage, ByRef objFile)

    If IsObject(objFile) then        'objFile should be a file object
        objFile.WriteLine strMessage
    Else
        Wscript.Echo  strMessage
    End If

End Sub

'********************************************************************
'*
'* Sub Print()
'* Purpose: Prints a message on screen if blnQuiet = False.
'* Input:   strMessage      the string to print
'* Output:  strMessage is printed on screen if blnQuiet = False.
'*
'********************************************************************

Sub Print(ByRef strMessage)
    If Not blnQuiet then
        Wscript.Echo  strMessage
    End If
End Sub

'********************************************************************
'*
'* Function FormatProvider
'* Purpose: Formats Provider so it is not case sensitive
'* Input:   Provider    a string
'* Output:  FormatProvider is the Provider with the correct Case
'*
'********************************************************************

Private Function FormatProvider(Provider)
    FormatProvider = ""
    I = 1
    Do Until Mid(Provider, I, 1) = ":"
        If I = Len(Provider) Then
            'This Provider is Probabaly not valid, but we'll let it pass anyways.
            FormatProvider = Provider
            Exit Function
        End If
        I = I + 1
    Loop

    Select Case LCase(Left(Provider, I - 1))
        Case "winnt"
            FormatProvider = "WinNT" & Right(Provider,Len(Provider) - (I - 1))
        Case "ldap"
            FormatProvider = "LDAP" & Right(Provider,Len(Provider) - (I - 1))   
    End Select


End Function


'********************************************************************
'*                                                                  *
'*                           End of File                            *
'*                                                                  *
'********************************************************************

'********************************************************************
'*
'* Procedures calling sequence: SEARCH.VBS
'*
'*    intParseCmdLine
'*    ShowUsage
'*    Search
'*        intExecuteSearch
'*            WriteLine
'*
'********************************************************************

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

DACL : Set Filesystem and Registry ACL

Option Explicit

' Set Filesystem and Registry ACL
' ===============================
'
' Author: Tobias Oetiker  
'         based on code by Nick Pearce, Craig Paterson and Rich Ellis
'
' Version: 1.2 -- 2001/05/08
'
' Changes: 1.1 Handle non-existing registry keys gracefully.
' Changes: 1.2 Added "K" option for simulating 1777 permission
'
' The purpose of this script is to allow ACL maniputlations
' to be performed by Microsoft Installer Packages (.msi)
'
' Add your ACL modification instructions to this script
' and integrate it as a Custom Action into the MSI.
'
' SETUP
' =====
'
' Note aclfix needs ADsSecurity.dll and RegObj.dll to work. 
' You can get ADsSecurity from ADSI SDK 2.5 under (/ResourceKit/ADsSecurity.dll)
'
' Get the sdk from
' http://msdownload.microsoft.com:80/msdownload/adsi/2.5/sdk/x86/en/Sdk.zip
' copy the dll to a place in your path and run 
'
' RegObj.dll is included in Office 2000 SR2 or also available directly from
' MS for registered VB users.
'
' regsvr32 regobj.dll
' regsvr32 adssecurity.dll 
'
' Usage with WISE for Windows Installer
' =====================================
' * add a copy of the two dlls to the package and install them somewhere
'   below the INSTALLDIR of the package. Make sure you click Self register in
'   the file property dialog
'
' * customize the dacl.vbs according to the needs of the application and add it
'   to the msi somewhere below INSTALLDIR. Maybe next to the dlls
' 
' * Add a custom action: Type:    Call Exe File
'                        Source:  File on destination machine
'                        Name:    DACL
'                        InstDir: SystemFolder
'                        Exe Cmd: wscript.exe "[!dacl.vbs]"  
'                        Sequenc: Install Execute Sequence (Before InstallFinalize)'                        
'    Condition: NOT REMOVE~="ALL"
'                        I-S Opt: System Context
'                        Process: Asynch, Wait at end of sequence
'
' TODO
' ====
' Using Add with the Registry creates working results, but somehow the ACEs are
' not in the proper order, and regedt32 complains when you look at them ...
' it also seems that maybe I am not adding all the reg entries necessary ...
' lack of docu ... sorry ... help appreciated. I guess it has something todo
' with inheritance ... 
'
' USAGE
' -----
'
' DACL function, url, "ace, ace, ..."
'
' function -- Add, Rm, Set
'
' url -- FILE://....       change this File/Folder
'        FILE://c:\home\   change this Folder and everything below
'        FILE://c:\home\\  change this Folder and Folders below
'        RGY://\HKEY_LOCAL_MACHINE\SOFTWARE    change this property
'        RGY://...\  and RGY://\...\\ are the same as indiviual
'                    registry values have no acls assigned
'
' ace -- account:rights
'
' account -- user or group
'
' rights (file) --  F - Full, C - Change, R - Read + Execute, 
'                   S - Read + Write + Execute, L - List
'                   K - Special Case, like 1777. Create file and work with your own only
' rights (registry) --  F - Full, R - Read
'
' EXAMPLES
' --------
' DACL "Add", "FILE://w:\hello.txt", "users:F,moetiker:F"
' DACL "Add", "FILE://w:\hello\",    "users:R,oetiker:F,moetiker:F"
' DACL "Rm",  "FILE://w:\oops.txt",  "user"   'remove whatever is there under user
' DACL "Add",  "FILE://w:\oops.txt",  "user:F" ' add Full control for user
' DACL "Add", "RGY://\HKEY_CURRENT_USER\SOFTWARE\ipswitch\ws_ftp\", "users:F"
'=============================================================================
DumpAcl "FILE://C:"
DACL "Rm", "FILE://C:", "users,CREATOR OWNER"
DACL "Add", "FILE://C:", "users:R"
DACL "Add", "FILE://C:", "users:K"
DumpAcl "FILE://C:"
'=============================================================================
' Implementation
' --------------
Sub DumpAcl (url)
    Dim sd, dacl, ace, sec
    Print url
    Set sec = Wscript.CreateObject("ADsSecurity")
    Set sd = sec.GetSecurityDescriptor( CStr(url) )
    Set dacl = sd.DiscretionaryAcl
    For Each ace In dacl
        Print "   " & ace.trustee & _
              " Type: " & ace.AceType & _
              " Mask: " & ace.AccessMask & _
              " AceFlags: " & ace.AceFlags & _
              " Flags: " & ace.Flags & _
       " OType: " & ace.ObjectType & _
       " IOTyp: " & ace.InheritedObjectType

    Next

    set sec = Nothing
    set sd = Nothing
    set dacl = Nothing
    
End Sub

Sub AclEdit( action, url, acl, UType )
    Dim acls, dacl, dummy, sec, sd, ace, acea, usera, user, perm, acsplit
    Const ADS_ACETYPE_ACCESS_ALLOWED = 0
    Const ADS_ACETYPE_ACCESS_DENIED = 1
    Const ADS_ACEFLAG_INHERIT_ACE = 2
    Const ADS_ACEFLAG_INHERIT_ONLY_ACE         = 8
    Const ADS_ACEFLAG_SUB_NEW = 9

    Print "Edit: " & action & " " & url & " " & acl & " " & utype
    acls = split(acl,",")
    
    Set sec = Wscript.CreateObject("ADsSecurity")
    on error resume Next

    ' without cstr this will break ... !!!
    Set sd = sec.GetSecurityDescriptor( CStr(url) )

    If ErrHandler("Get SD for " & url ) Then
        On Error GoTo 0
        Exit Sub
    End If

    Set dacl = sd.DiscretionaryAcl
    dummy = dacl.AceCount ' this will throw an error if there is no DACL    
    If ErrHandler("Get DACL for " & url ) Then
        On Error GoTo 0
        Exit Sub
    End If

    ' DumpAcl url

'    If action = "Rm" Or action = "Add" Then
    If action = "Rm" Then
        ' for Add we remove the ACEs for the folks for whoom need new ones
        For Each ace In dacl
            acea = split (LCase(ace.trustee & "\" & ace.trustee),"\")
            If acea(0) <> "nt authority" Then
                For Each user In acls
                    usera = split (LCase(user),":")        
                    If acea(1) = usera(0) Then
                        Print "Remove ACE: " & ace.trustee
                        dacl.RemoveACE ace                    
                        ErrHandler("Remove ACE for " & ace.trustee & _
                                   " from " & url)
                    End If
                Next
            End if
        Next

    ElseIf action = "Set" Then
        For Each ace In dacl
            acea = split (LCase(ace.trustee & "\" & ace.trustee),"\")
            If acea(0) <> "nt authority" Then
                dacl.RemoveACE ace
                ErrHandler("Remove ACE for " & ace.Trustee & " from " & url)
                Print "Remove ACE: " & ace.trustee
            End if
        Next    
    Elseif action <> "Add" Then
        Wscript.Echo "Unknown Action: " & action
    End If
    
    If action = "Set" Or action = "Add" Then
        For Each dummy In acls
            acsplit = split (dummy,":")
            user = acsplit(0)
            perm = acsplit(1)
            Print action & " " & utype & " " & user & " " & perm
            Select Case UType
                Case "DIRECTORY"
                    ' folders require 2 aces for user (to do with inheritance)
                    AddFileAce dacl, user, perm, _
                               ADS_ACETYPE_ACCESS_ALLOWED, _
                               ADS_ACEFLAG_SUB_NEW
      if ucase(perm) <> "K" then
                        AddFileAce dacl, user, perm, _
                               ADS_ACETYPE_ACCESS_ALLOWED, _
                               ADS_ACEFLAG_INHERIT_ACE
                    end if
                case "FILE"
                    AddFileAce dacl, user, perm, _
                               ADS_ACETYPE_ACCESS_ALLOWED,0
                case "REGISTRY"
                    AddRegAce dacl, user, perm, _
                              ADS_ACETYPE_ACCESS_ALLOWED, _
                              ADS_ACEFLAG_INHERIT_ACE
            End Select
        Next

    End If

    
    sd.DiscretionaryAcl = dacl
    If ErrHandler("Get SD for " & url ) Then    
        On Error GoTo 0
        Exit Sub
    End If

    sec.SetSecurityDescriptor sd    
   
    If ErrHandler("Get SD for " & url ) Then
        On Error GoTo 0
        Exit Sub
    End If
    
    Set sd = Nothing
    Set dacl = Nothing
    Set sec = Nothing

    ' DumpAcl url

    On Error GoTo 0  
End Sub

Sub AddRegACE(dacl, user, perm , acetype, aceflags)
    ' Add registry ACE
    Dim ace
    
    Const ADS_ACETYPE_ACCESS_ALLOWED = 0
    Const RIGHT_REG_READ = &H20019
    Const RIGHT_REG_FULL = &HF003F

    
    Set ace = CreateObject("AccessControlEntry")
    ace.Trustee = user
    
    Select Case UCase(perm)
        ' specified rights so far only include FC & R. Could be expanded though
        Case "F"
            ace.AccessMask = RIGHT_REG_FULL
        Case "R"
            ace.AccessMask = RIGHT_REG_READ
    End Select
    
    ace.AceType = acetype
    ace.AceFlags = aceflags
    dacl.AddAce ace
    ErrHandler("Add Ace for " & user )

    set ace=Nothing

End Sub

Sub AddFileAce(dacl,user, perm, acetype, aceflags)
    ' add ace to the specified dacl
    Dim ace
    
    Const RIGHT_LIST = &H4
    Const RIGHT_READ = &H80000000
    Const RIGHT_EXECUTE = &H20000000
    Const RIGHT_WRITE = &H40000000
    Const RIGHT_DELETE = &H10000
    Const RIGHT_FULL = 2032127 ' &H10000000
    Const RIGHT_CHANGE_PERMS = &H40000
    Const RIGHT_TAKE_OWNERSHIP = &H80000

    
    Set ace = CreateObject("AccessControlEntry")
    ace.Trustee = user
    
    select case ucase(perm)
        ' specified rights so far only include FC & R. Could be expanded though
        case "F"
            ace.AccessMask = RIGHT_FULL
        case "C"
            ace.AccessMask = RIGHT_READ or RIGHT_WRITE Or _
               RIGHT_EXECUTE or RIGHT_DELETE
        case "R"
            ace.AccessMask = RIGHT_READ or RIGHT_EXECUTE
        case "S" 'Special
            ace.AccessMask = RIGHT_READ or RIGHT_WRITE or RIGHT_EXECUTE
        case "L" 'List
            ace.AccessMask = RIGHT_LIST
        case "K" ' User can Create and work files in the dir specified and nothing else
            ace.AceType = 0
            ace.AccessMask = 1048582 ' create files
     ace.AceFlags = 0
            dacl.AddAce ace
            set ace=Nothing
            Set ace = CreateObject("AccessControlEntry")    
            ace.Trustee = "CREATOR OWNER"
            ace.AccessMask = RIGHT_FULL
            acetype=0
            aceflags=9
    end select
    
    ace.AceType = acetype
    ace.AceFlags = aceflags
    dacl.AddAce ace
    ErrHandler("Add Ace for " & user )

    set ace=Nothing

End Sub
   
Sub DACL(action,url,acl)
    Dim argarry, utype, upath, walk, ftype, fs, rfldr, file, sfldr
    Dim ro, rk, regval,skey
    argarry = split(url,"://")
    utype = argarry(0)
    upath = argarry(1)

    Print "Action: " & action & " " & utype & "--" & upath & " " & acl

    If Right(upath,2) = "\\" Then
        walk = "\\" ' folders only 
        upath = Left(upath, Len(upath)-2)
    ElseIf Right(upath,1) = "\" Then
        walk = "\" ' files and folders
        upath = left(upath, len(upath)-1)      
    End If
    
    If utype = "FILE" Then
        
        Set fs=Wscript.CreateObject("Scripting.FileSystemObject")
        Print "---" & upath
        If fs.FileExists(upath) Then
            Set rfldr=fs.GetFile(upath)
            ftype = "FILE" 'directory
        ElseIf fs.FolderExists(upath) Then
            Set rfldr=fs.GetFolder(upath)
            ftype = "DIRECTORY" 'file
        Else
            ' its neither file nor folder ... maybe it does not exist ...
            wscript.echo "Can't find " & upath
            Exit Sub
        End If
        
        AclEdit action, "FILE://" & rfldr.path, acl, ftype

        If ftype = "FILE" Then 'if this is a file our work is done
            Exit Sub
        End If
        
        If walk = "\" then
            For Each file In rfldr.files
                AclEdit action, "FILE://" & file , acl, "FILE"
            Next
        End If
        
        if walk = "\" or walk = "\\" then 
            for each sfldr in rfldr.subfolders
                DACL action, "FILE://" & sfldr & walk, acl
            next
        end if
        
    elseif utype = "RGY" Then

        Set ro = CreateObject("RegObj.Registry")
        on error resume Next
        Set rk = ro.RegKeyFromString( upath )
        If ErrHandler("Get Registry Key " & upath ) Then
            On Error GoTo 0
            Exit Sub
        End If
        
        AclEdit action, "RGY://" & rk.FullName, acl,"REGISTRY"  
                        
        if walk = "\" or walk = "\\" then
            for each skey in rk.Subkeys
                DACL action,"RGY://" &  skey.FullName & walk, acl
            next
        end If
        
    else
        Wscript.Echo "Unsupported URL Type: " & utype
    end If
    On Error GoTo 0
    
End Sub

Function ErrHandler(what)
    If Err.Number > 0 Then
        WScript.Echo what & " Error " & Err.Number & ": " & Err.Description
        Err.Clear
        Return True
    End If
    ErrHandler = False
End Function

Sub Print(Str)
    'strip when debugging
    'wscript.echo Str
End Sub

Delete Windows Patch Install Folders

Const WINDOWS = &H24&

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(WINDOWS)
Set objFolderItem = objFolder.Self
' Wscript.Echo objFolderItem.Path

Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubfolders FSO.GetFolder(objFolderItem.Path)

Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
        If Right(Subfolder.Name,1) = "$" AND Left(Subfolder.Name,1) = "$" Then
            ' Wscript.Echo Subfolder.Name
            Subfolder.Delete
        End If
        ' Wscript.Echo Subfolder.Path
        ' ShowSubFolders Subfolder
    Next
End Sub

Configure Computer Rights in Active Directory

'**********************************************************************
'
'  Configure Computer Rights in AD
'
'**********************************************************************

'**********************************************************************
'Connecting to the default naming context
'**********************************************************************
Set oRootDSE = GetObject("LDAP://RootDSE")
strNamingContext = oRootDSE.Get("defaultNamingContext")
set oSubscription = GetObject("LDAP://"&strNamingContext)


'**********************************************************************
'Getting the security descriptor of the domain root
'**********************************************************************
on error resume next
set oSecDesc = oSubscription.Get("ntSecurityDescriptor")
set oACL = oSecDesc.DiscretionaryACL
if err.number<>0 then
 wscript.echo "Error : "&error.number&" "&error.description
 wscript.quit(1)
end if


'**********************************************************************
'Create a new ACE giving write access to the comment field of computer objects
'********************************************************************** 
Set objACE = CreateObject("accessControlEntry")
objACE.Trustee = "Domain Computers"
objACE.AccessMask = 32
objACE.AceType = 5
objACE.AceFlags = 10
objACE.Flags = 3
objAce.ObjectType="{BF967A6A-0DE6-11D0-A285-00AA003049E2}"
objACE.InheritedObjectType="{BF967A86-0DE6-11D0-A285-00AA003049E2}"

oACL.AddAce(objACE)
oSecDesc.DiscretionaryACL = oACL


'**********************************************************************
'Write back the security descriptor
'**********************************************************************
oSubscription.Put "ntSecurityDescriptor",oSecDesc
oSubscription.SetInfo
if err.number<>0 then
 wscript.echo "Error : "&error.number&" "&error.description
 wscript.quit(1)
end if

Repair Image Preview in Windows 2000/XP

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\.art\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.bmp\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.dib\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.gif\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.jfif\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.jpe\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.jpg\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.jpeg\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.png\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

[HKEY_CLASSES_ROOT\.wmf\ShellEx\{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}]
@="{7376D660-C583-11d0-A3A5-00C04FD706EC}"

Install WinZIP 8.0/9.0 in Silent Mode

ECHO Install WinZIP 8.0/9.0
if not exist "C:\Program Files\WinZip" md "C:\Program Files\WinZip"
echo d|xcopy /E /C /Q /H /K /O /Y "E:\Install\WinZip" "C:\Program Files\WinZip"
"C:\Program Files\WinZip\WINZIP32.EXE" /noqp /notip /autoinstall

Install .NET Framework 1.1 in Silent Mode

ECHO Install .NET Framework 1.1
L:\IE6F\dotnetfx.exe /q:a /c:"install /l /q"

Install MDAC 2.8 in Silent Mode

ECHO Install MDAC 2.8
D:\MDAC28.exe /Q:A /R:N /C:"DASETUP.EXE /Q /N"

Install Internet Explorer 6 SP1 in Silent Mode

ECHO Install Internet Explorer 6 SP1
"D:\ie6setup.exe" /Q:A /R:N /C:"ie6wzd /S:""#e"" /Q:A /R:N"

Install Windows 2000 MUI in Silent Mode

ECHO Install Windows 2000 french MUI
"E:\W2KMUIFR\MUISETUP.exe" /i 0411 0c0a 040c /d 040c /r /s

REM /i Specifies the user interface language(s) to be installed.
REM 0411 Japanese 0c0a Spanish 040c French
REM /d Specifies the default user interface language (applied to all new user accounts and used in places such as the Winlogon screen)
REM /u Specifies the user interface language(s) to be uninstalled
REM /r Specifies that the reboot message should not be displayed
REM /s Specifies that the installation complete message should not be displayed

Install Oracle 8.1.7 in Silent Mode

ECHO Install Oracle 8.1.7
"D:\install\win32\setup.exe" -responsefile "E:\clientappuser.rsp" -silent

REM SETUP.EXE -RESPONSEFILE FILENAME [-SILENT] [-NOWELCOME]
REM FILENAME = Identifies the specific response file
REM -SILENT = Runs Oracle Universal Installer in complete silent mode. The Welcome window is suppressed automatically.
REM -NOWELCOME = Suppresses the Welcome window that appears during installation

French Keyboard for All Language

Use the same Keyboard System File kbdfr.dll for all language. If you want to use US Keyboard, replace kbdfr.dll by kbdus.dll, if you use German Keyboard, replace kbdfr.dll by kbdgr.dll, etc. Thanks to M. Jacques BEGAINT for this post.

---

REGEDIT4

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\00000404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\00000804]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0010404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0010804]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0020404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0020804]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0030404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0030804]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0040404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0050404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0050804]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0060404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0070404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0080404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E0090404]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E00E0804]
"Layout File" = "kbdfr.dll"
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\E01F0404]
"Layout File" = "kbdfr.dll"

Excel Files Printing Automation

On Error Resume Next

Dim LoadDelay, QuitDelay
'Time to wait in ms(millisecond, 1 second=1000ms) 
LoadDelay = 1000
QuitDelay = 1000

If (WScript.Arguments.Count = 1) Then
  ExcelFileName = WScript.Arguments.Item(0)
Else 
  ExcelFileName = InputBox("Please Enter the Excel File Name > ")
End If

Set objExcel = WScript.CreateObject("Excel.Application")
  objExcel.Visible = False
  objExcel.Workbooks.Open(ExcelFileName)
  WScript.Sleep LoadDelay

  'Print to the default printer
  'Print the first sheet, sheet index starts from 1
  'Set ObjSheet = objExcel.ActiveWorkbook.WorkSheets(1)
  'ObjSheet.PrintOut

  'Print all sheets in the workbook
  objExcel.ActiveWorkbook.PrintOut

  WScript.Sleep QuitDelay

objExcel.ActiveWorkbook.Close(False)

objExcel.Quit

Print Queue Logging

Option Explicit

Dim PrintJobSet, fso, WriteLogFile

On Error Resume Next
Set PrintJobSet = GetObject("winmgmts:").InstancesOf("Win32_PrintJob")
Set fso = CreateObject("Scripting.FileSystemObject")
Set WriteLogFile = fso.OpenTextFile("C:\PrintJobLog.txt", 8)
If Err <> 0 Then
    WriteLogFile.Write "Test Admin Print Queues Failed  " & Err.Description & " " & Err.Number & " " & Now & vbNewLine
ElseIf Err = 0 Then
    WriteLogFile.Write "Test Admin Print Queues Passed  " & Now & vbNewLine
    If (PrintJobSet.Count = 0) Then
        WriteLogFile.Write "No print jobs!" & vbNewLine
    Else  
 WriteLogFile.Write "Number of Jobs are " & PrintJobSet.Count & vbNewLine  
    End If

   For Each PrintJob In PrintJobSet
    WriteLogFile.Write "Name" & vbTab & "JobId" & vbTab & "Status" & vbTab & "TotalPages " & vbNewLine
    WriteLogFile.Write PrintJob.Name & vbTab & PrintJob.JobId & vbTab & PrintJob.Status & vbTab & PrintJob.TotalPages & vbNewLine
    Next
End If

Directory Scan

' Given a root directory, this script will scan for
' subdirectories and will output the size of each subdirectory.

On Error Resume Next

Dim RootDir, FileSystem, RootFolder, SubFolders, Folder
Dim FolderSize, Tmp

If Wscript.Arguments.Count <> 1 Then
 Wscript.Echo "USAGE: dirscan.vbs  [root directory]"
 Wscript.Echo ""
 Wscript.Echo " Given a root directory, dirscan will scan"
 Wscript.Echo " all subdirectories and output the size of"
 Wscript.Echo " each subdirectory."
 Wscript.Quit 0
Else
 RootDir = Wscript.Arguments(0)
 Wscript.Echo "Root directory is: " & RootDir
 Wscript.Echo ""
End If

Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set RootFolder = FileSystem.GetFolder(RootDir)
If Err.Number <> 0 Then
 ' Display the error that occurred
 Wscript.Echo "(" & Err.Number & ") " & Err.Description
 Wscript.Echo ""
 Wscript.Echo "The path that you entered is invalid, please " & _
  "select a different path."
 Wscript.Quit Err.Number
End If

Set SubFolders = RootFolder.SubFolders

For Each Folder In SubFolders
 FolderSize = Folder.Size
 Tmp = FormatNumber(FolderSize, 0, 0, 0, -1)
 Tmp = Right(Space(20) & Tmp, 20)
 Wscript.Echo Tmp & " " & Folder.Path
Next

Print Server Migration

Dim strComputer, sPrinterPath, sPrinterName, sOldPrntSrv, sNewPrntSrv

sOldPrntSrv = "OldPrintServer"
sNewPrntSrv = "NewPrintServer"

Set WshNetwork = CreateObject("WScript.Network")

strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")

For Each objPrinter in colInstalledPrinters
  sPrinterPath = UCase(objPrinter.Name)
  Length = Len(sPrinterPath)
  sPrinterName = Right(sPrinterPath,Length - InStrRev(sPrinterPath,"\"))

  If Instr(sPrinterPath, sNewPrntSrv) Then
    If Length > 27 Then
      WshNetwork.RemovePrinterConnection sPrinterPath
      WshNetwork.AddWindowsPrinterConnection UCase("\\" & sNewPrntSrv & "\" & sPrinterName)
    End If
  End If

  If Instr(sPrinterPath, sOldPrntSrv) Then
    WshNetwork.RemovePrinterConnection sPrinterPath
    WshNetwork.AddWindowsPrinterConnection UCase("\\" & sNewPrntSrv & "\" & sPrinterName)
  End If

Next

VBScript : IfMember and MapNetworkDrive

Set wshnetwork = CreateObject("Wscript.Network")
Set fso = CreateObject("Scripting.FileSystemObject")

Private Function IsMember(groupName)

  Set wshnetwork = CreateObject("WScript.Network")
  domain = wshnetwork.UserDomain
  user = wshnetwork.UserName
  flgIsMember = false
  Set userObj = GetObject("WinNT://" & domain & "/" & user & ",user")
  For Each grp In userObj.Groups
    If grp.Name = groupName Then
      flgIsMember = true
      Exit For
    End If
  Next
  IsMember = flgIsMember
  Set userObj = nothing
  Set wshnetwork = nothing

End Function

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objAdapter In colAdapters 
  If Not IsNull(objAdapter.IPAddress) Then 
    For i = LBound(objAdapter.IPAddress) To UBound(objAdapter.IPAddress)
      address = objAdapter.IPAddress(i)
      VLANX = instr(address, "10.14.3.")
      If VLANX = 1 Then
        IFM = IsMember("GG-VLS-SEN-CAO")
        Set wshnetwork = CreateObject("Wscript.Network")
        user = wshnetwork.UserName
          If IFM = true then 
            If fso.folderexists("X:\")=False Then
              WshNetwork.MapNetworkDrive "X:", "\\Paris\" & user
            Else
              WshNetwork.RemoveNetworkDrive "X:"
              WshNetwork.MapNetworkDrive "X:", "\\Paris\" & user
            End If
          End If
      End If
    Next
  End If
Next

M1 = IsMember("GG-HelpDesk")
Set wshnetwork = CreateObject("Wscript.Network")
user = wshnetwork.UserName
If M1 = true then 
  If fso.folderexists("R:\")=False Then
    WshNetwork.MapNetworkDrive "R:", "\\Tokyo\HelpDesk"
  Else
    WshNetwork.RemoveNetworkDrive "R:"
    WshNetwork.MapNetworkDrive "R:", "\\Tokyo\HelpDesk"
  End If
End If

M2 = IsMember("GG-Project")
Set wshnetwork = CreateObject("Wscript.Network")
user = wshnetwork.UserName
If M2 = true then 
  If fso.folderexists("F:\")=False Then
    WshNetwork.MapNetworkDrive "F:", "\\NewYork\project"
  Else
    WshNetwork.RemoveNetworkDrive "F:"
    WshNetwork.MapNetworkDrive "F:", "\\NewYork\project"
  End If
  If fso.folderexists("M:\")=False Then
    WshNetwork.MapNetworkDrive "M:", "\\NewYork\report"
  Else
    WshNetwork.RemoveNetworkDrive "M:"
    WshNetwork.MapNetworkDrive "M:", "\\NewYork\report"
  End If
End If

M3 = IsMember("GG-HR")
Set wshnetwork = CreateObject("Wscript.Network")
user = wshnetwork.UserName
If M3 = true then 
  If fso.folderexists("R:\")=False Then
    WshNetwork.MapNetworkDrive "R:", "\\Hamilton\HR"
  Else
    WshNetwork.RemoveNetworkDrive "R:"
    WshNetwork.MapNetworkDrive "R:", "\\Hamilton\HR"
  End If
  If fso.folderexists("X:\")=False Then
    WshNetwork.MapNetworkDrive "X:", "\\vls-sen-s04\CV"
  Else
    WshNetwork.RemoveNetworkDrive "X:"
    WshNetwork.MapNetworkDrive "X:", "\\vls-sen-s04\CV"
  End If
End If

M4 = IsMember("GG-Director")
Set wshnetwork = CreateObject("Wscript.Network")
user = wshnetwork.UserName
If M4 = true then 
  If fso.folderexists("H:\")=False Then
    WshNetwork.MapNetworkDrive "H:", "\\NewYork\Director"
  Else
    WshNetwork.RemoveNetworkDrive "H:"
    WshNetwork.MapNetworkDrive "H:", "\\NewYork\Director"
  End If
End If

Windows XP : Very Slow to Open a Session

If Windows XP with MUI Language Pack very slow (more than 10 minutes) to open a session, it's because of difference between the following value. Set all these MultiUILanguageId and MUILanguagePending the same value to resolve this problem.

---

Windows Registry Editor Version 5.00

[HKEY_USERS\S-1-5-18\Control Panel\Desktop]
"MultiUILanguageId"="0000040c"
"MUILanguagePending"="0000040c"

[HKEY_USERS\S-1-5-19\Control Panel\Desktop]
"MultiUILanguageId"="0000040c"
"MUILanguagePending"="0000040c"

[HKEY_USERS\S-1-5-20\Control Panel\Desktop]
"MultiUILanguageId"="0000040c"
"MUILanguagePending"="0000040c"