'Schema GetAttributes exmple
'aAttribs=GetAttributes("Computer")
'for each sAttrib in aAttribs
'	wscript.echo sAttrib
'next

'LDAP Query example
'aTest=ldapquery("objectClass=Computer","ADsPath")
'for each stmp in aTest
'	wscript.echo stmp
'next

'GetSid Example
'set objNet = CreateObject("wscript.network")
'set objUser = GetObject("WinNT://"&objNet.UserDomain&"/"&objNet.UserName&",user")
'set objShell = CreateObject("wscript.shell")
'wscript.echo GetSid(objUser.objectSid)

'Send e-mail Example
'call notify ("MS Exchange Settings","My Subject","My body"&vbcrlf&"line 2",Array("recip1@domain1.com","recip2@domain2.com"))

Function GetCurrentDir
	GetCurrentDir=left(wscript.scriptfullname,instrrev(wscript.scriptfullname,"\"))
End Function

Function HasWMI(sHWComputer)
	on error resume next
	set oWMI=GetObject("winmgmts://"&sHWComputer&"/root")
	if err.number <> 0 then
		HasWMI=False
	else
		HasWMI=True
	end if
	on error goto 0
end Function

Function ldapquery(sSource,sQuery,sAttribute)
	on error resume next
	'Returns result in aResult.  Surrounds output in quotes and uses comma separation for multivalued results.

	ADS_CHASE_REFERRALS_SUBORDINATE = &H20
	ADS_CHASE_REFERRALS_EXTERNAL = &H40
	ADS_CHASE_REFERRALS_ALWAYS = ADS_CHASE_REFERRALS_SUBORDINATE Or ADS_CHASE_REFERRALS_EXTERNAL
	aAtts=split(sAttribute,",")
	iReturn=ubound(aAtts)
	if iReturn<0 then iReturn=0
	Set oConn = WScript.CreateObject("ADODB.Connection")
	Set oRS = WScript.CreateObject("ADODB.Recordset")
	Set oCommand = WScript.CreateObject("ADODB.Command")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Set oCommand.ActiveConnection = oConn
	oCommand.CommandText = "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"

	oCommand.Properties("Page Size") = 99
	oCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
	Set oRS = oCommand.Execute
	if oRS.recordcount<1 then 
		ldapquery=array("Not Found")
		exit function
	end if
	oRS.movefirst
	redim Preserve aResult(oRS.recordcount-1)
	x=0
	While Not oRS.EOF      
		'User for multi-attribute queries
		'strTemp=""""
		'for intI = 0 to iReturn
		'	if len(strTemp)>1 then strTemp=strTemp&","""
		'	strTemp=strTemp&CSTR(oRS.Fields(intI).Value)&""""
		'next
		'aResult(x)=strTemp

		aResult(x)=oRS.Fields(0).Value
		x=x+1
	      	oRS.MoveNext
	Wend
	ldapquery=aResult
End Function

Function ldapqueryTop(sSource,sQuery,sAttribute,iTOp)
	'Returns Top x records - from https://premier.microsoft.com/default.aspx?scid=kb;en-us;269361
	const adUseClient=3
	const adOpenStatic = 3
	const adLockOptimistic = 3
	const adLockReadOnly = 1
	const adCmdText = 1
	const adFilterFetchedRecords = 3

	on error resume next
	'Returns result in aResult.  Surrounds output in quotes and uses comma separation for multivalued results.

	ADS_CHASE_REFERRALS_SUBORDINATE = &H20
	ADS_CHASE_REFERRALS_EXTERNAL = &H40
	ADS_CHASE_REFERRALS_ALWAYS = ADS_CHASE_REFERRALS_SUBORDINATE Or ADS_CHASE_REFERRALS_EXTERNAL
	aAtts=split(sAttribute,",")
	iReturn=ubound(aAtts)
	if iReturn<0 then iReturn=0
	Set oConn = WScript.CreateObject("ADODB.Connection")
	Set oRS = WScript.CreateObject("ADODB.Recordset")
	Set oCommand = WScript.CreateObject("ADODB.Command")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Set oCommand.ActiveConnection = oConn
	oCommand.CommandText = "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"
	sCmd= "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"
	oCommand.Properties("Page Size") = 99
	oCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS

	set oRS.ActiveConnection = oConn
	oRS.CursorLocation = adUseClient
    	oRS.CursorType = adOpenStatic
    	oRS.LockType = adLockOptimistic

    	oRS.PageSize = iTop '<--- this is the value to change for how many records to return.
    	oRS.CacheSize = oRS.PageSize

	'Set oRS = oCommand.Execute
	oRS.Open sCmd
	oRS.AbsolutePage = 1
    	oRS.Filter = adFilterFetchedRecords

	if oRS.recordcount<1 then 
		ldapqueryTop=array("Not Found")
		exit function
	end if
	oRS.movefirst
	'redim Preserve aResult(oRS.recordcount-1)
	redim Preserve aResult(iTop-1)
	x=0
	While Not oRS.EOF      
		'User for multi-attribute queries
		'strTemp=""""
		'for intI = 0 to iReturn
		'	if len(strTemp)>1 then strTemp=strTemp&","""
		'	strTemp=strTemp&CSTR(oRS.Fields(intI).Value)&""""
		'next
		'aResult(x)=strTemp

		aResult(x)=oRS.Fields(0).Value
		x=x+1
	      	oRS.MoveNext
	Wend
	ldapqueryTop=aResult
End Function

Function GetDomainSuffix(sDomain)
	'Returns ldap domain suffix from dns style domain name sDomain (i.e. returns "dc=mydomain,dc=com" from "mydomain.com")
	'Add .com if it is a netbios domain name
	if instr(sDomain,".") = 0 then
		sDomain=sDomain&".com"
	end if


	'Get dc portion of binding string
	dc=split(sDomain,".")
	for x = 0 to ubound(dc)-1
		sComp=scomp&"dc="&dc(x)&","
	next
	GetDomainSuffix=scomp&"dc="&dc(x)
End Function

Function GetTopLevelDomainSuffix(sDnsDomain)
	set oRoot=GetObject("LDAP://"&sDNSDomain&"/rootDSE")
	GetTopLevelDomainSuffix=oRoot.Get("defaultNamingContext")
End Function

Function GetDomain(sServer)
	'Returns ADsPath to current domain
	'defaultNamingContext
	'schemaNamingContext
	set oRoot=GetObject("LDAP://"&sServer&"/rootDSE")
	GetDomain=oRoot.Get("defaultNamingContext")
End Function

Function GetCurrentDomain()
	'Returns ADsPath to current domain
	'defaultNamingContext
	'schemaNamingContext
	set oRoot=GetObject("LDAP://rootDSE")
	GetCurrentDomain=oRoot.Get("defaultNamingContext")
End Function

Function GetNetbiosDomain(sDNSDomain)
	'Returns Netbios name of current domain
	'defaultNamingContext
	'schemaNamingContext

	set oRoot=GetObject("LDAP://"&sDNSDomain&"/rootDSE")
	sTopLevel=oRoot.Get("defaultNamingContext")
	set oPartitions=GetObject("LDAP://cn=Partitions,cn=configuration,"&sTopLevel)
	for each oSub in oPartitions
		if instr(lcase(oSub.name),"enterprise") = 0 then
			sDomain=replace(oSub.name,"CN=","")
			GetNetbiosDomain=oSub.nETBIOSName
		end if
	next
End Function

Function GetCurrentNetbiosDomain()
	'Returns Netbios name of current domain
	'defaultNamingContext
	'schemaNamingContext

	set oRoot=GetObject("LDAP://rootDSE")
	sTopLevel=oRoot.Get("defaultNamingContext")
	set oPartitions=GetObject("LDAP://cn=Partitions,cn=configuration,"&sTopLevel)
	for each oSub in oPartitions
		if instr(lcase(oSub.name),"enterprise") = 0 then
			sDomain=replace(oSub.name,"CN=","")
			GetCurrentNetbiosDomain=oSub.nETBIOSName
		end if
	next
End Function


Function GetAttributes(sClass)
	set oSchema = GetObject("LDAP://schema")
	for each oClass in oSchema
		if (lcase(oclass.name)) = lcase(sClass) then
			redim Preserve aProps(Ubound(oClass.OptionalProperties)+Ubound(oClass.MandatoryProperties)+1)	
			lstOptProps =  oclass.OptionalProperties
			ix=0
			for each prop in lstOptProps
				aProps(ix)=prop
				ix=ix+1
			next
			lstManProps = oClass.MandatoryProperties
			for each prop in lstManProps
				aProps(ix)=prop
				ix=ix+1
			next
		end if
	next
	getAttributes=aProps
End Function

Function DateToDays(sDate)
	'Returns number of days in sDate since 01/01/00 assuming sdate is in format mm/dd/yyyy

	'Get month, day, year
	dim aMonth(12)
	adate=split(sDate,"/")
	iYear=aDate(2)
	iMonth=aDate(0)
	iDays=aDate(1)
	if len(iYear) <> 4 then 
		wscript.echo "Error:  Year does not contain 4 digits"
		exit function
	end if

	'Add days for current year
	iTotalDays=iYear*365

	'Add days for month(s)
	aMonth(1)=31
	amonth(3)=31
	amonth(5)=31
	amonth(7)=31
	amonth(8)=31
	amonth(10)=31
	amonth(12)=31
	amonth(4)=30
	amonth(6)=30
	amonth(9)=30
	amonth(11)=30
	if iYear mod 4 = 0 then
		amonth(2)=29
	else
		amonth(2)=28
	end if
	if iMonth>1 then
		for x = 1 to iMonth-1
			iTotalDays=iTotalDays+amonth(x)		
		next
	end if

	'Add days in current month	
	itotaldays=itotaldays+idays

	'Compensate for previous leap years
	iTotalDays=iTotalDays+int((iYear-1)/4)
	DateToDays=iTotalDays
End Function

Function DaysToDate(iDays)
	'Returns mm/dd/yyyy based on total days since 01/01/00.  See DateToDays function above
	'Compensate for leap years
	dim aMonth(12)
	iYear=int(iDays/365)

	'Adjust days and year for leap year days added.
	'Approximate leapyeardays to get year.
	iLeapYearDays=int((iDays)/1460)
	iDaysAdj=iDays-iLeapYearDays
	iYear=int(iDaysAdj/365)

	'Use year to get original days (before leap year days added) and put in idaysadj
	iDaysAdj=iDays-(int((iYear-1)/4))
	iDaysinYear=iDaysAdj-(iYear*365)

	if iDaysInYear=0 then 
		iYear=iYear-1
		iDaysInYear=365
		if iYear mod 4 = 0 then
			iDaysInYear = 366
		end if
	end if
	aMonth(1)=31
	amonth(3)=31
	amonth(5)=31
	amonth(7)=31
	amonth(8)=31
	amonth(10)=31
	amonth(12)=31
	amonth(4)=30
	amonth(6)=30
	amonth(9)=30
	amonth(11)=30
	if iYear mod 4 = 0 then
		amonth(2)=29
	else
		amonth(2)=28
	end if
	

	iTmp=iDaysinYear
	bfound=false
	x=1
	do while bfound=false	
		if iTmp>amonth(x) then
			iTmp=iTmp-amonth(x)
			x=x+1
		else
			iMonth=x
			iDay=iTmp
			if iDay=0 then iDay=1
			bfound=true
		end if
	loop
	if len(iMonth)=1 then iMonth="0"&iMonth		
	if len(iDay)=1 then iDay="0"&iDay	
	while len(iYear) < 4 
		iYear="0"&iYear
	wend
	DaysToDate=iMonth&"/"&iDay&"/"&iYear
End Function

'Network Functions and binary converters
Function GetNetwork(sIP,sSubnet)
'Gets the network address from an ip and subnet address.  Requires the following functions below:  ItoB, BtoI, sAnd, Pad.
	aIPOctet=split(sIP,".")
	aSubnetOctet=split(sSubnet,".")
	for z = 0 to Ubound(aSubnetOctet)
		sIPtmp=pad(ItoB(aIPOctet(z)))
		sSubTmp=pad(ItoB(aSubnetOctet(z)))
		GetNetwork=GetNetwork&BtoI(sAnd(sIPtmp,sSubTmp))
		if z<uBound(aSubnetOctet) then GetNetwork=GetNetwork&"."
	next
End Function

Function GetRouter(sNet)
	'Returns the router for an ip address specified in the format xxx.xxx.xxx/xx (where /xx is the number of network bits).
	'ie:  170.196.197.83/26 will return 170.196.197.125
	'Assumes router in 26 bit subnets is 3rd from last address and 5th from the last (.250) in 24 bit subnets
	'Requires functions itob, btoi, pad, sand, getnetwork

	'Split address into aGRAddress and netbits into sGRNetBits
	aGRAddress=split(sNet,".")
	aGRSubnet=split(aGRAddress(3),"/")
	sGRNetBits=aGRSubnet(1)
	aGRAddress(3)=aGRSubnet(0)
	sGRAddress=aGRAddress(0)&"."&aGRAddress(1)&"."&aGRAddress(2)&"."&aGRAddress(3)
	
	'Get Network by sending subnet mask and address to getnetwork function.
	bGRNetMask=String(sGRNetBits,"1")&String((32-sGRNetBits),"0")
	sBRNetMask=BtoI(mid(bGRNetmask,1,8))&"."&BtoI(mid(bGRNetMask,9,8))&"."&BtoI(mid(bGRNetMask,17,8))&"."&BtoI(Mid(bGRNetMask,25,8))
	sGRNetwork=GetNetwork(sGRAddress,sBRNetMask)
	
	'Get broadcast address  (All 1's host portion of address)=last host in subnet + 1 
	bHosts=BtoI(String((32-sGRNetBits),"1"))
	aGRNetOctets=split(sGRNetwork,".")
	sGRLastOct=aGRNetOctets(3)+bHosts-2
	if sGRNetBits=24 then sGRLastOct=sGRLastOct-3
	GetRouter=aGRAddress(0)&"."&aGRAddress(1)&"."&aGRAddress(2)&"."&sGRLastOct
End Function

Function IPinSubnet(sIINIP,sIINSub)
	'Returns true if ip is subnet where subnet is in CIDR form (i.e. 170.196.13.0/24)
	'Requires functions ItoB and Pad
	IPinSubnet=False
	if instr(sIINSub,"/") < 1 then Exit Function
	sIINSubnet=split(sIINSub,"/")(0)
	sIINNetbits=split(sIINSub,"/")(1)
	if instr(sIINSubnet,".") < 1 then Exit Function
	bIINSubnet=Pad(ItoB(split(sIINSubnet,".")(0)))&Pad(ItoB(split(sIINSubnet,".")(1)))&Pad(ItoB(split(sIINSubnet,".")(2)))&Pad(ItoB(split(sIINSubnet,".")(3)))
	bIINIP=Pad(ItoB(split(sIINIP,".")(0)))&Pad(ItoB(split(sIINIP,".")(1)))&Pad(ItoB(split(sIINIP,".")(2)))&Pad(ItoB(split(sIINIP,".")(3)))
	if left(bIINSubnet,sIINNetBits)=left(bIINIP,sIINNetBits) then IPinSubnet=True
End Function

Function HtoI(sNumber)
	'Converts string representation of binary number to integer

	sNumber=replace(sNumber,"0x","")
	sNumber=replace(sNumber,"0X","")

	HtoI=0
	for x = 1 to len(sNumber)
		vDigit=lcase(mid(sNumber,x,1))
		'Convert a-f into 10-15
		if asc(vDigit)>96 then
			vDigit=asc(vDigit)-87
		end if
		power=len(sNumber)-x
		HtoI=HtoI+vDigit*16^(len(sNumber)-x)
	next
End Function

Function ItoB(iNumber)
'Converts Integer to string representation of Binary number
	ItoB=""
	ipower=0
	itmp=iNumber
	do while itmp >= 2
		itmp=itmp/2
		ipower=ipower+1
	loop
	itmp=iNumber
	for x = ipower to 0 step -1
		if (2^x) > CInt(iTmp) then
		'if (2^x) > iTmp then
			ItoB = ItoB&"0"
		else
			iTmp = iTmp-2^x
			ItoB = ItoB&"1"
		end if
	next
End Function

Function BtoI(sNumber)
'Converts string representation of binary number to integer
	BtoI=0
	for x = 1 to len(sNumber)
		vDigit=mid(sNumber,x,1)
		power=len(sNumber)-x
		BtoI=BtoI+vDigit*2^(len(sNumber)-x)
	next

End Function

Function sAnd(sNum1,sNum2)
'Binary and on string representations of two numbers 
	iLen=len(sNum1)
	if len(sNum2) > iLen then iLen=len(sNum2)
	sAnd=""
	for x = iLen to 1 step -1
		if (mid(sNum1,x,1)=1 and mid(sNum2,x,1)=1) then
			sAnd="1"&sAnd
		else
			sAnd="0"&sAnd
		end if
	next
End Function

Function Pad(sOctet)
	Pad=sOctet
	if len(sOctet) < 8 then
		for x = 1 to (8-len(sOctet))
			Pad="0"&Pad				
		next
	end if

End Function

Function iPad(sOctet,iBitsToPad)
	iPad=sOctet
	if len(sOctet) < iBitsToPad then
		for x = 1 to (iBitsToPad-len(sOctet))
			iPad="0"&iPad				
		next
	end if

End Function

Function GetNetBits(sSub)
	'Counts 1's in binary anded address to get number of network bits.
	GetNetBits=0
	aSubnet=split(sSub,".")
	for x = 0 to ubound(aSubnet)
		sBinOct=Pad(ItoB(aSubnet(x)))
		for y = 1 to len(sBinOct)
			if mid(sBinOct,y,1)="1" then GetNetBits=GetNetBits+1
		next
	next
End Function

Function ShowAllIPs(sCIDR)
	'Shows all ip's in a subne
	'Requires functions itob, btoi, pad, iPad, sand, getnetwork
	'Excludes network and broadcast addresses

	'Split address into aSAIAddress and netbits into sSAINetBits
	aSAIAddress=split(sCIDR,".")
	aSAISubnet=split(aSAIAddress(3),"/")
	sSAINetBits=aSAISubnet(1)
	aSAIAddress(3)=aSAISubnet(0)
	'bSAIAddress=Pad(ItOB(aSAIAddress(0)))&"."&Pad(ItoB(aSAIAddress(1)))&"."&Pad(ItoB(aSAIAddress(2)))&"."&Pad(ItoB(aSAIAddress(3)))
	bSAIAddress=Pad(ItOB(aSAIAddress(0)))&Pad(ItoB(aSAIAddress(1)))&Pad(ItoB(aSAIAddress(2)))&Pad(ItoB(aSAIAddress(3)))
	bNetwork=left(bSAIAddress,sSAINetBits)
	bHosts=right(bSAIAddress,32-sSAINetBits)
	bBroadcast=string(32-sSAINetBits,"1")

	iStart=BtoI(bhosts)+1 '+1 to skip network address
	iLastHost=BtoI(bBroadcast) -1' -1 to skip broadcast address

	bCurHost=bHosts
	iBitsToPad=32-sSAINetBits
	do while iCurHost < iLastHost
		iCurHost=BtoI(bCurHost) + 1
		bCurHost=ItoB(iCurHost)
		bCurWhole=bNetwork&iPad(bCurHost,iBitsToPad)
		wscript.echo BtoI(mid(bCurWhole,1,8))&"."&BtoI(mid(bCurWhole,9,8))&"."&BtoI(mid(bCurWhole,17,8))&"."&BtoI(Mid(bCurWhole,25,8))
	loop
End Function

Function GetSid(bSID)
	'Returns SDDL for binary sid
	dim arrSubAut(25)
	strSID="S"
	strTmp=Cstr(hex(ascw(mid(bSid,1))))
	arrSubAut(1)=CDbl(right(strTmp,2))
	arrSubAut(2)=CDbl(left(strTmp,2-4+len(strTmp)))
	for intx = 3 to len(bSid)/2 
		arrSubAut(intX)="&H"&Cstr(hex(ascw(mid(bSid,intx*2))))&CStr(hex(ascw(mid(bSid,(intx*2)-1))))
	next
	for intx = 1 to len(bSid)/2
		strSID=strSID&"-"&CStr(CDbl(arrSubAut(intx)))
	next
	GetSid=strSID
End Function

Function GetSID_Binary(bSID)
	'Get binary sid for ldap searches against Exchange
	sSID=""
	for ix=1 to len(bSID)
		sSubAut=""
		sSubAut=cstr(hex(ascw(mid(bSid,ix))))
		do while len(sSubAut)<4
			sSubAut="0"&sSubAut
		loop
		sSubAut=right(sSubAut,2)&left(sSubAut,2)
		sSID=sSID&sSubAut
	next
	GetSID_Binary=sSID
End Function

Function GetSID_OctetString(bSID)
	'Emulates the ADsEncodeBinaryData function.  
	'Will convert sid into format that can be used in ldap query.
	'If obtaining sid from Exchange 5.5 use GetInfoEx("Assoc-NT-Account;binary"),0 to get sid.
	sSID=""
	for ix=1 to len(bSID)
		sSubAut="\"
		sSubAut=cstr(hex(ascw(mid(bSid,ix))))
		do while len(sSubAut)<4
			sSubAut="0"&sSubAut
		loop
		sSubAut=right(sSubAut,2)&"\"&left(sSubAut,2)
		sSID=sSID&"\"&sSubAut
	next
	GetSID_OctetString=sSID
End Function

Function GetSID_SQL(bSID)
	'Will convert objUser.objectSID into format that is used by syslogins and sysusers tables
	'Same as result of SUSER_SID function.
	sSID=""
	for ix=1 to len(bSID)
		sSubAut="\"
		sSubAut=cstr(hex(ascw(mid(bSid,ix))))
		do while len(sSubAut)<4
			sSubAut="0"&sSubAut
		loop
		sSubAut=right(sSubAut,2)&left(sSubAut,2)
		sSID=sSID&sSubAut
	next
	GetSID_SQL="0x"&sSID
End Function

Function sqlsid_to_decimal(sSTDSID)
	'Takes a sql sid (i.e. "0x01050000000000051500000060590A7F3C635D253928A073CF610000") and returns the SDDL version
	if instr(sSTDSID,"0x") then sSTDSID=split(sSTDSID,"x")(1)
	iSTDSubAut=0
	sSTDSubAut=""
	for iSTDx = len(sSTDSID)-1 to 1 step -2
		iSTDSubAut=iSTDSubAut+1
		sSTDSubAut=sSTDSubAut&mid(sSTDSID,iSTDx,2)
		if iSTDSubAut mod 4 = 0 then
			if iSTDSubAut=24 then
				sSTDResult="5-"&sSTDResult
			elseif iSTDSubAut=28 then
				sSTDResult="S-1-"&sSTDResult
			elseif iSTDSubAut > 4 then
				sSTDResult=clng("&h"&sSTDSubAut)&"-"&sSTDResult
			else
				sSTDResult=clng("&h"&sSTDSubAut)
			end if
			sSTDSubAut=""
		end if
	next
	sqlsid_to_decimal=sSTDResult
End Function

Function FiletoArray(sFilename)
	'Returns array of lines in sFilename. sFilename must exist in current directory.
	constForReading = 1 'used for opening files
	ix=0
	set oFSfta=CreateObject("Scripting.FileSystemObject")
	if oFSfta.FileExists(sFilename) then
		set oFilefta=oFSfta.OpenTextFile(sFilename, constForReading)
		do while oFilefta.AtEndOfStream<>true
			sLinefta=oFilefta.ReadLine
			if Len(sLinefta)>0 then
				Redim Preserve aResult(ix)
				aResult(ix)=sLinefta
				ix=ix+1
			end if
		loop
	end if
	FiletoArray=aResult
	Set oFSfta=Nothing
	Set oFilefta=Nothing
End Function

Function ArrayToFile(aATFArray,sATFFilename)
	'Create file from array
	constForWriting = 2 'used for opening files
	ix=0
	set oATFFS=CreateObject("Scripting.FileSystemObject")
	set oATFFile=oATFFS.createtextfile(sATFFilename,True)

	for each sATFString in aATFArray
		oATFFile.writeline sATFString
	next
	oATFFile.close
End Function

Sub DictToFile(dATFDict,sATFFilename)
	constForWriting = 2 'used for opening files
	ix=0
	set oATFFS=CreateObject("Scripting.FileSystemObject")
	set oATFFile=oATFFS.createtextfile(sATFFilename,True)

	for each sATFKey in dATFDict.Keys
		oATFFile.writeline """"&sATFKey&""","""&dATFDict(sATFKey)&""""
	next
	oATFFile.close
End Sub

Function FiletoString(sFTS)
	constForReading = 1 'used for opening files
	set oFTS=CreateObject("Scripting.FileSystemObject")
	if oFTS.FileExists(sFTS) then
		set oFTSFile=oFTS.OpenTextFile(sFTS, constForReading)
		FiletoString=oFTSFile.ReadAll
		oFTSFile.close
	else
		FiletoString="File not found"
	end if
	set oFTS=Nothing
	set oFTSFile=Nothing
End Function

Sub StringToFile(sSTFString,sSTFFile)
	set oSTFFS=createobject("scripting.filesystemobject")
	if not instr(sSTFFile,"\") then
		sSTFFile=left(wscript.scriptfullname,instrrev(wscript.scriptfullname,"\"))&sSTFFile
	end if	
	set oSTFFile=oSTFFS.createtextfile(sSTFFile,True)
	oSTFFile.write(sSTFString)
	oSTFFile.close
End Sub

Function ReplaceText(sSourceFile,sDestFile,sTarget,sNewText)
	'Replaces characters in file w/case insensitive matching.
	'Can use same source and destination file.

	cForWriting = 2
	cForReading = 1

	set oFSrt=CreateObject("Scripting.FileSystemObject")
	if oFSrt.FileExists(sSourceFile) then

		'Read lines of file into array aLines
		ix=0
		set oSourcert=oFSrt.OpenTextFile(sSourceFile, cForReading)
		do while oSourcert.AtEndOfStream<>true
			sLinefta=oSourcert.ReadLine
			Redim Preserve aLines(ix)
			aLines(ix)=sLinefta
			ix=ix+1
		loop
		Set oSourcert=Nothing
	
		'Write New file
		if oFSrt.FileExists(sDestFile) then
			set oFilert=oFSrt.GetFile(sDestFile)
			set oStreamrt=oFilert.OpenAsTextStream(cForWriting)
		else
			set oStreamrt=oFSrt.CreateTextFile(sDestFile,True)
		end if

		for each sLine in aLines
			sNewLine=sLine
			if instr(1,sLine,sTarget,1) > 0 then 
				sNewLine=replace(sLine,sTarget,sNewText,1,-1,1)
			end if
			oStreamrt.WriteLine (sNewLine)
		next
	else
		wscript.echo "File "&sSourceFile&" cannot be found."	
	end if
	set oFilert=nothing
	set oStreamrt=Nothing
	set oFSrt=Nothing
end Function

Function Commas(sNumber)
	Commas=sNumber
	on error resume next
	if len(sNumber) > 0 then
		wscript.echo sNumber
		if cdbl(sNumber) > 0 then
			Commas=FormatNumber(sNumber,0,0,-1)
		end if
	end if
End Function

Sub Notify(sProfile,sSubject,sBody,aRecips)
	'Send Mail with Error Notification using sProfile, sSubject, sBody and aRecips()
	wscript.echo "Sending mail notification."
	Set oSession = wscript.CreateObject("MAPI.Session")
	oSession.Logon(sProfile)
	'For server/mailbox use:
	oSession.logon "","",false,true,true,true,sNotifyServer & vbLf &sNotifyMailbox
	Set oMsg = oSession.Outbox.Messages.Add 
	oMsg.Subject = sSubject
	oMsg.Text = sBody
	for intx = 0 to ubound (aRecips)
		Set oOneRecip = oMsg.Recipients.Add 
		oOneRecip.Name = aRecips(intx)
		oOneRecip.Resolve 
	next
	oMsg.Update 
	oMsg.Send ()
	oSession.Logoff
	set oSession=Nothing
	set oMsg=Nothing
	set oOneRecip=Nothing
End Sub

Sub NotifyCDONTS(sSubject,sBody,aRecips)
	'Requires SMTP Mails service from IIS
	wscript.echo "Sending mail notification."
	Set oMail = CreateObject("CDONTS.NewMail") 
	oMail.From = "originator@mydomain.com" 
	for each sRecip in aRecips
		oMail.To = sRecip&";"
	next
	oMail.Subject = sSubject
	oMail.Body = sBody
	'oMail.AttachFile "d:\sample.txt" 
	oMail.Send 
	Set oMail = Nothing 
End Sub

Sub NotifyOutl
	set oOutlook=CreateObject("Outlook.Application")
	wscript.echo "Sending mail notification."

	'For exchange mailbox provider
	set oMbx=oOutlook.Session.Folders.Item("Mailbox - "&oOutlook.Session.CurrentUser)
	'For internet only service provider w/pst 
	'set oMbx=oOutlook.Session.Folders.Item("Personal Folders")

	set oOutbox=oMbx.Folders("Outbox")
	set oMsg=oOutbox.Items.Add
	oMsg.Recipients.Add "recip@mydomain.com"
	oMsg.Subject="test subject"
	oMsg.Body="test body"
	oMsg.send
	wscript.echo "Sent"
	oOutlook.Session.logoff
End Sub

Sub GetEvent(iEventID,sFilename)
	'Displays event from csv export of event logs
	constForReading = 1 'used for opening files
	ix=0
	set oFSGE=CreateObject("Scripting.FileSystemObject")
	if oFSGE.FileExists(sFilename) then
		set oFileGE=oFSGE.OpenTextFile(sFilename, constForReading)
		do while oFileGE.AtEndOfStream<>true
			sLineGE=oFileGE.ReadLine
			if Instr(sLineGE,",") then
				aTmp=split(sLineGE,",")
				if ubound(aTMP) > 5 then
					if aTmp(5)=iEventID then 'Found event id
						wscript.echo sLineGE
						sEvLine=" "
						do while (oFileGE.AtEndOfStream<>true) And (asc(left(sEvLine,1))=32)
							if sEVLine=" " then sEVLine=oFileGE.ReadLine
							wscript.echo sEVLine
							sEvLine=oFileGE.ReadLine
						Loop
					end if
				end if


			end if
		loop
	end if
	FiletoArray=aResult
	Set oFSGE=Nothing
	Set oFileGE=Nothing
End Sub

Function WMIVer(sWMIComputer)

	on error resume next
	Set oCIMID = GetObject("WinMgmts:\\"&sWMIComputer&"\root\cimv2:__CIMOMIdentification")
	if err.number <> 0 then
		WMIVer="Not Installed"
		exit function
	end if
	sVer=oCIMID.VersionUsedtoCreateDB
	if instr(sVer,".") then
		aTmp=split(sVer,".")
		if ubound(aTmp)>2 then
			sMajor=aTmp(2)
			select case sMajor
				case "1085" WMIVer="1085" 'version 1.5 (Windows 2000)"
				case "698" WMIVER="698" 'version 1.1x (Win9x/NT4 SP4/SMS 2.0)"
				case else WMIVER=sMajor 'other verions?
			end select
		end if
	else
		WMIVer=sVer
	end if
	set oCIMID=Nothing
	on error goto 0
	'Only works for w2k
	'if sMajor>=1085 then
	'	'on error resume next
	'	set oWMI=GetObject("winmgmts://"&sComputer&"/root/cimv2")
	'	set oSettings = oWMI.Get("Win32_WMISetting=@")
	'	WScript.Echo  "BuildVersion="&oSettings.BuildVersion
	'	'on error goto 0
	'end if
End Function

Function GetPublicFolder(sGFName,oGFSession)
	'sGFName=full path of folder to retrieve
	'oGFSession=CDO Session object

	'Get Root
	set oGFStore = oGFSession.infostores.item("Public Folders")	
	set oGFCurrent = oGFSession.getFolder(oGFStore.fields(&h66310102),oGFStore.id)


	aGFTmp=split(sGFName,"\")

	'Iterate through folders
	for each sGFSub in aGFTmp		
		if len(trim(sGFSub))>0 then
			bGFFound=False
			set oGFNewCurrent=Nothing
			if oGFCurrent.Folders.Count <=0 then
				GetPublicFolder="Couldn't find folder "&sGFSub
				exit function			
			end if
			for each oGFFold in oGFCurrent.Folders
				if lcase(oGFFold.name)=lcase(trim(sGFSub)) then 
					if not bGFFound then set oGFNewCurrent=oGFFold
					bGFFound=True
				end if
			next
			if bGFFound then 
				set oGFCurrent=oGFNewCurrent
			else
				GetPublicFolder="Couldn't find folder "&sGFSub
				exit function			
			end if
		end if
	next
	set GetPublicFolder=oGFCurrent
End Function

Sub AddIP(sComputerName,sNewIPAddress)
	'Create IP
	'Find NIC with 10-net addresses
	strWinMgt = "winmgmts://" & sComputerName & ""
	Set oAdapters = GetObject(strWinMgt).ExecQuery("select * from Win32_NetworkAdapterConfiguration where IPEnabled=True") 
	iIndex=0
	for each oAdapter in oAdapters
		bFound=False
		for each sIP in oAdapter.IPAddress
			if instr(sIP,".") then
				aOcts=split(sIP,".")
				if aOcts(0)="10" then bFound=True
			end if
		next
		if bFound then
			aIPs=oAdapter.IPAddress
			ReDim Preserve aIPs(ubound(aIPs)+1)
			aIPs(uBound(aIPs))=sNewIPAddress
			aMasks=oAdapter.IPSubnet
			ReDim Preserve aMasks(ubound(aMasks)+1)
			aMasks(uBound(aIPs))="255.255.0.0"
			for ix=0 to ubound(aIPs)
				'wscript.echo ix&":"&aIPs(ix)&","&aMasks(ix)
				aIPs(ix)=CStr(aIPs(ix))
				aMasks(ix)=CStr(aMasks(ix))
			next
			wscript.echo "Result="&oAdapter.EnableStatic(aIPs, aMasks)
			'oAdapter.IPAddress=aIPs
			'oAdapter.SetInfo
		end if
	next
End Sub

Function ProperCap(sPCString)
	aPCWords=split(sPCString," ")
	sPCResult=""
	for each sPCWord in aPCWords
		if len(sPCWOrd) > 1 then 
			sPCNewWord=ucase(left(sPCWord,1))&lcase(right(sPCWord,len(sPCWord)-1))
		else
			sPCNewWord=ucase(sPCWord)
		end if
		if len(sPCResult)=0 then
			sPCResult=sPCNewWord
		else
			sPCResult=sPCResult&" "&sPCNewWOrd
		end if
	next
	ProperCap=sPCResult
End Function

Function ScriptPath()
	ScriptPath=left(wscript.ScriptFullName,InStrRev(wscript.ScriptFullName,"\"))
End Function

Function StringToHex(sString)
	sResult="0000"
	for iz = 1 to len(sString)
		sResult=sResult&"00"&Cstr(hex(asc(mid(sString,iz,1))))
	next
	sResult=sResult&"000000"
	StringToHex=sResult
End Function

Function HexToString(sHex)
	'Requires HtoI function for hex conversion	
	sResult=""
	for iz = 1 to len(sHex) step 2
		if mid(sHex,iz,2)<>"00" then sResult=sResult&chr(HtoI(mid(sHex,iz,2)))
	next
	HexToString=sResult
End Function

Function PropExist(oObj,sProp)
	'check for existence of property sProp in object oObj
	PropExist=0
	oObj.GetInfo
	for ix=0 to oObj.Propertycount -1
		set oProp=oObj.Item(ix)
		if lcase(oProp.name)=lcase(sProp) then
			PropExist=-1
			exit function
		end if
	next
End Function

Function IniUpdate(sFileName,sSection,sKey,sValue)
	'Replaces or adds key with value specified to ini file

	if instr(sSection,"[")=0 then sSection="["&sSection
	if instr(sSection,"]")=0 then sSection=sSection&"]"	
	bReplaced=False
	bResult=""
	cForWriting = 2
	cForReading = 1

	set oFSrt=CreateObject("Scripting.FileSystemObject")
	if oFSrt.FileExists(sFileName) then
		'Read lines of file into array aLines
		ix=0
		set oSourcert=oFSrt.OpenTextFile(sFileName, cForReading)
		do while oSourcert.AtEndOfStream<>true
			sLinefta=oSourcert.ReadLine
			Redim Preserve aLines(ix)
			aLines(ix)=sLinefta
			ix=ix+1
		loop
		oSourcert.Close
		Set oSourcert=Nothing
	
		'rewrite file line by line
		if oFSrt.FileExists(sFileName) then
			set oFilert=oFSrt.GetFile(sFileName)
			set oStreamrt=oFilert.OpenAsTextStream(cForWriting)
		else
			set oStreamrt=oFSrt.CreateTextFile(sFileName,True)
		end if

		bSection=False

		for ix=0 to ubound(aLines)
			sLine=aLines(ix)
			sNewLine=sLine

			'Find Section
			if not bSection then
				if lcase(sLine)=lcase(sSection) then bSection=True
			else
				'If blank line check next line for new section
				if len(trim(sLine))=0 then
					iNext=ix+1
					if iNext<=ubound(aLines) then
						sNextLine=aLines(iNext)
						if (instr(sNextLine,"[")<>0) and (instr(sNextLine,"]") <> 0) then
							'New section so we need to append key here.
							bSection=False
							if not bReplaced then
								oStreamrt.WriteLine sKey&"="&sValue
								bReplaced=True
								bResult="Replaced:  Added new value."
							end if
						end if
					end if
				end if

				'Check for next section if not found
				if (bReplaced=False) and (instr(sLine,"[")<>0) and (instr(sLine,"]") <> 0) then
					bSection=False
					oStreamrt.WriteLine sKey&"="&sValue					
					bReplaced=True
					bResult="Replaced:  Added new value."
				end if

				if instr(lcase(sLine),lcase(sKey))<>0 then
					'Found key
					if instr(sLine,"=")=0 then
						sNewLine=sKey&"="&sValue
						bReplaced=True
						bResult="Value was empty.  Added "&sValue
					else
						aTmp=split(sLine,"=")
						sNewLine=aTmp(0)&"="&sValue
						bReplaced=True
						bResult="Replaced "&aTmp(1)&" with "&sValue
					end if
				end if
			end if
			oStreamrt.WriteLine (sNewLine)
		next
		'in case we're adding to last section in file
		if bSection and not bReplaced then
			oStreamrt.WriteLine sKey&"="&sValue
			bReplaced=True
			bResult="Replaced:  Added new value."
		end if
	else
		bResult="Error:  File "&sFileName&" cannot be found."	
	end if
	if bReplaced then 
		bResult="Replaced:  "&bResult
	else
		bResult="Error:  Couldn't find section "&sSection&"."
	end if
	oStreamrt.close
	set oFilert=nothing
	set oStreamrt=Nothing
	set oFSrt=Nothing
	IniUpdate=bResult
End Function

Function LogEvent(sType,sText)
	' Event log entry types
	CONST EVENT_TYPE_SUCCESS = 0
	CONST EVENT_TYPE_ERROR = 1
	CONST EVENT_TYPE_WARNING = 2
	CONST EVENT_TYPE_INFORMATION = 4 
	Set objLog = New Logger
	objLog.AppEventLog = True
	'objLog.LogFile = True
	'objLog.Console = True
	'objLog.OpenLogFile strLogFile, True
	objLog.LogEvent EVENT_TYPE_INFORMATION, 0, 0, "", "Test Event at " & Date() & " " & Time()
End Function

Function PropExist(oObj,sProp)
	on error resume next
	PropExist=0
	oObj.GetInfo
	for ix=0 to oObj.Propertycount -1
		set oProp=oObj.Item(ix)
		if lcase(oProp.name)=lcase(sProp) then
			PropExist=-1
			exit function
		end if
	next
End Function

Function RegGetValue(sServer,sPath)
	'Get Registry Root
	sRoot=ucase(left(sPath,instr(sPath,"\")-1))

	'Set hRoot and remove registry root from path
	select case sRoot
		case "HKEY_CLASSES_ROOT","HKCR"
			hRoot=&H80000000
			sPath=right(sPath,len(sPath)-instr(sPath,"\"))
		case "HKEY_CURRENT_USER","HKCU"
			hRoot=&H80000001
			sPath=right(sPath,len(sPath)-instr(sPath,"\"))
		case "HKEY_LOCAL_MACHINE","HKLM"
			hRoot=&H80000002
			sPath=right(sPath,len(sPath)-instr(sPath,"\"))
		case "HKEY_USERS","HKU"
			hRoot=&H80000003
			sPath=right(sPath,len(sPath)-instr(sPath,"\"))
		case "HKEY_CURRENT_CONFIG","HKCC"
			hRoot=&H80000005
			sPath=right(sPath,len(sPath)-instr(sPath,"\"))
		case "HKEY_DYN_DATA","HKDD"
			hRoot=&H80000006
			sPath=right(sPath,len(sPath)-instr(sPath,"\"))
		case else
			hRoot=&H80000002
	end select

	'Split path into key and value parts
	sTargetValue=right(sPath,len(sPath)-instrrev(sPath,"\"))
	sKeyPath=left(sPath,instrrev(sPath,"\")-1)

	'Get Registry object
	on error resume next
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sServer & "\root\default:StdRegProv")
	if err.number <> 0 then
		RegGetValue="Not found.  Error: "&Cstr(Hex(err.number))&" "&err.description
		err.clear
		exit function
	end if
	on error goto 0

	'Enumvalues to get value data type
	iReturn=oReg.EnumValues (hRoot, sKeyPath, aValues, iTypes)
	if iReturn <> 0 then
		if iReturn="2" then
			RegGetValue="Not Found.  WMI Error:  "&iReturn&". Key "&sKeyPath&" not found."
		else
			RegGetValue="Not Found.  WMI Error:  "&iReturn&". Check http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/wbemerrorenum.asp for reason."
		end if
		
		exit function
	end if

	if TypeName(aValues)="Null" then
		RegGetValue="Not found.  Error: Couldn't find the "&sTargetValue&" value (or any values) under "&sKeypath&"."
		exit function
	end if

	'Get Data type
	for ix=0 to ubound(aValues)
		'wscript.echo aValues(ix),iTypes(ix)
		if lcase(aValues(ix))=lcase(sTargetValue) then 
			iType=iTypes(ix)
			bFound=True
		end if
	next
	
	'Return if value not found.
	if not bFound then
		RegGetValue="Couldn't find value "&sTargetValue&" under key "&sKeyPath&"."
		exit function
	end if

	'Types: REG_SZ (1), REG_EXPAND_SZ (2), REG_BINARY (3),	REG_DWORD (4), REG_MULTI_SZ (7)
	select case iType
		case 1
			iReturn=oReg.GetStringValue(hRoot,sKeyPath,sTargetValue,sValue)
		case 2
			iReturn=oReg.GetExpandedStringValue(hRoot,sKeyPath,sTargetValue,sValue)
		case 3
			iReturn=oReg.GetBinaryValue(hRoot,sKeyPath,sTargetValue,bValues)
			if iReturn = 0 then 
				for each bValue in bValues
					sDigit=cstr(hex(bValue))
					if len(sDigit)<2 then sDigit="0"&sDigit
					if len(sValue) = 0 then 
						sValue=sDigit
					else
						sValue=sValue&" "&sDigit
					end if
				next
			end if
		case 4
			iReturn=oReg.GetDWORDValue(hRoot,sKeyPath,sTargetValue,sValue)
		case 7	
			iReturn=oReg.GetMultiStringValue(hRoot,sKeyPath,sTargetValue,aValues)
			if iReturn = 0 then 
				for each sString in aValues
					if len(sValue)=0 then
						sValue=sString
					else
						sValue=svalue&","&sString
					end if
				next
			end if
		case else
			sValue="Not Found.  Error: Value is an unrecognized data type: "&iType&"."
	end select

	if len(sValue)=0 and iReturn <> 0 then
		if iReturn="2" then
			RegGetValue="Not Found.  WMI Error:  "&iReturn&". Key "&sKeyPath&" not found."
		else
			RegGetValue="Not Found.  WMI Error:  "&iReturn&". Check http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/wbemerrorenum.asp for reason."
		end if
		
		exit function
	end if

	RegGetValue=sValue			
End Function


Function HostAlive(sHost)
	HostAlive=False
	if wscript.version<5.6 then
		wscript.echo "Requires wscript 5.6 or better"
		exit function
	end if
	set oShell=CreateObject("wscript.shell")
	set oPing=oShell.exec("ping "&sHost)
	set oOutput=oPing.stdOut
	sIP="0.0.0.0"
	Do while not oOutput.AtEndOfStream
		sLine=oOutput.ReadLine
		'wscript.echo sLine
		if instr(sLine,"Pinging ") then
			aTmp=split(sLine," ")
			sIP=replace(replace(aTmp(2),"[",""),"]","")
		else
			if instr(sLine,"Reply from "&sIP) then 
				HostAlive=True
				exit function
			end if
		end if
	Loop
End Function

Function GetIP(sHost)
	if wscript.version<5.6 then
		wscript.echo "Requires wscript 5.6 or better"
		exit function
	end if
	set oShell=CreateObject("wscript.shell")
	set oPing=oShell.exec("ping "&sHost)
	set oOutput=oPing.stdOut
	Do while not oOutput.AtEndOfStream
		sLine=oOutput.ReadLine
		if instr(sLine,"Pinging ") then
			aTmp=split(sLine," ")
			sIP=replace(replace(aTmp(2),"[",""),"]","")
			GetIP=sIp
			exit function
		end if
	Loop
	GetIP=sIP
End Function

Function GetNameFromIP(sGNFIP)
	if wscript.version<5.6 then
		wscript.echo "Requires wscript 5.6 or better"
		exit function
	end if
	set oShell=CreateObject("wscript.shell")
	set oPing=oShell.exec("ping -n 1 -a "&sGNFIP)
	set oOutput=oPing.stdOut
	Do while not oOutput.AtEndOfStream
		sLine=oOutput.ReadLine
		if instr(sLine,"Pinging ") then
			aTmp=split(sLine," ")
			GetNameFromIP=Trim(aTmp(1))
		end if
	Loop
	GetIP=sIP
End Function

Function GetSMSClientsByQuery(sSMSServer,sSMSDB)
	'Returns all servers with sms installed
	'Get Server Collection
	sQuery="select CollectionID from v_Collection where Name='All Windows NT Server Systems'"
	Set oRS = WScript.CreateObject("ADODB.Recordset")
	oRS.Open sQuery,"Provider=sqloledb;Data Source="&sSMSServer&";Initial Catalog="&sSMSDB&";Trusted_Connection=yes;Integrated Security=SSPI",3

	sServerTable="v_CM_RES_COLL_"&oRS.Fields(0).Value
	oRS.Close

	'Query for servers
	sQuery="select distinct name from "&sServerTable
	oRS.Open sQuery,"Provider=sqloledb;Data Source="&sSMSServer&";Initial Catalog="&sSMSDB&";Trusted_Connection=yes;Integrated Security=SSPI",3
	ix=0
	while not oRS.EOF
		Redim Preserve aResult(ix)
		aResult(ix)=oRS.Fields(0).Value
		wscript.echo aResult(ix)
		ix=ix+1
		oRS.MoveNext
	wend
	oRS.Close
	GetSMSServersByQuery=aResult
End Function

Function FiletoDict(sFilename)
	'Adds dictionary elements from 2 column csv.
	constForReading = 1 'used for opening files
	ix=0
	set oFSfta=CreateObject("Scripting.FileSystemObject")
	set dResult=CreateObject("Scripting.Dictionary")
	if oFSfta.FileExists(sFilename) then
		set oFilefta=oFSfta.OpenTextFile(sFilename, constForReading)
		do while oFilefta.AtEndOfStream<>true
			sLinefta=oFilefta.ReadLine
			if instr(sLinefta,",") then
				aTmp=split(sLinefta,",")
				if not dResult.Exists(aTmp(0)) then dResult.add aTmp(0),aTmp(1)
			end if
		loop
	end if
	Set oFSfta=Nothing
	Set oFilefta=Nothing
	set FiletoDict=dResult
End Function


Function GetW2KDCSite(sServer)
	'Returns ad site for a server. Requires ldapquery function
	aSites=ldapquery("cn=configuration,dc=mydomain,dc=com","cn="&sServer,"ADsPath")
	aSiteComps=split(aSites(0),",CN=")
	if ubound(aSiteComps) < 2 then
		GetSite="Not Found"
	else
		GetSite=asiteComps(2)
	end if
End Function

Function GetMySite
	set oADSysInfo=createobject("ADSystemInfo")
 	GetMySite=oADSysInfo.SiteName
End Function

Function SQLQuery(sSQServer,sSQDB,sSQQuery)
	Set oSQRS = WScript.CreateObject("ADODB.Recordset")
	oSQRS.Open sSQQuery,"Provider=sqloledb;Data Source="&sSQServer&";Initial Catalog="&sSQDB&";Integrated Security=SSPI",3
	if oSQRS.recordcount < 1 then
		SQLQuery=Array("no results")
		set oSQRS=Nothing
		exit function
	end if
	redim preserve aSQResults(oSQRS.recordcount-1)
	iSQ=0
	while not oSQRS.EOF
		if oSQRS.Fields.count>1 then
			for xSQ=0 to oSQRS.Fields.count-1
				if xSQ=0 then
					sTemp=oSQRS.Fields(xSQ).Value
				else
					sTemp=sTemp&","&oSQRS.Fields(xSQ).Value
				end if
			next
			aSQResults(iSQ)=sTemp
		else
			aSQResults(iSQ)=oSQRS.Fields(0).Value
		end if
		iSQ=iSQ+1
		oSQRS.MoveNext
	wend
	SQLQuery=aSQResults
End Function

Function GetOS(sServer)
	set oGSFS=createobject("scripting.filesystemobject")
	if oGSFS.FileExists("\\"&sServer&"\admin$\system32\wbem\wmic.exe") then
		GetOS="W2K3"
	elseif oGSFS.FileExists("\\"&sServer&"\admin$\system32\runas.exe") then
		GetOS="W2K"
	else
		GetOS="NT4"
	end if
	set oGSFS=Nothing

	'WMI unreliable on NT4 otherwise below will also work:
	'On Error Resume next
	'Set oLocator=CreateObject("WbemScripting.SWbemLocator")
	'Set oWMISvc=oLocator.ConnectServer(sServer,"root/cimV2")
	'If Err.Number <> 0 Then
	'	WScript.Echo("error")
	'	sErr="0x"&Cstr(hex(Err.Number))
	'	sDesc=Err.Description
	'	Err.Clear()
	''	Set oWMISvc=oLocator.ConnectServer(sServer,"root/cimV2",,,,ntlmdomain,128) ' only works on xt and above
	'	Set oWMISvc=oLocator.ConnectServer(sServer,"root/cimV2",,,,ntlmdomain)
	'	If Err.Number <> 0 Then
	'		WScript.Echo "Error "&sErr&" ("&sDesc&") connecting to WMI on server "&sServer
	'		GetOS="Couldn't get Server OS"
	'		Exit Function
	'	End If	
	'End If
	'Set WMIConnect=oWMISvc
	'set oOSes=oWMISvc.ExecQuery("select Name, CSDVersion from Win32_OperatingSystem") ' where Primary='True'") 
	'for each oOs in oOSes
	'	sName=oOS.Name
	'	sName=Replace(sName,"Windows NT Server","Windows NT 4.0 Server")
	'	if instr(sName,"|") then
	'		aTmp=split(sName,"|")
	'		sName=aTmp(0)
	'	end if
	'	if (instr(sName,"NT 4.0") > 0) then GetOS="NT4"
	'	if (instr(sName,"Windows 2000 Server") > 0) then GetOS="W2K"
	'	if (instr(sName,"Windows Server 2003") > 0) then GetOS="W2K3"
	'next
End Function

Function IsWscript
	IsWscript=False
	if instr(lcase(wscript.fullname),"wscript.exe")>0 then IsWscript=True
End Function

Function SortArray(ByRef aDatatoSort, ByVal sOrder)
	'sOrder should be either "ASC" or "DESC" for ascending or descending sort
	'Modifies array directly and returns 0 if no errors.  Otherwise, returns error code.
	if ucase(sOrder)="DESC" then
		sOrder="DESC"
	else
		sOrder="ASC"
	end if
	SortArray=0
	on error resume next
	adVarChar=200
	adUseClient=3
	adOpenKeyset=1
	adLockOptimistic=3

	set oSA_RS=createobject("ADOR.recordset") 'lighter weight than adodb
	SortArray=err.number
	Set oSA_RS.ActiveConnection = Nothing
	oSA_RS.CursorLocation = adUseClient
	oSA_RS.CursorType = adOpenKeyset
	oSA_RS.LockType = adLockOptimistic


	oSA_RS.Fields.append "SortMe",adVarChar, 255
	SortArray=err.number
	oSA_RS.open
	SortArray=err.number
	for iSA_Counter=0 to ubound(aDatatoSort)
		oSA_RS.addnew "SortMe",aDatatoSort(iSA_Counter)
	next
	oSA_RS.update
	SortArray=err.number
	oSA_RS.sort = "SortMe "&sOrder
	SortArray=err.number
	oSA_Rs.moveFirst
	iSA_Counter=0
	while not oSA_Rs.EOF
		aDatatoSort(iSA_Counter)=oSA_RS.fields(0).value
		oSA_RS.movenext
		iSA_Counter=iSA_Counter+1
	wend
End Function

Function SortDictionary(ByRef dDatatoSort,ByVal bBykey, ByVal sOrder)
	'bByKey sould be True to sort by keys and False to sort by values.
	'sOrder should be either "ASC" or "DESC" for ascending or descending sort
	'Modifies array directly and returns 0 if no errors.  Otherwise, returns error code.
	if ucase(sOrder)="DESC" then
		sOrder="DESC"
	else
		sOrder="ASC"
	end if
	
	SortArray=0
	on error resume next
	adVarChar=200
	adUseClient=3
	adOpenKeyset=1
	adLockOptimistic=3

	set oSA_RS=createobject("ADOR.recordset") 'lighter weight than adodb
	if err.number <> 0 then
		SortArray=err.number
		err.clear
		exit function
	end if
	Set oSA_RS.ActiveConnection = Nothing
	oSA_RS.CursorLocation = adUseClient
	oSA_RS.CursorType = adOpenKeyset
	oSA_RS.LockType = adLockOptimistic


	oSA_RS.Fields.append "Keys",adVarChar, 255
	oSA_RS.Fields.append "Values",adVarChar, 255
	if err.number <> 0 then
		SortArray=err.number
		err.clear
		exit function
	end if

	oSA_RS.open
	if err.number <> 0 then
		SortArray=err.number
		err.clear
		exit function
	end if

	for each sSA_Key in dDatatoSort.Keys
		oSA_RS.addnew array("Keys","Values"),array(sSA_Key,dDatatoSort(sSA_Key))
	next
	oSA_RS.update
	if err.number <> 0 then
		SortArray=err.number
		err.clear
		exit function
	end if

	sSortColumn="Values"
	if bByKey then sSortColumn="Keys"	
	oSA_RS.sort = sSortColumn&" "&sOrder
	if err.number <> 0 then
		SortArray=err.number
		err.clear
		exit function
	end if

	oSA_Rs.moveFirst
	set oSA_Dictionary=createobject("scripting.dictionary")
	if err.number <> 0 then
		SortArray=err.number
		err.clear
		exit function
	end if

	while not oSA_Rs.EOF
		oSA_Dictionary.add oSA_RS.fields("Keys").value,oSA_RS.fields("Values").value
		if err.number <> 0 then
			SortArray=err.number
			err.clear
			exit function
		end if
		oSA_RS.movenext
	wend
	set dDatatoSort=oSA_Dictionary
	if err.number <> 0 then
		SortArray=err.number
		err.clear
	end if
End Function

Function QuerytoXLS(ByVal sQXLSServer,ByVal sQXLSDB,ByVal sQXLSQuery,ByRef oQXLSRange)
	'Copies results of query to range in spreadsheet
	'Returns number of rows updated
	Set oQXLSRS = WScript.CreateObject("ADODB.Recordset")
	set oQXLSConn=wscript.createobject("ADODB.Connection")
	set oQXLSCmd=wscript.createobject("ADODB.Command")
	sQXLSConn="Provider=sqloledb;Data Source="&sQXLSServer&";Integrated Security=SSPI;Trusted Connection = YES;Initial Catalog="&sQXLSDB
	'sQXLSConn = "Provider=sqloledb;Data Source="&sQXLSServer&";Initial Catalog="&sQXLSDB&";uid="&sUID&";pwd="&sPwd 'for standard security.
	'sQXLSConn="Provider=sqloledb;Data Source=tcp:"&sQXLSServer&";Integrated Security=SSPI;Trusted Connection = YES;Initial Catalog="&sQXLSDB 'force tcp connection
	'oQXLSConn.CommandTimeout = 500
	oQXLSConn.Open sQXLSConn
	oQXLSCmd.CommandTimeout = 600 'Wait 10 minutes for query results
	oQXLSCmd.ActiveConnection=oQXLSConn
	oQXLSCmd.CommandText=sQXLSQuery
	set oQXLSRS=oQXLSCmd.Execute
	QuerytoXLS=oQXLSRange.Cells.CopyFromRecordSet(oQXLSRS)
	oQXLSRS.close
	set oQXLSRS=Nothing
	set oQXLsQXLSConn=Nothing
	set oQXLSCmd=Nothing
End Function

Function ldapquerytoXLS(sSource,sQuery,sAttribute,ByRef oLDXLSRange)
	'on error resume next
	'Returns result in aResult.  Surrounds output in quotes and uses comma separation for multivalued results.

	ADS_CHASE_REFERRALS_SUBORDINATE = &H20
	ADS_CHASE_REFERRALS_EXTERNAL = &H40
	ADS_CHASE_REFERRALS_ALWAYS = ADS_CHASE_REFERRALS_SUBORDINATE Or ADS_CHASE_REFERRALS_EXTERNAL
	aAtts=split(sAttribute,",")
	iReturn=ubound(aAtts)
	if iReturn<0 then iReturn=0
	Set oConn = WScript.CreateObject("ADODB.Connection")
	Set oRS = WScript.CreateObject("ADODB.Recordset")
	Set oCommand = WScript.CreateObject("ADODB.Command")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Set oCommand.ActiveConnection = oConn
	wscript.echo "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"
	oCommand.CommandText = "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"

	oCommand.Properties("Page Size") = 99
	oCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
	Set oRS = oCommand.Execute
	'if oRS.recordcount<1 then 
	'	ldapquery=Array("Not Found")
	'	exit function
	'end if
	ldapquery=oLDXLSRange.Cells.CopyFromRecordSet(oRS)
End Function

Function ldapquerytodictionary(sSource,sQuery,sAttribute)
	'on error resume next
	'Returns result in aResult.  Surrounds output in quotes and uses comma separation for multivalued results.

	ADS_CHASE_REFERRALS_SUBORDINATE = &H20
	ADS_CHASE_REFERRALS_EXTERNAL = &H40
	ADS_CHASE_REFERRALS_ALWAYS = ADS_CHASE_REFERRALS_SUBORDINATE Or ADS_CHASE_REFERRALS_EXTERNAL

	set dResult=createobject("scripting.dictionary")
	aAtts=split(sAttribute,",")
	iReturn=ubound(aAtts)
	if iReturn<0 then iReturn=0
	Set oConn = WScript.CreateObject("ADODB.Connection")
	Set oRS = WScript.CreateObject("ADODB.Recordset")
	Set oCommand = WScript.CreateObject("ADODB.Command")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Set oCommand.ActiveConnection = oConn
	wscript.echo "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"
	oCommand.CommandText = "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"

	oCommand.Properties("Page Size") = 99
	oCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
	Set oRS = oCommand.Execute
	if oRS.recordcount<1 then 
		dResult.add "Not Found","Not Found"
		set ldapquerytodictionary=dResult
		exit function
	end if
	oRS.movefirst
	redim Preserve aResult(oRS.recordcount-1)
	x=0
	While Not oRS.EOF      
		'User for multi-attribute queries
		'strTemp=""""
		'for intI = 0 to iReturn
		'	if len(strTemp)>1 then strTemp=strTemp&","""
		'	strTemp=strTemp&CSTR(oRS.Fields(intI).Value)&""""
		'next
		'aResult(x)=strTemp

		dResult.add oRS.Fields(0).Value,"Found"
		x=x+1
	      	oRS.MoveNext
	Wend
	set ldapquerytodictionary=dResult
End Function

Function GetExchangeGC (sExServer)
	'Requires WMIConnect
	'Types - o=local dc, 1=domain dc, 2=gc
	set oWMI=WMIConnectEx(sExServer)
	set oDSAs=oWMI.ExecQuery("select * from Exchange_DSAccessDC where type=2")

	if oDSAs.count>1 then wscript.echo "GC Count="&oDSAs.count
	for each oDSA in oDSAs
		GetExchangeGC=oDSA.Name
	next
end Function	

Function GetExchangeDC (sExServer)
	'Requires WMIConnect
	'Types - o=local dc, 1=domain dc, 2=gc
	set oWMI=WMIConnectEx(sExServer)
	set oDSAs=oWMI.ExecQuery("select * from Exchange_DSAccessDC where type=1")

	if oDSAs.count>1 then wscript.echo "DC Count="&oDSAs.count
	for each oDSA in oDSAs
		GetExchangeDC=oDSA.Name
	next
end Function	

Function WMIConnectEx(sServer)
	'On Error Resume next
	Set oLocator=CreateObject("WbemScripting.SWbemLocator")
	Set oWMISvc=oLocator.ConnectServer(sServer,"root/MicrosoftExchangeV2")
	If Err.Number <> 0 Then
		WScript.Echo("error")
		sErr="0x"&Cstr(hex(Err.Number))
		sDesc=Err.Description
		Err.Clear()
		Set oWMISvc=oLocator.ConnectServer(sServer,"root/cimV2",,,,ntlmdomain)
		If Err.Number <> 0 Then
			WScript.Echo "Error "&sErr&" ("&sDesc&") connecting to WMI on server "&sServer
			Set WMIConnect=WScript.Name
			Exit Function
		End If	
	End If
	Set WMIConnectEx=oWMISvc
End Function

Sub RegisterFile(sFileName)
	'Note file should be in same directory as script

	on error resume next
	sDir=left(wscript.scriptfullname,instrrev(wscript.scriptfullname,"\"))
	wscript.echo "Attempting to copy and register "&sDir&sFileName
	'Copy file to system32 directory
	set oShell=CreateObject("wscript.shell")
	sSysDir=oShell.Environment("Process").Item("windir")&"\system32\"
	sDLL=sDir&sFileName
	set oFS=createobject("scripting.filesystemobject")
	sLocalDLL=sSysDir&sFileName
	err.clear
	oFS.CopyFile sDLL,sSysDir
	if err.number <> 0 then
		wscript.echo "Error: "&cstr(hex(err.number))&" "&err.description&" copying "&sFileName&" to "&sSysDir&". Quitting..."
		wscript.quit
	end if
	iResult=oShell.run ("%windir%\system32\regsvr32.exe /s """&sLocalDLL&"""",2,True)
	if iResult <> 0 then
		wscript.echo "Error "&iResult&" registering "&sFileName&"."
		wscript.quit
	end if
	err.clear
End Sub

Function UTC(sUTCTime)
	'Requires GetTimeZone function
	sSeconds=split(sUTCTime,":")(2)
	sUTCTime=FormatDateTime(sUTCTime,4) 
	sUTCTime="********"&replace(sUTCTime,":","")
	sUTCTime=left(sUTCTime,12)&"00.000000"&GetTimeZone(getobject("winmgmts:"))
	UTC=sUTCTime
End Function

Function GetTimeZone(oGTZWMI)
	Set oOSes = oGTZWMI.InstancesOf("Win32_OperatingSystem")

	For Each oOS In oOSes
		if oOS.Primary then
	    		GetTimeZone=oOS.CurrentTimeZone
		end if
	next
	set oOSes=Nothing
End Function

Function GetKeys(sServer,sKeyPath)
	'Returns subkeys in array

	'Get Registry Root
	sRoot=ucase(left(sKeyPath,instr(sKeyPath,"\")-1))

	'Set hRoot and remove registry root from path
	select case sRoot
		case "HKEY_CLASSES_ROOT","HKCR"
			hRoot=&H80000000
			sPath=right(sKeyPath,len(sKeyPath)-instr(sKeyPath,"\"))
		case "HKEY_CURRENT_USER","HKCU"
			hRoot=&H80000001
			sPath=right(sKeyPath,len(sKeyPath)-instr(sKeyPath,"\"))
		case "HKEY_LOCAL_MACHINE","HKLM"
			hRoot=&H80000002
			sPath=right(sKeyPath,len(sKeyPath)-instr(sKeyPath,"\"))
		case "HKEY_USERS","HKU"
			hRoot=&H80000003
			sPath=right(sKeyPath,len(sKeyPath)-instr(sKeyPath,"\"))
		case "HKEY_CURRENT_CONFIG","HKCC"
			hRoot=&H80000005
			sPath=right(sKeyPath,len(sKeyPath)-instr(sKeyPath,"\"))
		case "HKEY_DYN_DATA","HKDD"
			hRoot=&H80000006
			sPath=right(sKeyPath,len(sKeyPath)-instr(sKeyPath,"\"))
		case else
			hRoot=&H80000002
	end select
	
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sServer & "\root\default:StdRegProv")
	iReturn=oReg.EnumKey(hRoot, sPath, aSubKeys)

	if iReturn <> 0 then
		wscript.echo "Error "&iReturn&" enumerating registry values under HKLM\Software\Microsoft\Windows NT\CurrentVersion\Hotfix"
		wscript.quit
	end if

	GetKeys=aSubKeys
End Function


Function QuerytoDictionary(ByVal sQDServer,ByVal sQDDB,ByVal sQDQuery)
	'Assumes query will only return two fields
	Set oQDRS = WScript.CreateObject("ADODB.Recordset")
	set oQDConn=wscript.createobject("ADODB.Connection")
	set oQDCmd=wscript.createobject("ADODB.Command")
	sQDConn="Provider=sqloledb;Data Source="&sQDServer&";Integrated Security=SSPI;Trusted Connection = YES;Initial Catalog="&sQDDB
	oQDConn.Open sQDConn
	oQDCmd.CommandTimeout = 600 'Wait 10 minutes for query results
	oQDCmd.ActiveConnection=oQDConn
	oQDCmd.CommandText=sQDQuery
	set oQDRS=oQDCmd.Execute
	set dQDResult=createobject("scripting.dictionary")
	'Need to change cursor to get recordcount
	'if oQDRS.recordcound=0 then
	'	dQDResult.add "None Found","None Found"
	'	QuerytoDictionary=dQDResult
	'	exit function
	'end if
	while not oQDRS.EOF
		if not dQDResult.exists(oQDRS.fields(0).value) then
			dQDResult.add oQDRS.fields(0).value,oQDRS.fields(1).value
		end if
		oQDRS.movenext
	wend
	oQDRS.close
	set QuerytoDictionary=dQDResult
	set oQDRS=Nothing
	set oQDConn=Nothing
	set oQDCmd=Nothing
End Function

Function QuerytoArray(ByVal sQDServer,ByVal sQADB,ByVal sQAQuery)
	'Assumes query will only return one field
	Set oQARS = WScript.CreateObject("ADODB.Recordset")
	set oQAConn=wscript.createobject("ADODB.Connection")
	set oQACmd=wscript.createobject("ADODB.Command")
	sQAConn="Provider=sqloledb;Data Source="&sQDServer&";Integrated Security=SSPI;Trusted Connection = YES;Initial Catalog="&sQADB
	oQAConn.Open sQAConn
	oQACmd.CommandTimeout = 600 'Wait 10 minutes for query results
	oQACmd.ActiveConnection=oQAConn
	oQACmd.CommandText=sQAQuery
	set oQARS=oQACmd.Execute
	'Need to change cursor to get recordcount
	'if oQARS.recordcound=0 then
	'	dQAResult.add "None Found","None Found"
	'	QuerytoArray=Array("none found")
	'	exit function
	'end if
	QDix=0
	while not oQARS.EOF
		redim preserve aQAResult(ix)
		aQAResult(ix)=oQARS.fields(0).value
		ix=ix+1
		oQARS.movenext
	wend
	if ix=0 then aQAResult=Array("None Found")
	oQARS.close
	QuerytoArray=aQAResult
	set oQARS=Nothing
	set oQAConn=Nothing
	set oQACmd=Nothing
End Function

Function ConvertToUTC(strTimeTmp,bTZAdj)

   'From http://msdn.microsoft.com/library/default.asp?url=/library/en-us/mmsdev/mms/example__converting_local_time_to_utc_time.asp
   'Requires function FormatDatePart
   'On Error Resume Next
   'Parses a date time string passing in the following format
   '6/13/2005 9:29:17 AM - Month/Day/Year Hour:Minutes:Seconds AM or PM
   'If bTZAdj=False, does not change time zone.

   strTime=split(split(strTimeTmp," ")(0),"/")(2)&FormatDatePart(split(split(strTimeTmp," ")(0),"/")(0))&FormatDatePart(split(split(strTimeTmp," ")(0),"/")(1))&FormatDatePart(split(split(strTimeTmp," ")(1),":")(0))&FormatDatePart(split(split(strTimeTmp," ")(1),":")(1))&FormatDatePart(split(split(strTimeTmp," ")(1),":")(2))
   AMPM=lcase(split(strTimeTmp," ")(2))

   Dim strDateTime, UTCDate, Computer
   Dim YerArg : YerArg = left(strTime,4   )
   Dim MonArg : MonArg = mid (strTime,5,2 )
   Dim DayArg : DayArg = mid (strTime,7,2 )
   Dim HrsArg : HrsArg = mid (strTime,9,2 ) 
   Dim MinArg : MinArg = mid (strTime,11,2)
   Dim SecArg : SecArg = mid (strTime,13,2)
   ToUTC 	= True
   TimeConst	= "UTC"
   'AMPM 	= "am"
   convertMil	= "000"

   Select Case AMPM
   	Case "pm"
	   If HrsArg < 12 Then HrsArg = HrsArg + 12
   	Case "am"
	   If HrsArg = 12 Then HrsArg = "00"
   End Select




   'Use Win32_ComputerSystem CurrentTimeZone property, because it automatically adjusts the
   'Time Zone bias for daylight saving time Win32_Time Zone Bias property does not.

   'Get the machines current time zone offset
   For Each LocalTimeZone in GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
   	TimeZoneOffset = LocalTimeZone.CurrentTimeZone
   Next

   'Wscript.Echo "The current time difference is " & TimeZoneOffset & " minutes (" & TimeZoneOffset/60 & " hrs)" 

   strDateTime = MonArg & "-" & DayArg & "-" & YerArg & " " & HrsArg & ":" & MinArg & ":" & SecArg

   if not bTzAdj then TimeZoneOffset = 0
   if TimeZoneOffset < 0 Then
	if ToUTC then
		UTCDate = DateAdd("n",  ABS(TimeZoneOffset), strDateTime)
	else
		UTCDate = DateAdd("n", -ABS(TimeZoneOffset), strDateTime)
	end if
   else
	if ToUTC then
		UTCDate = DateAdd("n", -ABS(TimeZoneOffset), strDateTime)
	else
		UTCDate = DateAdd("n", ABS(TimeZoneOffset), strDateTime)
	end if
   end if

   If Err.Number <> 0 Then 
	Wscript.Echo "ConvertToUTC::Invalid Argument"
	Usage
   End If
    ConvertToUTC = Trim(Year(UTCDate) & "-" & FormatDatePart(Month(UTCDate)) & "-" & FormatDatePart(Day(UTCDate)) & "T" & FormatDatePart(Hour(UTCDate)) & ":" & FormatDatePart(Minute(UTCDate)) & ":" & FormatDatePart(Second(UTCDate)))&"Z"
   'ConvertToUTC = Trim(Year(UTCDate) & "-" & FormatDatePart(Month(UTCDate)) & "-" & FormatDatePart(Day(UTCDate)) & "T" & FormatDatePart(Hour(UTCDate)) & ":" & FormatDatePart(Minute(UTCDate)) & ":" & FormatDatePart(Second(UTCDate))) & "." & convertMil

End Function

Function ConvertToUTCSample(strTime)
   'From http://msdn.microsoft.com/library/default.asp?url=/library/en-us/mmsdev/mms/example__converting_local_time_to_utc_time.asp
   'Requires function FormatDatePart
   'On Error Resume Next
   'Parses a date time string passing in the following format
   '20040806065423 - Year Month Day Hour Minutes Seconds

   Dim strDateTime, UTCDate, Computer
   Dim YerArg : YerArg = left(strTime,4   )
   Dim MonArg : MonArg = mid (strTime,5,2 )
   Dim DayArg : DayArg = mid (strTime,7,2 )
   Dim HrsArg : HrsArg = mid (strTime,9,2 ) 
   Dim MinArg : MinArg = mid (strTime,11,2)
   Dim SecArg : SecArg = mid (strTime,13,2)
   ToUTC 	= True
   TimeConst	= "UTC"
   AMPM 	= "am"
   convertMil	= "000"

   'Use Win32_ComputerSystem CurrentTimeZone property, because it automatically adjusts the
   'Time Zone bias for daylight saving time Win32_Time Zone Bias property does not.

   'Get the machines current time zone offset
   For Each LocalTimeZone in GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
   	TimeZoneOffset = LocalTimeZone.CurrentTimeZone
   Next

   'Wscript.Echo "The current time difference is " & TimeZoneOffset & " minutes (" & TimeZoneOffset/60 & " hrs)" 

   strDateTime = MonArg & "-" & DayArg & "-" & YerArg & " " & HrsArg & ":" & MinArg & ":" & SecArg

   if TimeZoneOffset < 0 Then
	if ToUTC then
		UTCDate = DateAdd("n",  ABS(TimeZoneOffset), strDateTime)
	else
		UTCDate = DateAdd("n", -ABS(TimeZoneOffset), strDateTime)
	end if
   else
	if ToUTC then
		UTCDate = DateAdd("n", -ABS(TimeZoneOffset), strDateTime)
	else
		UTCDate = DateAdd("n", ABS(TimeZoneOffset), strDateTime)
	end if
   end if

   If Err.Number <> 0 Then 
	Wscript.Echo "ConvertToUTC::Invalid Argument"
	Usage
   End If
    ConvertToUTCSample = Trim(Year(UTCDate) & "-" & FormatDatePart(Month(UTCDate)) & "-" & FormatDatePart(Day(UTCDate)) & "T" & FormatDatePart(Hour(UTCDate)) & ":" & FormatDatePart(Minute(UTCDate)) & ":" & FormatDatePart(Second(UTCDate)))&"Z"
   'ConvertToUTC = Trim(Year(UTCDate) & "-" & FormatDatePart(Month(UTCDate)) & "-" & FormatDatePart(Day(UTCDate)) & "T" & FormatDatePart(Hour(UTCDate)) & ":" & FormatDatePart(Minute(UTCDate)) & ":" & FormatDatePart(Second(UTCDate))) & "." & convertMil

End Function

Function ConvertToUTCNOW

   'From http://msdn.microsoft.com/library/default.asp?url=/library/en-us/mmsdev/mms/example__converting_local_time_to_utc_time.asp
   'Requires function FormatDatePart
   'On Error Resume Next
   'Parses a date time string passing in the following format
   '20040806065423 - Year Month Day Hour Minutes Seconds
   strTimeTmp=Now

   strTime=split(split(strTimeTmp," ")(0),"/")(2)&FormatDatePart(split(split(strTimeTmp," ")(0),"/")(0))&FormatDatePart(split(split(strTimeTmp," ")(0),"/")(1))&FormatDatePart(split(split(strTimeTmp," ")(1),":")(0))&FormatDatePart(split(split(strTimeTmp," ")(1),":")(1))&FormatDatePart(split(split(strTimeTmp," ")(1),":")(2))
   AMPM=lcase(split(strTimeTmp," ")(2))

   Dim strDateTime, UTCDate, Computer
   Dim YerArg : YerArg = left(strTime,4   )
   Dim MonArg : MonArg = mid (strTime,5,2 )
   Dim DayArg : DayArg = mid (strTime,7,2 )
   Dim HrsArg : HrsArg = mid (strTime,9,2 ) 
   Dim MinArg : MinArg = mid (strTime,11,2)
   Dim SecArg : SecArg = mid (strTime,13,2)
   ToUTC 	= True
   TimeConst	= "UTC"
   'AMPM 	= "am"
   convertMil	= "000"


   'Use Win32_ComputerSystem CurrentTimeZone property, because it automatically adjusts the
   'Time Zone bias for daylight saving time Win32_Time Zone Bias property does not.

   'Get the machines current time zone offset
   For Each LocalTimeZone in GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
   	TimeZoneOffset = LocalTimeZone.CurrentTimeZone
   Next

   'Wscript.Echo "The current time difference is " & TimeZoneOffset & " minutes (" & TimeZoneOffset/60 & " hrs)" 

   strDateTime = MonArg & "-" & DayArg & "-" & YerArg & " " & HrsArg & ":" & MinArg & ":" & SecArg

   if TimeZoneOffset < 0 Then
	if ToUTC then
		UTCDate = DateAdd("n",  ABS(TimeZoneOffset), strDateTime)
	else
		UTCDate = DateAdd("n", -ABS(TimeZoneOffset), strDateTime)
	end if
   else
	if ToUTC then
		UTCDate = DateAdd("n", -ABS(TimeZoneOffset), strDateTime)
	else
		UTCDate = DateAdd("n", ABS(TimeZoneOffset), strDateTime)
	end if
   end if

   If Err.Number <> 0 Then 
	Wscript.Echo "ConvertToUTC::Invalid Argument"
	Usage
   End If
    ConvertToUTCNow = Trim(Year(UTCDate) & "-" & FormatDatePart(Month(UTCDate)) & "-" & FormatDatePart(Day(UTCDate)) & "T" & FormatDatePart(Hour(UTCDate)) & ":" & FormatDatePart(Minute(UTCDate)) & ":" & FormatDatePart(Second(UTCDate)))&"Z"
   'ConvertToUTC = Trim(Year(UTCDate) & "-" & FormatDatePart(Month(UTCDate)) & "-" & FormatDatePart(Day(UTCDate)) & "T" & FormatDatePart(Hour(UTCDate)) & ":" & FormatDatePart(Minute(UTCDate)) & ":" & FormatDatePart(Second(UTCDate))) & "." & convertMil

End Function

Function FormatDatePart(str)
   if Len(str) < 2 Then str = "0" & str
   FormatDatePart = str
   If not IsNumeric(str) Then 
	WScript.Echo "FormatDatePart::Invalid arguments"
   End If
End Function

Function GetNetbiosName
	Set oSysinfo = CreateObject("ADSystemInfo")
	GetNetbiosName = oSysinfo.DomainShortName
End Function

Function GetPoliciesIncluded(sGPISMTP,oGPIUser)
	'Requires ldapquery and GetSID_String functions
	'sGPISMTP must be primary smtp address stamped by policy.
	sMyOrg = "Org Name"
	sMyDomain = "domain name"

	'Find Policy that stamps sGPISMTP address
	aGPIPolicyPaths=ldapquery("CN=Recipient Policies,CN="&sMyOrg&",CN=Microsoft Exchange,CN=Services,CN=Configuration,DC="&smyDomain&",DC=com","gatewayProxy=SMTP:*"&sGPISMTP,"ADsPath")
	sGPIPolicyPath=""

	'If more than one policy applies this address, find policy with query that includes oGPIUser
	if ubound(aGPIPolicyPaths)>0 then
		for each sGPIPolPath in aGPIPolicyPaths
			set oGPIPol=getobject(sGPIPolPath)
			sGPIFound=""
			sGPIFound=ldapquery("ou=organizations,dc="&sMyDomain&",dc=com","&(cn="&oGPIUser.cn&")"&oGPIPol.purportedSearch,"ADsPath")(0)
			if lcase(sGPIFound)=lcase(oGPIUser.ADsPath) then
				sGPIPolicyPath=sGPIPolPath
			end if
		next
		if len(sGPIPolicyPath)=0 then
			GetPoliciesIncluded="Couldn't find matching Policy"
			exit function
		end if
	else
		sGPIPolicyPath=aGPIPolicyPaths(0)
	end if
	if sGPIPolicyPath="Not Found" then
		GetPoliciesIncluded="Can't find policy for address SMTP:*"&sGPISMTP
		exit function
	end if
	set oGPIPol=getObject(sGPIPolicyPath)
	GetPoliciesIncluded=GetSID_String(oGPIPol.objectGUID)&","&GetSID_String(oGPIPol.msExchPolicyOptionList)
End Function

Function GetSID_String(bGSSSid)
	'Will convert sid into format that is used by msExchPoliciesIncluded user attribute.

	sGSSSid=""
	for iGSSCounter=1 to len(bGSSSid)
		sGSSSubAut="0x"
		sGSSSubAut=cstr(hex(ascw(mid(bGSSSid,iGSSCounter))))
		do while len(sGSSSubAut)<4
			sGSSSubAut="0"&sGSSSubAut
		loop
		sGSSSubAut=right(sGSSSubAut,2)&left(sGSSSubAut,2)
		sGSSSid=sGSSSid&sGSSSubAut
	next

	if len(sGSSSid)<> 32 then
		getSID_String=sGSSSid
		exit function
	end if

	for iGSSCounter=7 to 1 step -2
		sGSSNewSID=sGSSNewSID&mid(sGSSSid,iGSSCounter,2)
	next
	sGSSNewSID=sGSSNewSID&"-"
	for iGSSCounter=11 to 9 step -2
		sGSSNewSID=sGSSNewSID&mid(sGSSSid,iGSSCounter,2)
	next
	sGSSNewSID=sGSSNewSID&"-"
	for iGSSCounter=15 to 13 step -2
		sGSSNewSID=sGSSNewSID&mid(sGSSSid,iGSSCounter,2)
	next
	sGSSNewSID=sGSSNewSID&"-"
	for iGSSCounter=17 to 19 step 2
		sGSSNewSID=sGSSNewSID&mid(sGSSSid,iGSSCounter,2)
	next
	sGSSNewSID=sGSSNewSID&"-"&mid(sGSSSid,21,len(sGSSSid)-20)
	GetSID_String="{"&sGSSNewSID&"}"
End Function


Function GetDomainRole(sGDRole,sGDRDC)
	'From http://support.microsoft.com/default.aspx?scid=kb;en-us;235617
	'Requires ldapquery function
	'Note need to set source to set oRoot=GetObject(LDAP://sDC/rootdse), oRoot.get("schemaNamingContext") and oRoot.get(""configurationNamingContext"") for schema and domain naming masters
	'sGDRole values are one of: infrastructureUpdate, domainDNS, rIDManager, crosRefContainer, dMD

	sGDRoleQuery=ldapquery(sGDRDC,"&(objectClass="&sGDRole&")(fSMORoleOwner=*)","ADsPath")(0)

	if sGDRoleQuery="Not Found" then
		wscript.echo "Error getting "&sGDRole&" from "&sGDRDC&"."
		exit function
	end if

	set oGDRDomain=GetObject(sGDRoleQuery)
	GetDomainRole="LDAP://"&oGDRDomain.fSMORoleOwner
	if instr(GetDomainRole,"LDAP://") < 1 then
		wscript.echo "Error getting "&sGDRole&" from "&sGDRDC&"."
		exit function
	end if
	GetDomainROle=replace(GetDomainRole,"CN=NTDS Settings,","")
	GetDomainRole=split(GetDomainRole,",CN=")(0)
	GetDomainROle=replace(GetDomainRole,"LDAP://","")
	GetDomainROle=replace(GetDomainRole,"CN=","")
End Function

Function PatternMatchFiles(sPMDirectory,sPMPattern)
	'Requires filetoarray if cscript version is less than 5.6
	set oPMShell=createobject("wscript.shell")
	if right(sPMDirectory,1)<> "\" then sPMDirectory=sPMDirectory&"\"
	if wscript.version<5.6 then
		sPMCurrDir=left(wscript.scriptfullname,instrrev(wscript.scriptfullname,"\"))
		oPMShell.Run "cmd /c dir /b """&sPMDirectory&sPMPattern&""" > """&sPMCurrDir&"dir~tmp.txt""",0,True
		aPMResult=FileToArray(sPMCurrDir&"dir~tmp.txt")
	else
		set oPMDir=oPMShell.exec("cmd /c dir /b """&sPMDirectory&sPMPattern&"""")
		set oPMOut=oPMDir.stdOut
		iPMCount=0
		Do while not oPMOut.AtEndOfStream
			sPMLine=oPMOut.ReadLine
			redim preserve aPMResult(iPMCount)
			aPMResult(iPMCount)=sPMLine
			iPMCount=iPMCount+1

		Loop
	end if
	if not IsArray(aPMResult) then aPMResult=Array("File Not Found")
	PatternMatchFiles=aPMResult
End Function

Function GetGUID_Ex5String(bGUID)
	'Emulates the ADsEncodeBinaryData function.  
	'Will convert guid into format that can be used in ldap query against Ex5.5 attribute msexchADCGlobalNames
	Dim iIndex,sSubAut,sGUID
	for iIndex=1 to len(bGUID)
		sSubAut=cstr(hex(ascw(mid(bGUID,iIndex))))
		do while len(sSubAut)<4
			sSubAut="0"&sSubAut
		loop
		sSubAut=right(sSubAut,2)&left(sSubAut,2)
		sGUID=sGUID&sSubAut
	next
	GetGuid_Ex5String=sGUID
End Function

Function GetX500(sGXAdspath)
	Dim sGXAddr,aGXtmp,sGXResult,sGXPart
	'if instr(sGXADsPath,"/") < 1 then exit function
	'sGXAddr=split(sGXAdspath,"/")(ubound(split(sGXADsPath,"/")))
	sGXAddr=sGXAdspath
	aGXtmp=split(sGXAddr,",")
	sGXResult=""
	if not IsArray(aGXTmp) then exit function
	for each sGXPart in aGXTmp
		if sGXResult="" then
			sGXResult=sGXPart
		else
			sGXResult=sGXPart&"/"&sGXResult
		end if
	next
	GetX500="/"&sGXResult
End Function

Function GetTextBetween(sGTBText,sGTBStart,sGTBEnd)
	'Returns text between two text tokens
	iGTBStart=instr(sGTBText,sGTBStart)+len(sGTBStart)
	iGTBEnd=instr(iGTBStart,sGTBText,sGTBEnd)
	GetTextBetween=mid(sGTBText,iGTBStart,iGTBEnd - iGTBStart)
End Function

Function ArrayToString(ATSArray,ATSDelim)
	'Opposite of split function - unsplit???
	if not IsArray(ATSArray) then
		ArrayToString=ATSArray
		exit function
	end if

	ATSResult=""
	for each ATSValue in ATSArray
		if len(ATSResult)=0 then
			ATSResult=ATSValue
		else
			ATSResult=ATSResult&ATSDelim&ATSValue
		end if
	next
	ArrayToString=ATSResult
End Function

Function AddArrays(AA1,AA2)
	Redim AAResult(ubound(AA1)+ubound(AA2)+1)
	for iAA = 0 to ubound(AA1)
		AAResult(iAA)=AA1(iAA)
	next

	iAABase=ubound(AA1)+1
	for iAA = 0 to ubound(AA2)
		AAResult(iAA+iAABase)=AA2(iAA)
	next
	AddArrays=AAResult
End Function

Function GetFolderGUI()
	BIF_NEWDIALOGSTYLE = &h40
	BIF_EDITBOX = &h10
	BIF_NONEWFOLDERBUTTON = &h200
	BIF_SHAREABLE = &h8000
	BIF_VALIDATE = &h20
	BIF_EDITBOX = &h10
	BIF_STATUSTEXT = &h4
	BIF_USENEWUI=BIF_NEWDIALOGSTYLE Or BIF_EDITBOX or BIF_VALIDATE or BIF_SHAREABLE
	set oShell=createobject("Shell.Application")
	'See ShellSpecialFolderConstants for third parameter optinos
	set oFolder=oShell.BrowseForFolder(0,"Please choose a folder",BIF_USENEWUI,0)
	'set oFolder=oShell.BrowseForFolder(0,"Please choose a folder",BIF_USENEWUI,"c:\")

	if len(TypeName(oFolder)) < 6 then
		exit function
	end if
	if lcase(left(TypeName(oFolder),6))<>"folder" then
		exit function
	end if
	set oFolderItem=oFolder.Items.Item
	GetFolderGUI=oFolderItem.Path
End Function

Function GetNumber(sGN)
	'Limits from http://msdn2.microsoft.com/en-us/library/9e7a57cf.aspx
	GetNumber=sGN
	if IsNumeric(sGN) then
		if (sGN > -32768) and (sGN < 32767) then
			GetNumber=CInt(sGN)
		elseif (sGN > -2147483648) and (sGN < 2147483647) then
			GetNumber=CLng(sGN)
		else
			GetNumber=CDbl(sGN)
		end if
	end if
End Function


Function GetSite(sExServer)
	'Requires ExLdapquery
	sADPath=Exldapquery(sExServer,"&(rdn="&sExServer&")(objectClass=computer)","ADsPath")
	aComponents=split(sADPath,",")
	GetSite=replace(aComponents(ubound(aComponents)-1),"ou=","")
End Function

Function GetSite2(sExServer)
	'Gets Site without using LDAP
	set oExServer=GetObject("LDAP://"&sExServer)
	set oRoot=GetObject("LDAP://"&sExServer&"/rootDSE")
	for each oExOU in oExServer
		for each oContainer in oExOU
			if oContainer.name="cn=Configuration" then
				for each oSub in oContainer
					if oSub.name="cn=Servers" then
						for each oServer in oSub
							if oServer.Class="Computer" then
								sServerName=""
								sServerName=replace(lcase(oServer.name),"cn=","")
								if lcase(sExServer)=sServerName then 
									aComponents=split(oServer.ADsPath,",")
									'sExOrg=replace(aComponents(ubound(aComponents)),"o=","")
									GetSite2=replace(aComponents(ubound(aComponents)-1),"ou=","")
								end if
							end if
						next
					end if
				next
			end if
		next
	next
End Function

Sub ShowAB
	set oCDO=createobject("mapi.session")
	oCDO.logon "bh"
	set oAB=oCDO.AddressLists(1)
	wscript.echo TypeName(oAB)
	ix=0
	for each oAddr in oAB.AddressEntries
		'wscript.echo TYpeName(oAddr)
		wscript.echo oAddr.name
		if ix>10 then
			oCDO.logoff
			wscript.quit
		end if
		ix=ix+1
	next
End Sub

Function GetOrg(sExServer)
	set oExRoot=GetObject("LDAP://"&sExServer&"/rootDSE")
	GetOrg=replace(oExRoot.Get("defaultNamingContext"),"o=","")
End Function

Function GetOrgE2K(sServer)
	'Requires Simpleldap query.
	set oRoot=GetObject("LDAP://"&sServer&"/rootDSE")
	sConfig = oRoot.Get("configurationNamingContext")
	GetOrgE2K=ldapquery(sServer&"/"&sConfig,"objectCategory=msExchOrganizationContainer","name")(0)
End Function

Function GetAdminGroup(sServer)
	'requires ldapquery
	set oRoot=GetObject("LDAP://"&sServer&"/rootDSE")
	sConfig = oRoot.Get("configurationNamingContext")
	sPath=ldapquery(sServer&"/"&sConfig,"objectCategory=msExchExchangeServer","ADsPath")(0)
	aTmp=split(sPath,",")
	GetAdminGroup=replace(aTmp(2),"CN=","")
End Function

Function Exldapquery(sSource,sQuery,sAttribute)
	'on error resume next
	'Returns result in aResult.  Surrounds output in quotes and uses comma separation for multivalued results.
	aAtts=split(sAttribute,",")
	iReturn=ubound(aAtts)
	if iReturn<0 then iReturn=0
	Set oConn = WScript.CreateObject("ADODB.Connection")
	Set oRS = WScript.CreateObject("ADODB.Recordset")
	Set oCommand = WScript.CreateObject("ADODB.Command")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Set oCommand.ActiveConnection = oConn
	oCommand.CommandText = "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"

	oCommand.Properties("Page Size") = 99
	Set oRS = oCommand.Execute
	'if oRS.recordcount<1 then 
	'	wscript.echo "No addresses found.  Exiting..."
	'	wscript.quit
	'end if
	oRS.movefirst
	Exldapquery=CSTR(oRS.Fields(0).Value)
End Function

Function GetMsgRoot(sExServer,sMailbox)
	'Gets count of messages in Root Mailbox Store.
	'sMailbox is mailbox rdn and sExServer is server name 
	sProfile=sExServer&chr(10)&sMailbox
	oSession.Logon "", "", Flase, True, False, False, sProfile
	sName="Mailbox - "&oSession.CurrentUser
	set oMbx=oSession.Infostores.Item(sName).RootFolder	
	iRootID=oMbx.FOlderID
	Set oRoot = oSession.GetFolder (iRootID)
	GetMsgRoot=oSession.CurrentUser&","&oRoot.Messages.Count
	oSession.Logoff
End Function

Function GetMyAddress(oSession)
	sPath=oSession.CurrentUser.Address
	sServer="myexchange55server"
	set oRecip=GetObject("LDAP://"&sServer&"/"&sPath)
	GetMyAddress=oRecip.rfc822mailbox
End Function

Function ProperDN(sBadDN)
	'converts comma-delimited dn from home-mdb or adspath into proper dn for exchange profile creation
	sDNRev=replace(sBadDN,",cn=","/cn=")
	sDnRev=replace(sDnRev,",ou=","/ou=")
	sDnRev=replace(sDnRev,",o=","/o=")
	aTmp=Split(sDNRev,"/")
	ProperDN=aTmp(0)
	for ix = 1 to ubound(aTmp)
		ProperDN=aTmp(ix)&"/"&ProperDN
	next
	ProperDN="/"&ProperDN
End Function

Function GetSites(sServer)
	'Returns all sites in org
	set oExRoot=GetObject("LDAP://"&sServer&"/rootDSE")
	sOrg=replace(oExRoot.Get("defaultNamingContext"),"o=","")
	set oOrg=GetObject("LDAP://"&sServer&"/o="&sOrg)
	ix=0
	for each oSite in oOrg
		if oSite.class="organizationalUnit" then
			Redim Preserve aResult(ix)
			aResult(ix)=replace(oSite.name,"ou=","")
			ix=ix+1
		end if
	next
	GetSites=aResult
End Function

Function CountItemsAtt(sPF,sProfile)
	'Counts messages in folder that have attachments
	'Requires GetPF Function

	set oSession = createobject("MAPI.Session")
	oSession.Logon sProfile,"password",False,True
	set oStore = oSession.infostores.item("Public Folders")
	set oPFRoot = oSession.getFolder(oStore.fields(&h66310102),oStore.id)
	if err.number <> 0 then 
		wscript.echo "Error using getfolder:  "&cstr(hex(err.number))&" "&err.description
		wscript.echo "Trying RootFolder instead"
		err.clear
		set oPFRoot=Nothing
		set oPFRoot=oStore.RootFolder
		if err.number <> 0 then 
			wscript.echo "Error using RootFolder: "&cstr(hex(err.number))&" "&err.description
			wscript.echo "Exiting..."
			oSession.Logoff
			wscript.quit
		end if
		err.clear
	end if
	'set oFolder=oPFRoot.Folders("Supply Chain").Folders("Imports")
	set oFolder=GetPF(sPF,oPFRoot)
	iCount=0
	for each oMsg in oFolder.Messages
		if oMsg.ATtachments.Count>0 then iCount=iCount+1
	next
	CountItemsAtt=iCount
End Function

Function CountItems(sPF,sProfile)
	'Counts messages in folder
	'Requires GetPF Function

	set oSession = createobject("MAPI.Session")
	oSession.Logon sProfile,"password",False,True
	set oStore = oSession.infostores.item("Public Folders")
	set oPFRoot = oSession.getFolder(oStore.fields(&h66310102),oStore.id)
	if err.number <> 0 then 
		wscript.echo "Error using getfolder:  "&cstr(hex(err.number))&" "&err.description
		wscript.echo "Trying RootFolder instead"
		err.clear
		set oPFRoot=Nothing
		set oPFRoot=oStore.RootFolder
		if err.number <> 0 then 
			wscript.echo "Error using RootFolder: "&cstr(hex(err.number))&" "&err.description
			wscript.echo "Exiting..."
			oSession.Logoff
			wscript.quit
		end if
		err.clear
	end if
	'set oFolder=oPFRoot.Folders("Supply Chain").Folders("Imports")
	set oFolder=GetPF(sPF,oPFRoot)
	CountItems=oFolder.Messages.count
End Function

Function GetPF(sPath,oTopFolder)
	aTmp=split(sPath,"\")
	set oCurrent=oTopFolder.Folders(aTmp(0))
	if ubound(aTmp) > 0 then
		for ix=1 to ubound(aTmp)
			set oNew=oCurrent.Folders(aTmp(ix))
			set oCurrent=oNew
		next
	end if
	set GetPF=oCurrent
End Function

Sub Quicklogin(sServer,sMailboxAlias)
	set oSession = createobject("MAPI.Session")
	oSession.logon "","",false,true,true,true,sServer & vbLf & sMailboxAlias
End Sub

Sub SlowLogin(sProfile)
	set oSession = createobject("MAPI.Session")
	oSession.Logon sProfile,"password",False,True
End Sub

Sub SetPermsOwner(oSPMBX,oSPFolder)
	'Gives mailbox oSPMBX owner permissions to public folder oSPFolder
	'Requires acl.dll to be registered for MSExchange.aclobject and MSExchange.ace objects.
	'Requires existing mapi session or create one here.  Need sServer & sLogonMailbox
	'set oSession = createobject("MAPI.Session")
	'oSession.logon "","",false,true,true,true,sServer & vbLf & sLogonMailbox


	'Resolve address
	set oGal = oSession.addresslists.item(1)
	set oMember = oGal.addressentries.item(oSPMBX.cn)

	' get the aclsobject for the folder
	set oACLs = createobject("MSExchange.aclobject")
	set oACLs.cdoitem = oSPFolder  ' set the CDO folder to CDOItem
	set oFolder_aces = oACLs.aces ' get ACEs for folder

	' create a new ace and add member
	set oNewACE = createobject("MSExchange.ACE")

	oNewACE.ID = oMember.id
	'oNewACE.rights = &H0400   ' role none
	oNewACE.rights = &H07fb 'role owner
	'oNewACE.rights = &H047b  'role Editor


	for each oACE in oACLs.ACEs
		'Remove any existing perms
		if oACE.ID <> "ID_ACL_DEFAULT" and oACE.ID <> "ID_ACL_ANONYMOUS" THEN
			'if oACEAddress=oMember then 
			'	oFolder_aces.delete oACE.id
			'end if			

			'Remove rights for everyone but LR Owner DL

			set oACEAddress=oSession.GetAddressEntry(oACE.ID) 
			if oACEAddress.name = oSPMBX.cn then oFolder_aces.delete oACE.id
		END IF
	next
	oFolder_aces.add oNewACE  ' add the ACE to the collection
	oACLs.update     ' commit changes to store
	set oGAL=nothing
	set oMember=Nothing
	set oACLs=Nothing
	set oFolder_aces=Nothing
End Sub

Function GetServersInSite(sSite,sDSServer)
	set oOrg = GetObject("LDAP://"&sDSServer)
	intI=0
	for each oCont in oOrg
		if oCont.Class="organizationalUnit" then
			if lcase(sSite)=lcase(replace(oCont.name,"ou=","")) then
				set oServers=GetObject("LDAP://"&sDSServer&"/"&oOrg.name&"/"&oCont.name&"/cn=Configuration/cn=Servers")
				for each objServer in oServers
					redim preserve aServerResult(intI)
					aServerResult(intI)=replace(objServer.name,"cn=","")
					intI=intI+1
				next
			end if
		end if	
	next
	if intI=0 then 
		GetServersInSite=Array("None Found")
	else
		GetServersInSite=aServerResult
	end if
end function

Function GetSID_Binary(bSID)
	'Get binary sid for ldap searches against Exchange
	sSID=""
	for ix=1 to len(bSID)
		sSubAut=""
		sSubAut=cstr(hex(ascw(mid(bSid,ix))))
		do while len(sSubAut)<4
			sSubAut="0"&sSubAut
		loop
		sSubAut=right(sSubAut,2)&left(sSubAut,2)
		sSID=sSID&sSubAut
	next
	GetSID_Binary=sSID
End Function

Function GetSID_OctetString(bSID)
	'Emulates the ADsEncodeBinaryData function.  
	'Will convert sid into format that can be used in ldap query.
	'If using with Exchange 5.5 use GetInfoEx("Assoc-NT-Account;binary"),0
	sSID=""
	for ix=1 to len(bSID)
		sSubAut="\"
		sSubAut=cstr(hex(ascw(mid(bSid,ix))))
		do while len(sSubAut)<4
			sSubAut="0"&sSubAut
		loop
		sSubAut=right(sSubAut,2)&"\"&left(sSubAut,2)
		sSID=sSID&"\"&sSubAut
	next
	GetSID_OctetString=sSID
End Function

Function HomeServer(oMailboxHS)
	oMailboxHS.GetInfoEx Array("home-mdb"),0
	sHomeServer=oMailboxHS.get("home-mdb")
	sHomeServer=mid(sHomeServer,instr(sHomeServer,",cn=")+4,instr(instr(sHomeServer,",cn=")+1,sHomeServer,",cn=")-instr(sHomeServer,",cn=")-4)
	HomeServer=sHomeServer
End Function

Function CRGetSite(oCRGS)
	'Gets site of custom recipient
	oCRGS.GetInfoEx Array("Obj-View-Containers"),0
	sCRContGS=oCRGS.Get("Obj-View-Containers")
	iStartGS=instr(lcase(sCRContGS),",ou=")+4
	iCharsGS=instr(lcase(sCRContGS),",o=")-instr(lcase(sCRContGS),",ou=")-4
	sSiteGS=mid(sCRContGS,iStartGS,iCharsGS)
	CRGetSite=sSiteGS
End Function

Function GetOABServer(sSite,sDSServer)
	'Will return offline address book server for a site.
	set oOrg = GetObject("LDAP://"&sDSServer)
	intI=0
	for each oCont in oOrg
		if oCont.Class="organizationalUnit" then
			if lcase(sSite)=lcase(replace(oCont.name,"ou=","")) then
				set oDSAConfigOAB=GetObject("LDAP://"&sDSServer&"/"&oOrg.name&"/"&oCont.name&"/cn=Configuration/cn=Site-DSA-Config")
				oDSAConfigOAB.GetInfoEx Array("Off-Line-AB-Server"),0
				sOABResult=oDSAConfigOAB.Get("Off-Line-AB-Server")
				sOABResult=mid(sOABResult,4,instr(lcase(sOABResult),",cn=")-4)
			end if
		end if	
	next
	if intI=0 then 
		GetServersInSite=Array("None Found")
	else
		GetServersInSite=aServerResult
	end if
	GetOABServer=sOABResult
end function

Function GetExchangeDC (sExServer)
	'Requires WMIConnect
	'Types - o=local dc, 1=domain dc, 2=gc
	set oWMI=WMIConnectEx(sExServer)
	set oDSAs=oWMI.ExecQuery("select * from Exchange_DSAccessDC where type=1")

	ix=0
	for each oDSA in oDSAs
		Redim Preserve aTmp(ix)
		aTmp(ix)=oDSA.Name
		ix=ix+1
	next
	GetExchangeDC=aTmp
end Function	

Function WMIConnectEx(sServer)
	'On Error Resume next
	Set oLocator=CreateObject("WbemScripting.SWbemLocator")
	Set oWMISvc=oLocator.ConnectServer(sServer,"root/MicrosoftExchangeV2")
	If Err.Number <> 0 Then
		WScript.Echo("error")
		sErr="0x"&Cstr(hex(Err.Number))
		sDesc=Err.Description
		Err.Clear()
		Set oWMISvc=oLocator.ConnectServer(sServer,"root/cimV2",,,,ntlmdomain)
		If Err.Number <> 0 Then
			WScript.Echo "Error "&sErr&" ("&sDesc&") connecting to WMI on server "&sServer
			Set WMIConnect=WScript.Name
			Exit Function
		End If	
	End If
	Set WMIConnectEx=oWMISvc
End Function

Function LookupMB(sLMBUser)
	'Requires ldapquery and GetSID_Binary
	bLMBSid=ldapquery("dc=mydomain,dc=com","samAccountName="&sLMBUser,"objectSID")(0)
	sLMBMB=ldapquery("myexchange55server","&(objectClass=person)(Assoc-NT-Account=" & GetSid_Binary(bLMBSid) & ")","ADsPath")(0)
	LookupMB=replace(sLMBMB,"LDAP://myexchange55server/","")
End Function

Function LookupNT(sLNTSMTP,sLNTExDSServer)
	'Requires ldapquery and GetSid_OctetString
	sLNTMBPath=ldapquery(sLNTExDSServer,"mail="&sLNTSMTP,"ADsPath")(0)
	if sLNTMBPath="Not Found" then
		sLNTMBPath=ldapquery(sLNTExDSServer,"proxyaddresses="&sLNTSMTP,"ADsPath")(0)
	end if
	if SLNTMBPath="Not Found" then
		LookupNT="Not Found"
		exit function
	end if
	set oLNTMB=GetObject(sLNTMBPath)
	oLNTMB.GetInfoEx Array("Assoc-NT-Account;binary"),0
	LookupNT=ldapquery("dc=mydomain,dc=com","objectSID="&GetSid_OctetString(oLNTMb.Get("Assoc-NT-Account")),"samAccountName")(0)
end function

Function ldapquery(sSource,sQuery,sAttribute)
	on error resume next
	'Returns result in aResult.  Surrounds output in quotes and uses comma separation for multivalued results.

	ADS_CHASE_REFERRALS_SUBORDINATE = &H20
	ADS_CHASE_REFERRALS_EXTERNAL = &H40
	ADS_CHASE_REFERRALS_ALWAYS = ADS_CHASE_REFERRALS_SUBORDINATE Or ADS_CHASE_REFERRALS_EXTERNAL
	aAtts=split(sAttribute,",")
	iReturn=ubound(aAtts)
	if iReturn<0 then iReturn=0
	Set oConn = WScript.CreateObject("ADODB.Connection")
	Set oRS = WScript.CreateObject("ADODB.Recordset")
	Set oCommand = WScript.CreateObject("ADODB.Command")
	oConn.Provider = "ADsDSOObject"
	oConn.Open "Active Directory Provider"
	Set oCommand.ActiveConnection = oConn
	oCommand.CommandText = "<LDAP://"&sSource&">;("&sQuery&");"&sAttribute&";SubTree"

	oCommand.Properties("Page Size") = 99
	oCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
	Set oRS = oCommand.Execute
	if oRS.recordcount<1 then 
		ldapquery=array("Not Found")
		exit function
	end if
	oRS.movefirst
	redim Preserve aResult(oRS.recordcount-1)
	x=0
	While Not oRS.EOF      
		'User for multi-attribute queries
		'strTemp=""""
		'for intI = 0 to iReturn
		'	if len(strTemp)>1 then strTemp=strTemp&","""
		'	strTemp=strTemp&CSTR(oRS.Fields(intI).Value)&""""
		'next
		'aResult(x)=strTemp

		aResult(x)=oRS.Fields(0).Value
		x=x+1
	      	oRS.MoveNext
	Wend
	ldapquery=aResult
End Function

Function GetAllAccounts(oGAAMB)
	'Shows mailbox users in permissions tab of mailbox for exchange 5.5 mailbox
	'Requires GetSID_OctetString and ldapquery functions
	oGAAMB.GetInfoEx Array("NT-Security-Descriptor;binary"),0
	bGAASD=oGAAMB.Get("NT-Security-Descriptor")
	iGAANTAccountCount=cint("&h"&Cstr(hex(ascw(mid(bGAASD,13,1)))))
	'wscript.echo len(bGAASD)
	sAllAccounts=""
	for iAccIndex=1 to len(bGAASD)
		'wscript.echo cstr(hex(ascw(mid(bGAASD,iAccIndex,1))))
		if iAccIndex<len(bGAASD)-28 then
			if cstr(hex(ascw(mid(bGAASD,iAccIndex,1))))="501" and cstr(hex(ascw(mid(bGAASD,iAccIndex+1,1))))="0" and cstr(hex(ascw(mid(bGAASD,iAccIndex+2,1))))="0" and cstr(hex(ascw(mid(bGAASD,iAccIndex+3,1))))="500" then
				bGAASid=mid(bGAASD,iAccIndex,14)
				sAccount=ldapquery("dc=mydomain,dc=com","objectsid="&GetSid_octetstring(bGAASid),"samAccountName")(0)
				if len(sAllAccounts)>0 then sAllAccounts=sAllAccounts&","
				sAllAccounts=sAllAccounts&sAccount
			end if
		end if
	next
	GetAllAccounts=sAllAccounts
End Function

Function GetFieldFromSMTP(sGFFAddress,iGFFTag,oGFFSession)
		Set oGFFMsg = oGFFSession.Outbox.Messages.Add
		Set oGFFRecip = oGFFMsg.Recipients.Add
		oGFFRecip.Name = sGFFAddress
		oGFFRecip.Resolve

		'Change PR_Sender_Search Key to PR_Search_Key
		if iGFFTag=&hC1D0102 then iGFFTag=&h300B0102

		set oGFFAddr=oGFFSession.GetAddressEntry(oGFFRecip.ID)
		GetFieldFromSMTP=oGFFAddr.Fields(iGFFTag)
End Function

Function GetAddress(iAddressID)
	on error resume next
	set oAddr=oSession.GetAddressEntry(iAddressID)
	if err.number <> 0 then
		if dUUIDs.exists(mid(iAddressID,9,32)) then 
			GetAddress="UnresolvedAddress-"&dUUIDs(mid(iAddressID,9,32)) '&" (Address Book ID="&iAddressID&")"
		else
			GetAddress="UnresolvedPABOrContact" '&" (Address Book ID="&iAddressID&")"
		end if
		err.clear
		on error goto 0
	else
		'sArgAddr=oAddr.address
		'sArgPFPath=oAddr.Fields(&h8004001E) 'PF Path
		GetAddress=oAddr.Fields(&h39FE001E) 'smtp address
	end if
	on error goto 0
End Function

Function GetGALID(aGGIAddrs,oGGISession)
	iGGIx=0	
	for each sGGIAddr in aGGIAddrs
		Set oMsg = oSession.Outbox.Messages.Add
		Set oRecip = oMsg.Recipients.Add
		oRecip.Name = sGGIAddr
		oRecip.Resolve
		Redim Preserve aGGIResult(iGGIx)
		aGGIResult(iGGIx)=oRecip.ID
		iGGIx=iGGIx+1
	next
	'wscript.echo "Typename: "&typename(aGGIResult)
	'for each s in aGGIResult
	'	wscript.echo "S: "&s
	'next
	GetGALID=aGGIResult
End Function