'==========================================================================================================================
' NAME: UserDiscovery.vbs
'
' AUTHOR: Mathias Haas, Fidelity Consulting AB. 
'         mathias.haas@fidelityconsulting.se
' DATE  : 2013-09-10
' Version : 1.1
' COMMENT: This script does User Discovery for SCCM based on the current computername
' V1.0 Original Version
' V1.1 Added ability to take arguments from SMS Client and Current Computername (See line 36).
' V1.2 If Script Argument /Local is used the script gets Computername and Site Code from the local host through WMI. 
'      (Good if you're running the script through a TS)
'==========================================================================================================================
Option Explicit

Dim sUserDomain, sComputerName, wShell, sLDAPDomainName, colNamedArguments
dim connection, computer, sUserName, sUserPassword, sCollectionID,sTopSiteServer,ListOfResources1,Resource1,sManagedByAttrib
dim sLogfile
Dim sSiteCode, sServer, sLocal
Dim oClient
Dim colGroups, objGroup
Dim key, SiteDic, i
Dim arrGroups()

Set wShell = WScript.CreateObject( "WScript.Shell" )
Set colNamedArguments = WScript.Arguments.Named

sUserName = ""
sUserPassword = ""
sTopSiteServer = "WFS0021a" 'This is the top SCCM site server of your organization.
sLDAPDomainName = "LDAP://OU=PROD,OU=Fujitsu,OU=Contractors,DC=corp1,DC=ad1,DC=seb,DC=net" 'This is the LDAP-path of where your computers are in your OU.
sLogfile = Replace(WScript.ScriptFullName,WScript.ScriptName,"") & Replace (WScript.ScriptName,".vbs","") & ".log"
sUserDomain    = wShell.ExpandEnvironmentStrings( "%USERDOMAIN%" )

' ### Begin ###
Call LogToFile(Now() & " - ### Script started")

'### 1. Find current computername / Site
If colNamedArguments.Exists("Computername") = True And colNamedArguments.Exists("SiteCode") = True Then

	sComputerName = colNamedArguments.Item("Computername") '	/Computername:%msgsys  <- Parameter in Status Filter Rules
	sSiteCode     = colNamedArguments.Item("SiteCode")     '    /Sitecode:%msgsc	   <- Parameter in Status Filter Rules
	
ElseIf len(sComputerName) = False  And len(sSiteCode) = False And colNamedArguments.Exists("Local") = False Then

	Call LogToFile(Now() & " - !!! Script needs argument /Computername and /SiteCode or only the argument /Local. " & vbLf &_
    "                          Argument /Local will find Site Code (and computername!) from the computer the script is run on. " & vbLf &_
	"                          Examples: cscript.exe UserDiscovery.vbs /Computername:B5831114 /SiteCode:600" & vbLf &_
	"                                    cscript.exe UserDiscovery.vbs /Local" & vbLf & vbLf &_
	Now() & " ### Exiting Script.")
	
	WScript.Quit (1)
	
ElseIf len(sComputerName) = False  And len(sSiteCode) = False And colNamedArguments.Exists("Local") = True Then
	'Call FindSiteCode()
	WScript.echo "Running in Local Mode."
	 sComputerName = wShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" ) 
 	 Set oClient = CreateObject("Microsoft.SMS.Client")
  	 sSiteCode = oClient.GetAssignedSite
end if

Call LogToFile(Now() & " Current host: "  & sComputerName)
Call LogToFile(Now() & " Assigned Site: " & sSiteCode)

'### 2. Find ManagedBy-attribute in AD.
Call CheckManagedBy(sComputerName)
Call LogToFile(Now() & " Primary User: " & sManagedByAttrib)

'### 3. Find group membership for Managed-by User
Call GroupMemberShip(sManagedByAttrib)

'#### 5. Find right SCCM-server and create the DDR there.

Call LookupSiteServer(sTopSiteServer,sSiteCode)

call LogToFile(Now() & " - ### Script finished" & vblf)
wscript.quit (0)

' --------------- FUNCTIONS ------------------

Function LookupSiteServer(Server,SiteCode)

Set connection = Connect(Server,sUserName,sUserPassword)
If Err.Number<>0 Then
    Call LogToFile(Now() & "Call to connect failed") : WScript.Quit(1)
End If

 Const wbemFlagReturnImmediately = 16
 Const wbemFlagForwardOnly = 32
    ' Set required variables.
 Dim Query,SiteParams,SiteRow
 SET SiteDic = CreateObject("Scripting.Dictionary")  
        
 ' WMI Query for all Sites + Sitecode
 Query = "select ServerName from SMS_Site where SiteCode = '"&SiteCode&"'"
    
    ' Run query.
    Set SiteParams = connection.ExecQuery(Query, , wbemFlagForwardOnly Or wbemFlagReturnImmediately)
        For Each SiteRow In SiteParams
                  	sServer= SiteRow.ServerName
        Next   
   
   'Create the Data Discovery Record for this site
   Call LogToFile(Now() & " Site server for : " & SiteCode & " = " & sServer)     
   Call CreateNewDDR(SiteCode,sManagedByAttrib,arrGroups)
End Function

Function FindSiteCode()

  'On Error Resume Next
  'Set swbemLocator = CreateObject("WbemScripting.SWbemLocator")
  'Set swbemconnection = swbemLocator.ConnectServer("Localhost", "root\ccm")
  'Set sSiteCode = swbemconnection.ExecQuery("Select * From SMS_R_System where name like 'B%' and Active = '1' and Client = '1' and Decommissioned = '0' and Obsolete = '0'")
   
  

  'On Error GoTo 0

End Function

Function Connect(server, userName, userPassword)
    Dim net
    Dim localConnection
    Dim swbemLocator
    Dim swbemServices
    Dim providerLoc
    Dim location
    
    Set swbemLocator = CreateObject("WbemScripting.SWbemLocator")

    swbemLocator.Security_.AuthenticationLevel = 6 'Packet Privacy
    
    ' If  the server is local, don't supply credentials.
    Set net = CreateObject("WScript.NetWork") 

    ' Connect to the server.
    Set swbemServices= swbemLocator.ConnectServer _
            (server, "root\sms",userName,userPassword)
    If Err.Number<>0 Then
        Call LogToFile(Now() & "Couldn't connect: " + Err.Description)
        Connect = null
        Exit Function
    End If
    
    ' Determine where the provider is and connect.
    Set providerLoc = swbemServices.InstancesOf("SMS_ProviderLocation")

        For Each location In providerLoc
            If location.ProviderForLocalSite = True Then
                Set swbemServices = swbemLocator.ConnectServer _
                 (location.Machine, "root\sms\site_" + location.SiteCode,userName,userPassword)
        '         WScript.Echo "Connected to : " & location.Machine & "\" & location.SiteCode
                If Err.Number<>0 Then
                    Call LogToFile(Now() & "Couldn't connect:" + Err.Description)
                    Connect = Null
                    Exit Function
                End If
                Set Connect = swbemServices
                Exit Function
            End If
        Next
    Set Connect = null ' Failed to connect.
End Function

' ===========================================================================================================
Function GroupMemberShip(User)
Dim objUser
Set objUser = GetObject("LDAP://" & User)
Set colGroups = objUser.Groups
i=0
For Each objGroup in colGroups
	ReDim Preserve arrGroups(i+1)
    arrGroups(i) = objGroup.CN
    Call LogToFile(Now() & " Member groups: " & arrGroups(i))
    i=i+1
Next
End Function

' ===========================================================================================================

Function CheckManagedBy(Name)
dim Location,objConnection,objCommand,objRecordSet,sPath,sManagedBy

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

' ---- Find Computer in AD ---
objCommand.CommandText = "Select Name, ADsPath from '"&sLDAPDomainName&"' where objectClass='computer' and Name = '" & Name & "'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
on error resume Next
Set objRecordSet = objCommand.Execute
	sPath = objRecordSet.Fields("ADsPath").Value
	If Err.Number<>0 Then
                    Call LogToFile(Now() & " - Error: " & Err.Description)
                    WScript.Quit(1)
	end if
on error goto 0
'wscript.echo "ADsPath: " & sPath

objCommand.CommandText = "SELECT Name, managedBy FROM '"&sPath&"' WHERE objectclass='computer' and Name = '" & Name & "'"

Set objRecordSet = objCommand.Execute

sManagedByAttrib = Null
sManagedBy = objRecordSet.Fields("managedBy").Value
if sManagedBy <> "null" Then
    'Wscript.Echo "Name: " 		& objRecordSet.Fields("Name").Value
	'Wscript.Echo "Managed By: " & objRecordSet.Fields("managedBy").Value)
	sManagedByAttrib = objRecordSet.Fields("managedBy").Value
else
	Call LogToFile(Now() & " !!! Can't find ManagedBy Attribute for user. Exiting Script.")
	wscript.quit(0)
end if

end function

' ===========================================================================================================
Sub CreateNewDDR(sitecode,username,aGroups)
 dim sName,sNameShort,sGroups,arrDDRGroups,newDDR

 sName = Split(username,",",2)
 sNameShort = Replace(sName(0),"CN=","")
  
    ' Define constants.
    Const ADDPROP_NONE  = &H0
    Const ADDPROP_GUID  = &H2
    Const ADDPROP_KEY   = &H8
    Const ADDPROP_ARRAY = &H10
	
	'Joining all Groups to a string including Domain name
    sGroups = Join (aGroups,"," & sUserDomain & "\")
    sGroups = sUserDomain & "\" & Left (sGroups,Len(sGroups)-7)
    arrDDRGroups = Split (sGroups,",")
  
    ' Load an instance of the SMSResGen.dll.
    Set newDDR=CreateObject("SMSResGen.SMSResGen.1")
    
    Dim sLen
    sLen = UBound (aGroups)
    
    ' Create a new DDR using the DDRNew method.
    newDDR.DDRNew "User", "UserDiscovery Script", sitecode
    
    ' Add properties to the new DDR using the DDRAddString method and the previously defined variables.
    newDDR.DDRAddString "Unique User Name", sUserDomain & "\" & sNameShort , 32, ADDPROP_KEY
    newDDR.DDRAddString "User Name", sNameShort , 32, ADDPROP_NONE
	newDDR.DDRAddString "Full User Name", sNameShort , 32, ADDPROP_NONE
	newDDR.DDRAddString "Windows NT Domain", sUserDomain , 32, ADDPROP_NONE
	newDDR.DDRAddStringArray "User Group Name", arrDDRGroups, 64, ADDPROP_ARRAY
	newDDR.DDRAddString "distinguishedName", username , 96, ADDPROP_NONE
         
    ' Write new DDR to file.
	Dim max,min,intNumber : max=100 : min=1 : Randomize : intNumber = Int ((max - min + 1) * Rnd + min)
	newDDR.DDRWrite sNameShort & intNumber & ".DDR"
   	Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
	wscript.echo "### Moving DDR to server" & vbCr
	wscript.echo "c:\windows\SysWOW64\" & sNameShort & intNumber & ".DDR", "\\" & sServer & "\SMS_" & sitecode & "\inboxes\auth\ddm.box\" & sNameShort & intNumber & ".DDR"
	'fso.movefile "c:\windows\SysWOW64\" & sNameShort & intNumber & ".DDR", "\\" & sServer & "\SMS_" & siteCode & "\inboxes\auth\ddm.box\" & sNameShort & intNumber & ".DDR"
End Sub

' ===========================================================================================================
Function LogToFile(txt2log)
Dim fso, sPath, fsotxt
Const ForAppending = 8

Set fso = CreateObject("Scripting.FileSystemObject") 
if (fso.FileExists(sLogfile)) Then
    Set fsotxt = fso.OpenTextFile(sLogfile, ForAppending, True)
  Else
    Set fsotxt = fso.CreateTextFile(sLogfile, False)
    fsotxt.WriteLine("Log from " & WScript.ScriptName) 
End If
fsotxt.WriteLine txt2log
WScript.Echo txt2log
End Function