'
' Customer :
' Filename : logon.vbs
' Author : Cédric Rathgeb
' Date : 2005-06-20
' Version : 2.1.3
' Copyright : Public Domain
' Warranty : None
'
On Error Resume Next
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
BS = Chr(92) ' Backslash
DBS = BS & BS ' Double Backslash
Set wshNetwork = WScript.CreateObject("WScript.Network" )
Set wshShell = WScript.CreateObject("WScript.Shell" )
Set wshSysEnv = wshShell.Environment("SYSTEM" )
sUser = LCase(wshShell.ExpandEnvironmentStrings("%USERNAME%" ))
sComputer = LCase(wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%" ))
sServer = "monserveur1"
sLDAPPath = "LDAP://dc=domain,dc=local"
sGroup = GetPrimaryGroup(sUser, sLDAPPath)
Select Case LCase(sGroup)
Case "juridique", "marketing", "secrétariat général"
sGroupUser = "état major" & BS & sGroup
sGroup = "état major"
Case "cave", "divers", "services aux locataires", "valeurs"
sGroupUser = "divers" & BS & sGroup
sGroup = "divers"
Case Else
sGroupUser = sGroup
End Select
' The pairs are "drive" and "share"
aryShares = Array(Array("T:", DBS & sServer & BS & "ClientApps" ), _
Array("U:", DBS & sServer & BS & "utilisateurs$" & BS & sGroupUser & BS & sUser), _
Array("V:", DBS & sServer & BS & "groupes$" & BS & sGroup & BS & "@commun" ), _
Array("W:", DBS & sServer & BS & "groupes$" ), _
Array("X:", DBS & sServer & BS & "commun$" ))
' The pairs are "printers" and "default printer for computers"
aryPrinters = Array(Array(DBS & sServer & BS & "comptabilite_hp_laserjet_color_4600n", "apicella;laureau" ), _
Array(DBS & sServer & BS & "comptabilite_hp_laserjet_5", "andre" ), _
Array(DBS & sServer & BS & "couloir_hp_laserjet_4050n", "bchatelain;ecuyer;reception1;reserve;schmid" ), _
Array(DBS & sServer & BS & "couloir_hp_laserjet_5si", "" ), _
Array(DBS & sServer & BS & "couloir_oki_9200c", "" ), _
Array(DBS & "golay" & BS & "quai_hp_psc_2210", "" ), _
Array(DBS & "magasin" & BS & "quai_hp_laserjet_3015", "magasin", "" ), _
Array(DBS & "treand" & BS & "quai_hp_laserjet_1012", "treand;lacotte", "" ), _
Array(DBS & "arianne" & BS & "etatmajor_brother_hl_1230", "arianne;may", "" ), _
Array(DBS & "benoist" & BS & "valeur_hp_980cxi", "benoist;flilipone" ))
' Search account in Active Directory
' Return AD distinguished name or an empty string if not found
Function GetADDistinguishedName(sAccount, sADPath)
Set oConnection = CreateObject("ADODB.Connection" )
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command" )
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<" & sADPath & ">;(&(objectCategory=User)(samAccountName=" & sAccount & " ));samAccountName,distinguishedName;subtree"
Set oRecordSet = oCommand.Execute
If oRecordset.RecordCount = 0 Then
' Not found !
GetADDistinguishedName = ""
Else
GetADDistinguishedName = oRecordset.Fields("distinguishedName" )
End If
oConnection.Close
End Function
' Get groups a user belongs to
' Return an array or empty
Function GetADGroupsUserBelongsTo(sAccount, sADPath)
Set oUser = GetObject("LDAP://" & GetADDistinguishedName(sAccount, sADPath))
aryMemberOf = oUser.GetEx("memberOf" )
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
' Not Fount !
GetADGroupsUserBelongsTo = Array()
Else
GetADGroupsUserBelongsTo = aryMemberOf
End If
End Function
' Get primary group for this user
' Return a string with groupname
' an empty string if not found
Function GetPrimaryGroup(sAccount, sADPath)
Set oUser = GetObject("LDAP://" & GetADDistinguishedName(sAccount, sADPath))
iPrimaryGroupID = oUser.Get("primaryGroupID" )
If Not(Err.Number = E_ADS_PROPERTY_NOT_FOUND) Then
Set oConnection = CreateObject("ADODB.Connection" )
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command" )
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<" & sADPath & ">;(objectCategory=Group);distinguishedName,primaryGroupToken;subtree"
Set oRecordSet = oCommand.Execute
Do Until oRecordset.EOF
If oRecordset.Fields("primaryGroupToken" ) = iPrimaryGroupID Then
sGroup = oRecordset.Fields("distinguishedName" )
End If
oRecordset.MoveNext
Loop
sGroup = Left(sGroup, InStr(sGroup, "," ) - 1)
GetPrimaryGroup = sGroup
oConnection.Close
Else
GetPrimaryGroup = ""
End If
End Function
' Disconnects all drives
Sub DisconnectDrives()
' Connect drives
Set colDrives = wshNetwork.EnumNetworkDrives
For i = 0 To colDrives.Count - 1 Step 2
wshNetwork.RemoveNetworkDrive colDrives(i)
Next
End Sub
' Map drive
Sub MapDrive(sDrive, sShare)
wshNetwork.MapNetworkDrive sDrive, sShare
End Sub
' Disconnect all printers
Sub DisconnectPrinters()
Set colPrinters = wshNetwork.EnumPrinterConnections
For i = 0 To colPrinters.Count - 1 Step 2
wshNetwork.RemovePrinterConnection colPrinters(i)
Next
End Sub
' Map printer
Sub MapPrinter(sPrinter)
wshNetwork.AddWindowsPrinterConnection sPrinter
End Sub
' Set Default Printer
Sub SetDefaultPrinter(sPrinter)
wshNetwork.SetDefaultPrinter sPrinter
End Sub
' Remove previous connections
DisconnectDrives
DisconnectPrinters
' Connect shares to local drives
For i = LBound(aryShares) to UBound(aryShares)
aryAux = aryShares(i)
MapDrive aryAux(0), aryAux(1)
Next
' Connect printers
For i = LBound(aryPrinters) to UBound(aryPrinters)
aryAux = aryPrinters(i)
MapPrinter aryAux(0)
aryComputers = Split(aryAux(1), ";" )
For j = LBound(aryComputers) to UBound(aryComputers)
If sComputer = aryComputers(j) Then
SetDefaultPrinter(aryAux(0))
End If
Next
Next
' Copy Icons on User's Desktop
Set oFSO = CreateObject("Scripting.FileSystemObject" )
sSource = DBS & "monserveur1" & BS & "ClientApps" & BS & "icons" & BS & "*.*"
sDestination = "C:" & BS & "documents and settings" & BS & sUser & BS & "bureau"
oFSO.CopyFile sSource, sDestination, True
Set oFSO = Nothing
' Add default paths keys for Word and Excel XP & 2003
wshShell.Run("regedit /s word_excel_paths.reg" )
' Delete objects
Set wshNetwork = Nothing
Set wshShell = Nothing
Set wshSysEnv = Nothing |
