Per Login Script Active Directory Objekte auslesen und Shares Zuordnen (Shares und Printers)

On Error Resume Next
Dim objFSO,objFILE,objShell,objNetwork
set objFSO=CreateObject("Scripting.FileSystemObject")  
set objShell=CreateObject("Wscript.Shell")  
set objNetwork=CreateObject("Wscript.Network")  

strHelpMsg="Hast Du Probleme? Dan löse sie! ;-) "  
iErrorTimeout=10
blnShowError=Wahr

'Verbinden der Netzlaufwerke nach Gruppenzugehörigkeit  
If IsAMemberOf(objNetwork.UserDomain,objNetwork.UserName,"Domain Users") Then MapIt "G:","\\FILE01\Data"  

'Verbinden der Printqueues nach Gruppenzugehörigkeit  
If IsAMemberOf(objNetwork.UserDomain,objNetwork.UserName,"Domain Users") Then AddPrinterConnection "\\Print01\HpLaserJ"  
' Standarddrucker setzen  
objNetwork.SetDefaultPrinter "\\Print01\HpLaserJ"  

'Unabhängiges Verbinden von Laufwerken  
MapIt "R:","\\FILE02\Public"  
'Unabhängiges Verbinden von Printqueues  
 AddPrinterConnection "\\Print01\HPDK1220c"  




'Erstellen der Zusammenfassung  
iDisplayTimeout=2
strMsg=""  
strMsg=strMsg & vbcrlf
strMsg=strMsg & vbcrlf
'enumerate drives  
Set objDrives = objNetwork.EnumNetworkDrives
strMsg=strMsg & "Network drive mappings:" & vbcrlf  
For i = 0 to objDrives.Count - 1  Step 2
  strMsg=strMsg & "Drive " & objDrives.Item(i) & "=" & objDrives.Item(i+1) & vbcrlf   
Next
strMsg=strMsg & vbcrlf

'Anzeigen der Zusammenfassung  
If strMsg<>"" Then objShell.Popup strMsg,iDisplayTimeout,"Logon Summary",vbOKOnly+vbInformation  
'End of main script  

'//////////////////////////////////////////////////  
Function PasswordExpires(strDomain,strUser)
On Error Resume Next
Dim objUser
Set objUser=GetObject("WinNT://" & strDomain & "/" & strUser & ",user")  
PassExp=INT(objUser.MaxPasswordAge/86400)-INT(objUser.PasswordAge/86400)

If PassExp<0 Then 
 strPassMsg="Your password never expires."  
Else
 strPassMsg="Your password expires in " & PassExp & " day(s)"  
end If

PasswordExpires=strPassMsg
End Function

Function IsAMemberOf(strDomain,strUser,strGroup)
On Error Resume Next
Set objUser=GetObject("WinNT://" & strDomain & "/" & strUser & ",user")  
Set objGrp=GetObject("WinNT://" & strDomain & "/" & strGroup & ",group")  

If objGrp.IsMember(objUser.ADsPath) Then
	IsAMemberOf=True
Else
	IsAMemberOf=False
End If 

End Function

Sub MapIt(strDrive,strMap)
On Error Resume Next
If objFSO.DriveExists(strDrive) Then objNetwork.RemoveNetworkDrive(strDrive)

objNetwork.MapNetworkDrive strDrive,strMap

If Err.Number<>0 And blnShowError Then
	strMsg="There was a problem mapping drive " & UCase(strDrive) & " to " &_  
	strMap & VbCrLf & strHelpMsg & VbCrLf & "Error#:" & Hex(err.Number) &_  
	VbCrLf & Err.Description
	objShell.Popup strMsg,iErrorTimeOut,"Error",vbOKOnly+vbExclamation  
	Err.Clear
End If

End Sub

Sub AddPrinterConnection(strPrinterUNC)
On Error Resume Next

objNetwork.AddWindowsPrinterConnection strPrinterUNC

If Err.Number<>0 And blnShowError Then
	strMsg="There was a problem mapping " & UCase(strPrinterUNC) & ". " &_  
	vbcrlf & VbCrLf & strHelpMsg & VbCrLf & "Error#:" & Hex(err.Number) &_  
	VbCrLf & Err.Description
	
	objShell.Popup strMsg,iErrorTimeOut,"Error",vbOKOnly+vbExclamation  
	Err.Clear
End If

end sub

Sub AddPrinterPortConnection(strPort,strPrinterUNC)
On Error Resume Next

objNetwork.AddPrinterConnection strPort,strPrinterUNC

If Err.Number<>0 And blnShowError Then
	strMsg="There was a problem mapping " & UCase(strPrinterUNC) & " to " &_  
	strPort & vbcrlf & VbCrLf & strHelpMsg & VbCrLf & "Error#:" & Hex(err.Number) &_  
	VbCrLf & Err.Description
	
	objShell.Popup strMsg,iErrorTimeOut,"Error",vbOKOnly+vbExclamation  
	Err.Clear
End If

end sub