'*****************************************************************************************
'*****************************************************************************************
' Purpose:  This script may be included in wsf scripts.  
'
' Version 2.5
' Global Variables: Debug, LogPath, WriteLogTimeStamp
' Function List:
' Function CvtPhonetic(strInput)							Returns phonetic string
' Sub WriteLog(Line)										Write a line of text to a file Requires global variable LogPath
' Sub DebugOut(Text)										Output a line of text to console if Debug=True
' Function GetPath()										Returns the path where the script is being executed
' Sub SendMail(strFrom, strTo, strCC, strSubject, strBody)	Sends text email
' Function ExecCmd(Command)									Executes a command like at a command prompt
' Function ListCompare(ByRef arrListA, ByRef arrListB)		Compares two arrays to see if any elements match
' Function GetMailAddr(UserID)								Get user's email address from AD
' Function CollectArgs()									Returns a 2 dimentional array of command line arguments
' Function GetComputerDN(strComputerName)					Returns the specified computer's DN from AD
' Function GetAllComputersInOU(strOU)						Returns an array with a list of all computers in the specifed OU
' Function GetUserDN(UserID)								Returns the specified user's DN from AD
' Function ReportAllGroups(sUserDN)							Returns all groups user is a member of including nested groups
' Function InsertSQL(arrFields, arrData, strTableName)		Performs a SQL insert. Requires global variable SQLConnectStr
' Function ServerInMaintenance(Server)						Returns Boolean True or False on maintenance mode.  Null on Error
' Function FindServerContacts(Server)                       Returns array of contacts from Infobase for given server
' Function GetMachineName()					                Returns the local computer name
' Function ListProdServers()                                Returns an array of production servers from the Infobase.
' Function ListServers(InfobaseServerState)                 Returns an array of servers from the Infobase based on their current state.
' Function GetServerDescription(Server)                     Returns a string containing the "Brief Description" from the Infobase
' Function ListNetWorkerServers()                           Returns an array of NetWorker servers from the Infobase.
' Function GetWMIConnection(Server, UserID, Password)       Returns WMI Connection Object
' Function StopService(strComputer, strService)             Returns Error code on WMI stop service
' Function ReadFile(strFile)                                Returns unprocessed contents of text file.
' Function BoolInStr(strLookIn, strLookFor)                 Returns true or false if strLookFor is in strLookIn
' Function GetOutlookVersion()								Returns Outlook version
' Function GetDotDom()										Returns FQDN of domain
' Function AddGGToLG(lgrp, ggrp, domain) Returns TRUE or FALSE depending on status of the operation
'*****************************************************************************************
'*****************************************************************************************
'***********************************Begin Global Variable Dimentioning********************
Option explicit
Dim Debug, LogPath, SQLConnectStr, WriteLogTimeStamp

WriteLogTimeStamp = False 'Default Value
'***********************************End Global Dim****************************************
Function CvtPhonetic(strInput)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function Converts a string to a list of phonetic equivalents
    ' Version 2.0
    ' Author Tommy Mills
    ' Arguements:  Text string containing printable characters
    ' Returns:  Text string
    '*****************************************************************************************
    '*****************************************************************************************
    Dim ReturnString, I, Lookup
    
    Lookup = array(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,"Exclaimation","DoubleQuote","Pound","DollarSign",_
    "Percent","Ampersand","SingleQuote","OpenParenthesis","CloseParenthesis","Asterisk","Plus","Comma",_
    "Dash","Period","Slash","Zero","One","Two","Three","Four","Five","Six","Seven","Eight","Nine",_
    "Colon","SemiColon","LessThan","Equal","GreaterThan","QuestionMark","AtSign","ALPHA","BETA",_
    "CHARLIE","DELTA","ECHO","FOXTROT","GOLF","HOTEL","INDIA","JULIET","KILO","LIMA","MIKE",_
    "NOVEMBER","OSCAR","PAPA","QUEBEC","ROMEO","SIERRA","TANGO","UNIFORM","VICTOR","WHISKEY","X-RAY",_
    "YANKEE","ZULU","OpenBracket","BackSlash","CloseBracket","Caret","Underscore","Apostrophe","alpha",_
    "beta","charlie","delta","echo","foxtrot","golf","hotel","india","juliet","kilo","lima","mike",_
    "november","oscar","papa","quebec","romeo","sierra","tango","uniform","victor","whiskey","x-ray",_
    "yankee","zulu","OpenCurlyBrace","Pipe","CloseCurlyBrace","Tilde")
    
    For I = 1 to len(strInput)
        If asc(mid(strInput,I,1)) < 33 or asc(mid(strInput,I,1)) = 127 then
            ReturnString = ReturnString & "*Undefined*"
        else
            ReturnString = ReturnString & Lookup(asc(mid(strInput,I,1)))        
        end if 

        If I <> len(strInput) then ReturnString = ReturnString & " - "
    Next
    CvtPhonetic = ReturnString
End Function
'*********************************************************************************************
Function GetPath()
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function returns the path where the script is currently being executed.
    ' Version 1.0
    ' Author Bryan Taylor
    ' Arguements:  None
    ' Returns:  Text string
    '*****************************************************************************************
    '*****************************************************************************************
    Dim path
    path = WScript.ScriptFullName
    GetPath = Left(path, InStrRev(path, "\"))
End Function
'*********************************************************************************************
Sub DebugOut(Text)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This sub echoes input if Global variable Debug is TRUE
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  Text String
    ' Returns:  Nothing
    '*****************************************************************************************
    '*****************************************************************************************
	If Debug then Wscript.Echo Text
End Sub
'*********************************************************************************************
Sub WriteLog(Line)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This sub writes the data in Line to the path specified by global variable
    '           LogPath.
    ' Version 1.2
    ' Author Tommy Mills
    ' Arguements:  Text String.  Also if the single word "OPEN" is passed the log will clear.
    ' Returns:  Nothing
    '*****************************************************************************************
    '*****************************************************************************************
	Dim fso, MyFile, TSString
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Set fso=CreateObject("Scripting.FileSystemObject")
	If Line = "OPEN" then ' Sending the word OPEN in upper case will clear the log
		on error resume next
		fso.DeleteFile(LogPath)
		on error goto 0
		exit sub
	end if
	Set Myfile=fso.OpenTextFile(LogPath, ForAppending, True)
	if WriteLogTimeStamp then TSString = "[" & Now() & "] "
	myfile.writeline TSString & Line 'Added time stamp to log
	myfile.close
End Sub
'*********************************************************************************************
Sub SendMail(strFrom, strTo, strCC, strSubject, strBody)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This sub will send email with supplied parameters.
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  From address, To addresses, CC addresses, Subject, Body text
    ' Returns:  Nothing
    '*****************************************************************************************
    '*****************************************************************************************
	dim iMsg, iConf, Flds
    Const cdoSendUsingPort = 2
    ' Enter your SMTP server in the next line.
	Const EMAILSERVER = "<SMTPServer.domain.com>"

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields
    With Flds
    	.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = emailserver 
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
        .Update
    End With
 
    ' Apply the settings to the message.
    With iMsg
        Set .Configuration = iConf
        .CC = strCC
        .To = strTo
        .From = strFrom
        .Subject = strSubject
        .TextBody =  strBody 
    End With
	on error resume next
    iMsg.Send
    on error goto 0
end sub
'*********************************************************************************************
Function ExecCmd(Command)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function will execute a command at a new command shell.
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  Command string
    ' Returns:  Text returned to std out and std error in a flat txt string.
    '*****************************************************************************************
    '*****************************************************************************************
	Dim oExec,WshShell, Line

	Set WshShell = WScript.CreateObject("WScript.Shell")
	Set oExec = WshShell.Exec(Command)
	Line = ""
	Do while oExec.Status <> 1
		If not oExec.StdOut.AtEndOfStream Then
			line = line & oExec.StdOut.ReadAll
		End If
		If not oExec.StdErr.AtEndOfStream Then
			line = line & oExec.StdErr.ReadAll
		End If
	Loop
	ExecCmd = Line
End Function
'*********************************************************************************************
Function ListCompare(ByRef arrListA, ByRef arrListB)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function will compare two arrays to see if any elements match
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  array containing list 1 to compare, array containing list 2 to compare
    ' Returns:  True if any elements between the arrays match.  False otherwise.
    '*****************************************************************************************
    '*****************************************************************************************
    Dim X, Y
    ListCompare = False
    For Each X in arrListA
        For Each Y in arrListB
            If Ucase(x) = Ucase(y) then
                ListCompare = True
                Exit For
            End If
        Next
        If ListCompare then Exit For
    Next
end Function
'*********************************************************************************************
Function GetMailAddr(UserID)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function return's a users email address from AD
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  User ID string
    ' Returns:  email address string
    '*****************************************************************************************
    '*****************************************************************************************
    Dim conn, rs, command, LDAPCONNECTSTR, objRootDSE, strDomain
    
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDomain = objRootDSE.Get("DefaultNamingContext")

	LDAPCONNECTSTR = "'LDAP://" & strDomain & "'"
	Set conn = CreateObject("ADODB.Connection")
	conn.Provider = "ADsDSOObject"
	conn.Open "Active Directory Provider"
	Set command = CreateObject("ADODB.Command")
	Set command.ActiveConnection = conn
	command.Properties("Page Size") = 10
	command.Properties("Asynchronous") = true
	command.CommandText = "SELECT distinguishedname, mail FROM " & LDAPCONNECTSTR & " WHERE sAMAccountName = '" & UserID & "'"
	Set rs = command.Execute
	If rs.BOF or rs.EOF then
	    GetMailAddr = NULL
	else
	    GetMailAddr = rs.fields("mail")
	End if
end Function
'*********************************************************************************************
Function CollectArgs()
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function gets the args collection and returns a two dimentional array.
    '           Element 0 is for switches that begin with - and element 1 is for values with
    '           no dash.
    ' Version 1.1
    ' Author Tommy Mills
    ' Arguements:  None
    ' Returns:  Two dimentional array, Null in both values if no arguements.
    '*****************************************************************************************
    '*****************************************************************************************
    Dim objArgs, I, Args()
    Redim Args(1,0)
    Args(0,0) = NULL
    Args(1,0) = NULL
    Set objArgs = wscript.arguments
    If objArgs.count = 0 then 
        CollectArgs = Args
        exit Function
    End if        
    for I = 0 to objArgs.count -1
        If mid(objArgs(i),1,1) = "-" or mid(objArgs(i),1,1) = "/" then
            If not isnull(Args(0,ubound(args,2))) then redim preserve Args(1, ubound(args,2) + 1)
            Args(0,ubound(args,2)) = objArgs(I)
            If I < objArgs.count -1 then
                If mid(objArgs(I + 1),1,1) <> "-" or mid(objArgs(i),1,1) = "/" then
                    Args(1,ubound(args,2)) = objArgs(I + 1)
                    I = I + 1
                end if
            end if
        Else
            If not isnull(Args(0,ubound(args,2))) or not isnull(Args(1,ubound(args,2))) then redim preserve Args(1, ubound(args,2) + 1)
            Args(1,ubound(args,2)) = objArgs(I)
        End if
    next
    CollectArgs = Args
end Function
'*********************************************************************************************
Function GetComputerDN(strComputerName)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function gets the computer's distinguished name from AD.
    ' Version 1.0
    ' Author Yang Lai
    ' Arguements:  String Computer name to check
    ' Returns:  DN of the computer
    '*****************************************************************************************
    '*****************************************************************************************
    ' Constants for the NameTranslate object.
    Const ADS_NAME_INITTYPE_GC = 3
    Const ADS_NAME_TYPE_NT4 = 3
    Const ADS_NAME_TYPE_1779 = 1
    Dim objTrans, objDomain
    Dim wshShell, wshNetwork

    Set wshNetwork = CreateObject("WScript.Network")
    Set objTrans = CreateObject("NameTranslate")
    objTrans.Init ADS_NAME_INITTYPE_GC, ""
    objTrans.Set ADS_NAME_TYPE_NT4, wshNetwork.UserDomain & "\" _
    & strComputerName & "$"
    GetComputerDN = objTrans.Get(ADS_NAME_TYPE_1779)

    set wshNetwork = nothing
    Set objTrans = nothing
End Function
'*********************************************************************************************
Function GetAllComputersInOU(strOU)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This Function returns all Computers in the specified OU
    ' Version 1.0
    ' Author Yang Lai
    ' Arguements:  OU
    ' Returns:  a string array with all computer in ou
    '*****************************************************************************************
    '*****************************************************************************************
    dim strAllComputers, objOU, objComputer

    Set objOU = GetObject("LDAP://" & strOU)
    objOU.Filter = Array("Computer")
    For Each objComputer in objOU
        strAllComputers = strAllComputers & objComputer.CN & ","
    Next
    If Len(strAllComputers) > 2 then
        GetAllComputersInOU = split(Left(strAllComputers, Len(strAllComputers) - 1),",")
    End If
    Set objOU = nothing
END Function
'*********************************************************************************************
Function GetUserDN(UserID)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This function gets the user's distinguished name from AD.
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  String user ID to check
    ' Returns:  DN of the user and null if no record found
    '*****************************************************************************************
    '*****************************************************************************************
	dim conn, command, rs, objRootDSE, strDomain, LDAPCONNECTSTR

    Set objRootDSE = GetObject("LDAP://RootDSE")
	strDomain = objRootDSE.Get("DefaultNamingContext")

	LDAPCONNECTSTR = "'LDAP://" & strDomain & "'"
    
	Set conn = CreateObject("ADODB.Connection")
	conn.Provider = "ADsDSOObject"
	conn.Open "Active Directory Provider"
	Set command = CreateObject("ADODB.Command")
	Set command.ActiveConnection = conn
	command.Properties("Page Size") = 10
	command.Properties("Asynchronous") = true
	command.CommandText = "SELECT distinguishedname, GroupMembershipSAM FROM " & LDAPCONNECTSTR & " WHERE sAMAccountName = '" & UserID & "'"
	Set rs = command.Execute
	If rs.BOF or rs.EOF then
	    GetUserDN = NULL
	else
	    GetUserDN = rs.fields("distinguishedname")
	End if
end function
'*********************************************************************************************
Function ReportAllGroups(sUserDN)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This function gets the user's groups including nested groups from AD.
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  DN of the user
    ' Returns:  DN of the user
    '*****************************************************************************************
    '*****************************************************************************************
  Dim mem, aMems, oUser, oGroup, sGroupList

  Set oUser = GetObject("LDAP://" & sUserDN)
  oUser.filter = array("group")
  on error resume next
  aMems = oUser.GetEx("memberOf")
  if err.number <> 0  then
      Err.Clear
      on error goto 0
  Else
    For each mem in aMems
      Set oGroup = GetObject("LDAP://" & mem)
      sGroupList = sGroupList & oGroup.CN & ","
      sGroupList = sGroupList & ReportAllGroups(mem)
    Next
    ReportAllGroups = Split(sGroupList, ",")
  End if
end function
'*********************************************************************************************
Function InsertSQL(arrFields, arrData, strTableName)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  This function inserts a row of data in a specified table
    ' Version 1.1
    ' Author Tommy Mills
    ' Arguements:  Array of fields to be inserted, Array of data for the specified fields,
    '              String TableName
    ' Returns:  string "Array Mismatch" if the element counts in the two arrays don't match
    ' REQUIRES Global Variable SQLConnectStr
    ' Examples of SQLConnectStr
    ' SQLConnectStr = "Provider=SQLOLEDB.1;Initial Catalog=<DATABASE>;Data Source=<SQLSERVER>\<SQLINSTANCE>,<PORT>;User ID=<USER>;Pwd=<PASSWORD>"
    ' TrustedSQLConnectStr = "Provider=SQLOLEDB.1;Initial Catalog=<DATABASE>;Data Source=<SQLSERVER>\<SQLINSTANCE>,<PORT>;Trusted_Connection=Yes"
    '*****************************************************************************************
    '*****************************************************************************************
	Dim strQuery, objConnection, objRecordset, Element
	
	If ubound(ArrFields) <> ubound(ArrData) then
		InsertSQL = "Array Mismatch"
		Exit Function
	End if
	Set objConnection = CreateObject("ADODB.Connection")
	objConnection.Connectionstring = SQLConnectStr
	strQuery = "INSERT INTO [" & strTableName & "] ("
	For each Element in ArrFields
		strQuery = strQuery & "[" & Element & "], "
	Next
	strQuery = Mid(StrQuery,1,len(StrQuery) - 2) & ") Values ("
	For each Element in ArrData
		strQuery = strQuery &  Element & ", "
	Next
	strQuery = Mid(StrQuery,1,len(StrQuery) - 2) & ")"
	objConnection.Open 
	Set objRecordset = objConnection.Execute (strQuery)
	objConnection.Close
End Function
'*********************************************************************************************
Function GetMachineName()
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  Returns the name of the system running this script
    ' Version 1.0
    ' Author Steve Ross
    ' Arguements:  
    ' Returns:  Computer name
    '*****************************************************************************************
    '*****************************************************************************************
    Dim WshNetwork
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    GetMachineName = WshNetwork.ComputerName
End Function
'*********************************************************************************************
Function ReadFile(strFile)
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  Returns the text from a specified file.  Returns null if an error occurs 
    '           opening the file.
    ' Version 1.0
    ' Author Tommy Mills
    ' Arguements:  Path to file to be read
    ' Returns:  Unprocessed contents of txt file.
    '*****************************************************************************************
    '*****************************************************************************************
    Dim fso, objFile
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    set fso = CreateObject("Scripting.FileSystemObject")
    On Error resume next
    Set objFile = fso.OpenTextFile(strFile, ForReading, False)
    If err.number <> 0 then
        err.clear
        ReadFile = Null
    End if
    On Error Goto 0
    ReadFile = objFile.ReadAll
End Function
'*********************************************************************************************
Function GetOutlookVersion()
    '*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  Returns Outlook version
    ' Version 1.0
    ' Author Steve Ross
    ' Arguements:  None
    ' Returns:  Outlook version or 0 if Outlook version could not be retrieved.  NOTE Outlook
	'			application is started to determine version.
    '*****************************************************************************************
    '*****************************************************************************************
	Dim objOutlook
	On Error Resume Next
	err.clear
	Set objOutlook = CreateObject("Outlook.Application")
	if err.number <> 0 then
		GetOutlookVersion = 0
	Else
		GetOutlookVersion = objOutlook.Version
		objOutlook.Quit
	End If
End Function
'*********************************************************************************************
Function GetDotDom()
	'*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  Returns FQDN of AD domain
    ' Version 1.0
    ' Author unknown
    ' Arguements:  None
    ' Returns:  FQDN of AD domain
    '*****************************************************************************************
    '*****************************************************************************************
	Dim arrDomain, intCount, strDotDomain, oRootDSE
	Set oRootDSE = GetObject("LDAP://rootDSE")
	arrDomain = split(oRootDSE.Get("defaultNamingContext"), ",")
	for intCount = 0 to ubound(arrDomain)
		strDotDomain = strDotDomain &  "." & mid(arrDomain(intcount),4)
	next

	GetDotDom = mid(strDotDomain,2)
	'msgbox "Dotted Domain = " & strDotDomain
End Function
'*********************************************************************************************
Function AddGGToLG(lgrp, ggrp, domain)
	'*****************************************************************************************
    '*****************************************************************************************
    ' Purpose:  Adds a domain global group to a local group.
    ' Version 1.0
    ' Author: Steve Ross 
    ' Arguements:  local group, global group, NetBIOS name of domain
    ' Returns:  TRUE if group add is successful.  FALSE if not.
    '*****************************************************************************************
    '*****************************************************************************************
	Dim objNet, compName, LocalGroup, DomainGroup

	On Error Resume Next
	Set objNet = CreateObject("Wscript.Network")
	Set compName = GetObject("WinNT://" & objNet.ComputerName)
	Set LocalGroup = compName.GetObject("group", lgrp)
	Set DomainGroup = GetObject("WinNT://" & domain & "/" & ggrp & ",group")
	LocalGroup.Add(DomainGroup.AdsPath)
	err.clear
	LocalGroup.SetInfo
	If err.number <> 0 then
		AddGGToLG = TRUE
	Else
		AddGGToLG = FALSE
	End If
End Function