'
' Customer : ---
' Filename : logon.vbs
' Author : Cédric Rathgeb
' Date : 2006-03-23
' Update : 2006-03-23
' Version : 2.2.5
' Copyright : Public Domain
' Warranty : None
' On Error Resume Next
bDebug = False
dTime1 = now()
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%" ))
sServerFile = "FILESRV"
sServerPrint = "PRINTSRV"
sServerDatabase = "DBSRV"
sRunOnceFile = "U:\runoncefile.txt"
sLDAPPath = "LDAP://dc=domain,dc=com"
sGroup = GetPrimaryGroup(sUser, sLDAPPath)
sGroupUser = Right(sGroup, Len(sGroup) - 5) ' Removes cn=DA from group name
dTime2 = Now()
' The pairs are "drive" and "share"
aryShares = Array(Array("F:", DBS & sServerDatabase & BS & "f_prg$" ), _
Array("G:", DBS & sServerDatabase & BS & "g_dat$" ), _
Array("U:", DBS & sServerFile & BS & sGroupUser & "$" & BS & sUser), _
Array("V:", DBS & sServerFile & BS & sGroupUser & "$" ), _
Array("W:", DBS & sServerFile & BS & "group$" ), _
Array("T:", DBS & sServerFile & BS & "commun$" ))
' The pairs are "printers" and "default printer for computers"
aryPrinters = Array(Array(DBS & sServerPrint & BS & "DmaxDaler", "" ), _
Array(DBS & sServerPrint & BS & "print0001", "da0002;da0003" ), _
Array(DBS & sServerPrint & BS & "print0002", "da0011" ), _
Array(DBS & sServerPrint & BS & "print0004", "da0005" ), _
Array(DBS & sServerPrint & BS & "print0007B", "da0001" ), _
Array(DBS & sServerPrint & BS & "print0008A", "da0004" ), _
Array(DBS & sServerPrint & BS & "print0017", "da0006;da0008" ), _
Array(DBS & sServerPrint & BS & "print0019", "" ))
' 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 (note : removes "Groupe " from 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
dTime3 = Now()
' Remove previous connections
DisconnectDrives
dTime4 = Now()
' Connect shares to local drives
For i = LBound(aryShares) to UBound(aryShares)
aryAux = aryShares(i)
MapDrive aryAux(0), aryAux(1)
Next
dTime5= Now()
' Check if printers are allready installed
Set oFSO = CreateObject("Scripting.FileSystemObject" )
' Get file in user's share and read it
bPrintersInstalled = False
If oFSO.FileExists(sRunOnceFile) Then
Set oTextFile = oFSO.OpenTextFile(sRunOnceFile , 1, 0)
sPrintersText = oTextFile.ReadAll
oTextFile.Close
Set oTextFile = Nothing
' Search if computer is already installed
If InStr(sPrintersText, sComputer) > 0 Then
bPrintersInstalled = True
End If
End If
' Don't redo this part
' of code if printers are allready installed on the computer
If Not(bPrintersInstalled) Then
DisconnectPrinters
' 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
' Add to printer's file the current computer name
Set oTextFile = oFSO.CreateTextFile(sRunOnceFile , True, False)
sPrintersText = sPrintersText & sComputer & vbCrLf
oTextFile.Write sPrintersText
oTextFile.Close
Set oTextFile = Nothing
' Copy shortcuts on User's Desktop
sSource = DBS & sServerDatabase & BS & "F_Prg$" & BS & "SHORTCUT" & BS & "*.*"
sDestinationF = "C:" & BS & "documents and settings" & BS & sUser & BS & "bureau"
sDestinationE = "C:" & BS & "documents and settings" & BS & sUser & BS & "desktop"
oFSO.CopyFile sSource, sDestinationF, True
oFSO.CopyFile sSource, sDestinationE, True
End If
If bDebug Then
msgbox "Ordinateur : " & sComputer & ". " &_
"Temps AD : " & datediff("s", dTime1, dTime2) & ". " &_
"Temps définition : " & datediff("s", dTime2, dTime3) & ". " &_
"Temps disques déconnexion : " & datediff("s", dTime3, dTime4) & ". " &_
"Temps disques connexion : " & datediff("s", dTime4, dTime5) & ". " &_
"Temps imprimantes : " & datediff("s", dTime5, Now()) & ". " &_
"Temps total : " & datediff("s", dTime1, Now()) & "."
End If
' Delete objects
Set oFSO = Nothing
Set wshNetwork = Nothing
Set wshShell = Nothing
Set wshSysEnv = Nothing |