Option Explicit
'-------------------------------------------------------------------------
' nawlogon.vbs
'
' Beschreibung
' generisches Anmeldescript mit Hilfsfunktionen zum Verbinden von Laufwerken etc

' Debug Ausgabe erfolgt im Eventlog
'
' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers
' ausgeführt. Die entsprechenden Berechtigungen sind sicher zu stellen
'
' (c)2006 Net at Work Netzwerksysteme GmbH
'
' Version 1.0 (20. Feb 2006) Frank Carius
'	Initial Release
' Version 1.2 (16. Feb 2010) Frank Carius
'	Gruppen rekursiv addieren  http://technet.microsoft.com/en-us/magazine/2006.03.scriptingguy.aspx
'	function GetGroupmembership addiert   
' Version 1.5 (25. Feb 2010) Frank Carius
'	EventlogAusgabe nur bei Fehler
' Version 1.4 (26. Apr 2010 ) Frank Carius
'	Bug in AddNested korrigiert, Endlosschleife wenn Gruppe in sich selbst mitglied war
'-------------------------------------------------------------------------

' In einer NT4 Umgebung muss das Script umgeschrieben werden. Folgender Code kann als Muster diesnen
' Set WshNetwork = WScript.CreateObject("WScript.Network")
' WScript.Echo "Domain Name: " & WshNetwork.UserDomain
' WScript.Echo "User Name: " & WshNetwork.UserName
' wscript.echo "Bind: " & "WinNT://" & WshNetwork.UserDomain & "/" & WshNetwork.UserName & ",User"
' 
' http://www.rlmueller.net/WinNT_Binding.htm
' Bind ist case sensible auf WinNT://
' set objUser = GetObject("WinNT://" & WshNetwork.UserDomain & "/" & WshNetwork.UserName & ",User")
' 
' Folgender Code erfordert AD-Funktionen (LDAP-Provider) auf dem Client !!!
'on error resume next

dim objNAWLogonHelp

set objNAWLogonhelp = new NAWLogonHelper
objNAWLogonhelp.debug = 3
objNAWLogonhelp.debugfile = "c:\nawlogon.log"
objNAWLogonhelp.logevent 0 , "NAWLogon gestartet"
objNAWLogonhelp.Addstatus "NAWLogon gestartet"

'wscript.echo objNAWLogonhelp.getenv("PATH")


wscript.echo "-----------------------------"
wscript.echo "-------     NAW LOGON  ------"
wscript.echo "-----------------------------"
wscript.echo "Datum/Zeit    :" & now()
wscript.echo "Anmeldename   :" & objNAWLogonhelp.getUserproperty("name")
wscript.echo "dn            :" & objNAWLogonhelp.getUserproperty("distinguishedName")
wscript.echo "Benutzername  :" & objNAWLogonhelp.getUserproperty("displayname")
wscript.echo "Computer      :" & objNAWLogonhelp.getcomputerproperty("name")
wscript.echo "Groupmembership :" & objNAWLogonhelp.GetGroupmembership
wscript.echo "-----------------------------"

wscript.quit

objNAWLogonHelp.run "notepad.exe",7

'~ if objNAWLogonhelp.ismember("CN=Richtlinien-Ersteller-Besitzer,CN=Users,DC=msxfaq,DC=local") then 
if objNAWLogonhelp.ismember("Administrator") then 
	wscript.echo "JA"
else
	wscript.echo "NEIN"
end if

if objNAWLogonhelp.iscomputer("test") then 
	wscript.echo "JA"
else
	wscript.echo "NEIN"
end if

objNAWLogonhelp.mapdrive "QRST", "\\srv01\netlogon", "CN=Richtlinien-Ersteller-Besitzer,CN=Users,DC=msxfaq,DC=local"

objNAWLogonhelp.mapdrive "U", "\\srv01\netlogon","CN=Administrator,CN=Users,DC=msxfaq,DC=local"
objNAWLogonhelp.mapdrive "Q", "\\srv01\netlogon",""
objNAWLogonhelp.mapdriveEx "Q", "","","false","",""
objNAWLogonhelp.mapdriveEx "Q", "\\srv01\netlogon","","false","",""
objNAWLogonhelp.mapdriveEx "Q", "\\srv01\netlogon","","false","",""
objNAWLogonhelp.mapdriveEx "X", "\\srv01\netlogon","","false","",""
objNAWLogonhelp.mapdriveEx "QRST","","","false","",""


objNAWLogonhelp.Addstatus "NAWLogon beendet"
objNAWLogonhelp.logevent 0 , "NAWLogon beendet"
set objNAWLogonhelp = nothing


'
'  ------------------------------------------ Hilfsfunktionen
'


class NAWLogonHelper
' Generische Klasse für im Anmeldescript obt benutzt Funktion
'
' INIT lädt die Daten des aktuellen Benutzers und Computers in den Cache
' CLOSE  schreibt aufgesammelte Statusmeldungen in Eventlog
'
' .LogEvent  schreibt Eventlog
' .AddStatus  addiert Status
'.IfMember  ' works with maximum 1500 Gropumemberships. you have to specify the DN and it must not be the primäry group of the User (so do not use "Domain Users" etc.
'.MapDrive

	dim strresult  ' contains results
	dim objShell, objADSUser, ADSysInfo, objUser, objNet, objGroupList, objGroup, blndebug, dtstarttime, i, strdebugfile

	private Sub Class_Initialize
		Set objShell = CreateObject("wscript.shell")
		Set objNet = CreateObject("WScript.Network")
		Set ADSysInfo = CreateObject("ADSystemInfo") 
		Set objGroupList = CreateObject("Scripting.Dictionary")

		strresult = ""
		blndebug = 1
		dtstarttime = now()
		AddStatus("NAWHelper:ADSystemInfo")
		AddStatus("NAWHelper:INIT:Username    :" & ADSysInfo.UserName)
		AddStatus("NAWHelper:INIT:AD-Sitename :" & ADSysInfo.Sitename)
		AddStatus("NAWHelper:INIT:BindString  :WinNT://" & objnet.Userdomain & "/" & objNet.Username & ",User")
		
		Set objUser = GetObject("WinNT://" & objnet.Userdomain & "/" & objNet.Username & ",User")
		Set objADSUser = GetObject("LDAP://" & ADSysInfo.UserName)

		if err.number <> 0 then 
			strresult = strresult & vbcrlf & "NAWHelper:ERROR at GetObject"
			err.clear
		end if 

		AddStatus("NAWHelper:INIT:LDAP-Info")
		AddStatus("NAWHelper:INIT:LDAP-Name :" & objADSUser.name)
		AddStatus("NAWHelper:INIT:LDAP-DN   :" & objADSUser.distinguishedname)
		
		objGroupList.CompareMode = vbTextCompare
		
		wscript.echo "NAWHelper:INIT:MemberOf : Start collecting group" 
		
		For Each objGroup In objADSUser.GetEx("memberOf")
			call AddNested(objGroup)
		Next
		Set objGroup = Nothing
		wscript.echo "NAWHelper:INIT:MemberOf : Done collecting group" 

		objGroupList(ADSysInfo.UserName) = True  ' DN User als "member" addieren damit "map" auch dann zutrifft
		AddStatus("NAWHelper:INIT:MemberOf :" & ADSysInfo.UserName)
		objGroupList(objNet.Username) = True  ' User als "member" addieren damit "map" auch dann zutrifft
		AddStatus("NAWHelper:INIT:MemberOf :" & objNet.Username)
		
		if err.number <> 0 then 
			objShell.logevent 3, "NAWHelper:INIT:ERROR at Memberlist"
			err.clear
		end if 	
	End Sub

	private Function AddNested(objNestedGroup)

		dim strMember, objCurrentGroup, arrlist 
		AddStatus("NAWHelper:INIT:MemberOf nestet:" & objNestedGroup)		
		Set objCurrentGroup = GetObject("LDAP://" & objNestedGroup)

		if objGroupList.Exists(objCurrentGroup.samaccountname)  then 
			AddStatus("NAWHelper:INIT:MemberOf :" & objCurrentGroup.samaccountname &" already in list")
		else
			AddStatus("NAWHelper:INIT:MemberOf :" & objCurrentGroup.samaccountname & " Added to List")
			objGroupList(objCurrentGroup.samaccountname) = True
			
			on error resume next
			arrlist = objCurrentGroup.GetEx("memberOf")
			if err.number = 0 then 
				on error goto 0
				For Each strMember in arrlist 
					AddNested(strMember)
				Next
			else
				AddStatus("NAWHelper:INIT:MemberOf : no more subgroups")
				err.clear
				on error goto 0
			end if
			
		end if 

	End Function


	public Property let debug(wert)
		blndebug = wert
	End Property

	public Property let debugfile(wert)
		strdebugfile = wert
	End Property
	
	sub LogEvent (intserverity,strmessage)
	'// Generates an eventlog entry and adds it to the summary //
		objShell.logevent intserverity , strmessage
		AddStatus("Event logged:" & intserverity & ":"&  strmessage)
	end sub

	sub AddStatus (strmessage)
	'// add status to the summary //		
		strresult = strresult & vbcrlf & now() & ":" & strmessage
		if blndebug > 0 then wscript.echo now() & ":" & strmessage
	end sub

	sub MapDrive (strdrives, strpath, strgroup)
		' strdrives = single driveletter to use (remap existing drive)
		'		= list of letters you want to use. will use first availible letter
		'strpath  = UNC Path to network share
		'strgroup  = DN of group or Username. map only if match
		'		= if empty -> remove mapping
		MapDriveEx strdrives, strpath, strgroup, "false", "",""
	end sub

	sub MapDriveEx (strdrives, strpath, strgroup, blnprofile, strUser, strpass)
		
	
		dim AllDrives, blnMapped, i, strMappedDrives, chrdrive, blnJobDone

		AddStatus("NAWHelper:MapDrive:map " & strdrives & " to " & strpath)

		if (strgroup = "") or objGroupList.Exists(strGroup) then  ' only work, if member of group or no group specified
			strdrives = ucase(strdrives)

			strMappedDrives = ""
			blnJobDone = false
			
			Set AllDrives = objNet.EnumNetworkDrives() 
			For i = 0 To AllDrives.Count - 1 Step 2 
				strMappedDrives = strMappedDrives & left(AllDrives.Item(i),1)
			Next 
			if err.number <> 0 then 
				objShell.logevent 3, "NAWHelper:MapDrive:ERROR at GetLocalDrives"
				err.clear
			end if 
			AddStatus("NAWHelper:MapDrive:MappedDrives = " & strMappedDrives)

			for i = 1 to len(strdrives)											'Loop all possible drive letters
				chrdrive = mid(strdrives,i,1)										'current Drive
				blnMapped = ((instr(strMappedDrives,chrdrive) <>0))					'is current drive mapped ?
				
				if 	(strpath = "") then
					if blnMapped = true then 								' letter found. Try to remove mapping
						AddStatus("NAWHelper:MapDrive:Drive " & chrdrive & " removing")
						on error resume next
						objNet.removeNetworkDrive chrdrive &":"
						ErrCheck Err.Number,"NAWHelper:MapDrive:Error removing" & chrdrive 
						blnJobDone = true
					else
						AddStatus("NAWHelper:MapDrive:Drive " & chrdrive & " not mapped. can't remove")
					end if 
				else ' Try to map the network path
					if blnMapped = false then 
						AddStatus("NAWHelper:MapDrive:Drive " & chrdrive & " mapping to "  & strpath)
						on error resume next
						if strUser = "" then 
							objNet.MapNetworkDrive chrdrive & ":", strpath, blnprofile
						else
							objNet.MapNetworkDrive chrdrive & ":", strpath, blnprofile, strUser, strpass
						end if
						ErrCheck Err.Number,"NAWHelper:MapDrive:Drive " & chrdrive & " mapping to "  & strpath
						blnJobDone = true
						exit für   ' done. exit here of Rangeloop
					else
						if len(strdrives) = 1 then 
							AddStatus("NAWHelper:MapDrive:Drive " & chrdrive & " remapping to "  & strpath)
							objNet.removeNetworkDrive chrdrive&":"
							if strUser = "" then 
								objNet.MapNetworkDrive chrdrive & ":", strpath, blnprofile
							else
								objNet.MapNetworkDrive chrdrive & ":", strpath, blnprofile, strUser, strpass
							end if
							ErrCheck Err.Number,"NAWHelper:MapDrive:Drive " & chrdrive & " remapping to "  & strpath
							blnJobDone = true
							exit for
						else ' RANGE MAPPING so find next free lette in the range" the drive
							AddStatus("NAWHelper:MapDrive:Drive " & chrdrive & " in use. try next one")
						end if 
					end if
				end if
			next
			if blnJobDone = false then
				AddStatus("NAWHelper:MapDrive:RangeMap FAILED:" & strdrives & " TO "  & strpath)
				objShell.logevent 1, "NAWHelper:MapDrive:Error RangeMap Code:" & err.number & " " & err.description
			end if 
		else 
			AddStatus("NAWHelper:MapDrive:Drive " & strdrives & " NOT IN GROUP " & strgroup & "to map " & strpath)
		end if	
	end sub

	function getUserproperty(strProperty)

		getUserproperty = objADSUser.get(strProperty)
		if err.number <> 0 then 
			AddStatus("NAWHelper:GetUserProperty:ERROR at Get:" & strProperty)
			err.clear
		end if 
	end function

	function getcomputerproperty(strProperty)

		select case lcase(strProperty)
		case "name"
			getcomputerproperty = objNet.computername
		case "adsite"
			getcomputerproperty = ADSysInfo.Sitename
		case else
			getcomputerproperty = "invalid parameter"
			AddStatus("NAWHelper:GetComputerProperty:Invalid Parameter:" & strProperty)
		end select
		
		if err.number <> 0 then 
			AddStatus("NAWHelper:GetComputerProperty:ERROR at Get:" & strProperty)
			err.clear
		end if 
	end function

	function GetGroupmembership
		GetGroupmembership = join(objGroupList.keys,vbtab)
	end function 

	function ismember (strGroup)
		ismember = objGroupList.Exists(strGroup)
	end function
	
	function GetEnv(strproperty)
	' liest environment aus
		GetEnv = objshell.environment("PROCESS")(UCASE(strproperty))
		if err.number <> 0 then 
			objShell.logevent 2, "NAWHelper:GetEnv:Error at " & strproperty
			err.clear
		end if 
	end function

	function run(strcommand,intOption)
	' startet externes Programm
	' intOption   7 =   ' wait für exit and start window minimized
		dim objWshShell, intresult
		Set objWshShell = CreateObject("WScript.Shell")
		intresult = objWshShell.run(strcommand,intOption,true)
		if intresult <> 0 then 
			objShell.logevent 3, "Errr " & intresult & "Starting " & strcommand
		end if
		run = intresult
	end function


	private sub ErrCheck (intErrCode,strMessage)

		if blndebug > 0 then 
			msgbox "Error:" & intErrCode & vbcrlf _
				& "Text:" & err.description & vbcrlf _
				& "Message:"& strMessage
		end if
		
		if err.number <> 0 then 
			objShell.logevent 1,  "Error  :" & intErrCode & vbcrlf _
							& "Text   :" & err.description & vbcrlf _
							& "Message:" & strMessage
		
			err.clear
		end if 
	end sub

	sub Class_Terminate()
		
		dim txtfile
		
		AddStatus "NAWHelper:Laufzeit:" & formatdatetime(now()-dtStartTime,vbLongTime)
		AddStatus "NAWHelper:Writing Status"
		for i = 1 to len(strresult) step 32000
			objShell.logevent 0, mid(strresult,i,32000)
		next
			
		if strdebugfile <> "" then
			'Set fs = CreateObject("Scripting.FileSystemObject")
			Set txtfile = CreateObject("Scripting.FileSystemObject").OpenTextFile(strdebugfile, 2, True) ' ForWriting
			txtfile.writeline strresult
			txtfile.Close
		end if 
	end sub
end class