' -------------------------------------------------------------------------
'
'       ACLReport v1.01
'       Script by Sakari Kouti (see http://www.kouti.com and
'       http://www.sovelto.fi)
'
' -------------------------------------------------------------------------

Option Explicit

Dim strWelcome

strWelcome = _
	"This script dumps ACLs of Active Directory objects,"     & vbCrLf & _
	"starting from a given root object (by default, the"      & vbCrLf & _
	"root of the default domain) into an HTML file called"    & vbCrLf & _
	"ACLReport.htm."                                          & vbCrLf & _
	""                                                        & vbCrLf & _
	"Best performance is achieved, when run locally on a DC." & vbCrLf & _
	""                                                        & vbCrLf & _
	"Do you want to continue (and specify the root)?"

' -------------------------------------------------------------------------
'
' IF YOU MODIFY THIS SCRIPT FOR INTERNAL USE, PLACE HERE A STATEMENT OF
' THE MODIFICATION
'
' -------------------------------------------------------------------------
'
'       Copyright Notice
'
' You have a royalty-free right to use and distribute the unmodified
' version of this script, provided that you agree that Addison-Wesley or
' Sakari Kouti has no warranty, obligations or liability for the script.
'
' You may also modify the script for the internal use in your organization,
' with the following three limitations: a) you may not modify or remove
' this copyright notice, b) you may not modify or remove the lines that
' generate to the HTML file the script name, the name of Sakari Kouti, and
' the two Web addresses, and c) you may not modify or remove the lines
' that generate the first message box in the script.
'
Dim strTitleBar
strTitleBar = "ACLReport v1.01 by Sakari Kouti"
'
' -------------------------------------------------------------------------
'
'       Version History
'
' Changes in v1.01
' - Moved the welcome text to the beginning, so if you open the script
'   in an editor, you see it right away
' - Added the search scope as a behavior constant, so you can easily
'   modify it
' - Moved the LDAP filter definitions right after the actual behavior
'   constants, so you can more easily modify the filters (if needed)
' - Added the explanation of white background to the color legend
' - Added a color background to the header row
' - Fixed the correct vbs name to the end of the HTML output
' - SCOPE_OUS_ONLY now includes also the domain object
' - Modified (most of) the progress messages to be displayed only if run
'   in CScript
'
' -------------------------------------------------------------------------

'==============================
'Behavior constants
'You can modify these at will
'==============================

Const SCOPE_OUS_ONLY          = True      'Whether to scan only OUs (and the domain object) or also other object classes
Const SCOPE_NON_ADVANCED_VIEW = True      'Whether to scan only normal-view objects or also advanced-view objects
Const SCOPE_ALL_ACES          = True      'Whether to display all ACEs or only non-inherited
Const SCOPE_STRING            = "subTree" 'Either subTree, oneLevel, or base

Dim strLDAPFilter

If SCOPE_OUS_ONLY Then
	If SCOPE_NON_ADVANCED_VIEW Then
		strLDAPFilter = "(&(|(objectCategory=organizationalUnit)(objectCategory=domainDNS))(!showInAdvancedViewOnly=TRUE))"
	Else
		strLDAPFilter = "(|(objectCategory=organizationalUnit)(objectCategory=domainDNS))"
	End If
Else
	If SCOPE_NON_ADVANCED_VIEW Then
		strLDAPFilter = "(!showInAdvancedViewOnly=TRUE)"
	Else
		strLDAPFilter = "(objectClass=*)"
	End If
End If


'==============================
'Script-level constants
'==============================

Const ADS_SCOPE_SUBTREE = 2

Const YES  = "Yes"
Const NBSP = " "

'==============================
'Script-level variables
'==============================
'(and their initial values,
'if they act like constants)
'==============================

'AccessMask Bits
'Constants would be like ADS_RIGHT_DS_CREATE_CHILD
Dim arrADSRights(18,1)  '19 value pairs, name and bit in each
arrADSRights(0,0) = "Create Child(s)"		'DS_CREATE_CHILD
arrADSRights(0,1) = &H1
arrADSRights(1,0) = "Delete Child(s)"		'DS_DELETE_CHILD
arrADSRights(1,1) = &H2
arrADSRights(2,0) = "List Contents"			'ACTRL_DS_LIST
arrADSRights(2,1) = &H4
arrADSRights(3,0) = "Validated Write(s)"	'DS_SELF"
arrADSRights(3,1) = &H8
arrADSRights(4,0) = "Read Prop(s)"			'DS_READ_PROP
arrADSRights(4,1) = &H10
arrADSRights(5,0) = "Write Prop(s)"			'DS_WRITE_PROP
arrADSRights(5,1) = &H20
arrADSRights(6,0) = "Delete Subtree"		'DS_DELETE_TREE
arrADSRights(6,1) = &H40
arrADSRights(7,0) = "List Object"			'DS_LIST_OBJECT
arrADSRights(7,1) = &H80
arrADSRights(8,0) = "Extended Right(s)"		'DS_CONTROL_ACCESS
arrADSRights(8,1) = &H100
arrADSRights(9,0) = "Delete"				'DELETE
arrADSRights(9,1) = &H10000
arrADSRights(10,0) = "Read Permissions"		'READ_CONTROL
arrADSRights(10,1) = &H20000
arrADSRights(11,0) = "Modify Permissions"	'WRITE_DAC
arrADSRights(11,1) = &H40000
arrADSRights(12,0) = "Modify Owner"			'WRITE_OWNER
arrADSRights(12,1) = &H80000
arrADSRights(13,0) = "SYNCHRONIZE"
arrADSRights(13,1) = &H100000
arrADSRights(14,0) = "ACCESS_SYSTEM_SECURITY"
arrADSRights(14,1) = &H1000000
arrADSRights(15,0) = "GENERIC_ALL"
arrADSRights(15,1) = &H10000000
arrADSRights(16,0) = "GENERIC_EXECUTE"
arrADSRights(16,1) = &H20000000
arrADSRights(17,0) = "GENERIC_WRITE"
arrADSRights(17,1) = &H40000000
arrADSRights(18,0) = "GENERIC_READ"
arrADSRights(18,1) = &H80000000

'AccessMask Combinations
Dim arrADSRightCombinations(3,1)  '19 value pairs, name and bit in each
arrADSRightCombinations(0,0) = "Full Control"
arrADSRightCombinations(0,1) = &HF01FF
arrADSRightCombinations(1,0) = "Read (incl. List Obj.)"
arrADSRightCombinations(1,1) = &H20094
arrADSRightCombinations(2,0) = "Read (excl. List Obj.)"
arrADSRightCombinations(2,1) = &H20014
arrADSRightCombinations(3,0) = "Full Control except Delete Child(s) and Delete Subtree"
arrADSRightCombinations(3,1) = &HF01BD

'AceFlags Bits
'Constants would be like ADS_ACEFLAG_INHERIT_ACE
Dim arrADSACEFlags(5,1)  '6 value pairs, name and bit in each
arrADSACEFlags(0,0) = "INHERIT_ACE"
arrADSACEFlags(0,1) = &H2
arrADSACEFlags(1,0) = "NO_PROPAGATE_INHERIT_ACE"
arrADSACEFlags(1,1) = &H4
arrADSACEFlags(2,0) = "INHERIT_ONLY_ACE"
arrADSACEFlags(2,1) = &H8
arrADSACEFlags(3,0) = "INHERITED_ACE"
arrADSACEFlags(3,1) = &H10
arrADSACEFlags(4,0) = "SUCCESSFUL_ACCESS"
arrADSACEFlags(4,1) = &H40
arrADSACEFlags(5,0) = "FAILED_ACCESS"
arrADSACEFlags(5,1) = &H80

'AceTypes
'Constants would be like ADS_ACETYPE_ACCESS_ALLOWED
Dim arrADSACETypes(5,1)  '6 value pairs, name and value in each
arrADSACETypes(0,0) = "Allow"               'ACCESS_ALLOWED"
arrADSACETypes(0,1) = 0
arrADSACETypes(1,0) = "Deny"                'ACCESS_DENIED"
arrADSACETypes(1,1) = &H1
arrADSACETypes(2,0) = "Audit"               'SYSTEM_AUDIT"
arrADSACETypes(2,1) = &H2
arrADSACETypes(3,0) = "Allow (Object)"      'ACCESS_ALLOWED_OBJECT"
arrADSACETypes(3,1) = &H5
arrADSACETypes(4,0) = "Deny (Object)"       'ACCESS_DENIED_OBJECT"
arrADSACETypes(4,1) = &H6
arrADSACETypes(5,0) = "Audit (Object)"      'SYSTEM_AUDIT_OBJECT"
arrADSACETypes(5,1) = &H7

'Flags Bits
'Constants would be like ADS_FLAG_OBJECT_TYPE_PRESENT
Dim arrADSFlags(1,1)  '2 value pairs, name and bit in each
arrADSFlags(0,0) = "OBJECT_TYPE_PRESENT"
arrADSFlags(0,1) = &H1
arrADSFlags(1,0) = "INHERITED_OBJECT_TYPE_PRESENT"
arrADSFlags(1,1) = &H2

Dim strTColSep  ', strTRowSep
Dim strHTMLStart, strHTMLEnd, strTableStart, strTableEnd, strTRowEnd
Dim strTHeaderRowStart
Dim strTNormalRowStart
Dim strTInheritedRowStart
Dim strTDenyRowStart
Dim strTInheritedDenyRowStart

strHTMLStart = _
	"<html><head><title>ACLs of Objects</title>"                              & vbCrLf & _
	"<style type=text/css>"                                                   & vbCrLf & _
	"   BODY {font-family: verdana, helvetica, sans-serif; font-size: 10pt;}" & vbCrLf & _
	"   TD   {font-family: verdana, helvetica, sans-serif; font-size: 10pt;}" & vbCrLf & _
	"</style>"                                                                & vbCrLf & _
	"</head><body>"                                                           & vbCrLf

strTableStart = "<table border=1 cellspacing=0 style=""border-collapse: collapse"" >" & vbCrLf

strTHeaderRowStart        = "<tr valign=top bgcolor=#E0FFFF><td>"   'light turquoise
strTNormalRowStart        = "<tr valign=top><td>"                   'white
strTInheritedRowStart     = "<tr valign=top bgcolor=#C0C0C0><td>"   'silver
strTDenyRowStart          = "<tr valign=top bgcolor=#FF8080><td>"   'pinkish red
strTInheritedDenyRowStart = "<tr valign=top bgcolor=#D08080><td>"   'dim red

strTColSep = "</td><td>"

strTRowEnd = _
	"</td></tr>" & vbCrLf

strTableEnd = _
	"</table>" & vbCrLf

strHTMLEnd = _
	"<p></p>"                                                                           & vbCrLf & _
	"<p>To better examine the results:<br>"                                             & vbCrLf & _
	"1. Right-click the table in IE and select <b>Export to Microsoft Excel</b>.<br>"   & vbCrLf & _
	"2. In Excel's <b>Data</b> menu, select <b>Filter</b> => <b>AutoFilter</b>.<br>"    & vbCrLf & _
	"3. Use the drop-down lists on the header row to see the selection of values<br>"   & vbCrLf & _
	"&nbsp;&nbsp;&nbsp;&nbsp;or to filter rows.<br>"                                    & vbCrLf & _
	"4. Click cell B2.<br>"                                                             & vbCrLf & _
	"5. In Excel's <b>Window</b> menu, select <b>Freeze Panes</b>.</p>"                 & vbCrLf & _
	"<p><b>Tip</b></p>"                                                                 & vbCrLf & _
	"<p>Every now and then, use this script to take a snapshot of the permissions<br>"  & vbCrLf & _
	"in your domain. By comparing the snapshots, you can track any changes to the<br>"  & vbCrLf & _
	"permissions.</p>"                                                                  & vbCrLf & _
	"<p><b>Color Legend</b></p>"                                                        & vbCrLf & _
	"<table border=1 cellspacing=0 style=""border-collapse: collapse"" >"               & vbCrLf & _
	"<tr bgcolor=#FFFFFF><td>An Allow ACE that is non-inherited</td></tr>"              & vbCrLf & _
	"<tr bgcolor=#C0C0C0><td>An Allow ACE that is inherited</td></tr>"                  & vbCrLf & _
	"<tr bgcolor=#FF8080><td>A Deny ACE that is non-inherited</td></tr>"                & vbCrLf & _
	"<tr bgcolor=#D08080><td>A Deny ACE that is inherited</td></tr>"                    & vbCrLf & _
	"</table>"                                                                          & vbCrLf & _
	"<p>This table was generated at " & Now() & " by ACLReport.vbs,<br>"                & vbCrLf & _
	"a script by Sakari Kouti (see http://www.kouti.com and http://www.sovelto.fi)</p>" & vbCrLf & _
	"</body></html>"                                                                    & vbCrLf

Dim objDSE, strDefaultDN, objADObject, i
Dim objSecDesc, objDACL, objACE
Dim objConnection, objCommand, objRecordset
Dim strRootDN
Dim intYesNo
Dim objFSO, objOutfile
Dim dicSchemaIDGUIDs, dicRightsGuids
Dim bolCScript


'==============================
'The Main Program
'==============================

Call CheckWSHEnvironment(bolCScript)
If bolCScript Then WScript.Echo strTitleBar

intYesNo =  MsgBox(strWelcome, _
	vbYesNo + vbQuestion + vbDefaultButton2, _
	strTitleBar)
If intYesNo = vbNo Then
	If bolCScript Then WScript.Echo "Exited by user request"
	WScript.Quit(0)	'no error so no errorlevel
End If

'------------------------------
' Ask the Root Object
'------------------------------

Set objDSE = GetObject("LDAP://rootDSE")
strDefaultDN = objDSE.Get("defaultNamingContext")
strRootDN = InputBox("Enter the distinguished name of the root object" & _
	vbCrLf & "(e.g. " & strDefaultDN & ")", , strDefaultDN)
If strRootDN = "" Then WScript.Quit(1)		'user clicked Cancel

'------------------------------
' ADO init
'------------------------------

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

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutfile = objFSO.CreateTextFile("ACLReport.htm", True)
Call objOutfile.Write(strHTMLStart & strTableStart)

Call WriteHeaders(objOutfile)

Set dicSchemaIDGUIDs = CreateObject("Scripting.Dictionary")
Call dicSchemaIDGUIDs.Add("Seed", "xxx")
Call CacheRightsGuids

objCommand.CommandText = _
	"<LDAP://" & strRootDN & ">;" & _
	strLDAPFilter & ";" & _
	"distinguishedName;" & _
	SCOPE_STRING

objCommand.Properties("Page Size")     = 500
objCommand.Properties("Cache Results") = False ' do not cache the result, it results in less memory requirements
    
Set objRecordset = objCommand.Execute

Do While Not objRecordset.EOF
	Call DisplayOneObject(objRecordset.Fields("distinguishedName"))
	objRecordset.MoveNext
Loop

objConnection.Close

Call objOutfile.Write(strTableEnd & strHTMLEnd)
Call objOutfile.Close

WScript.Echo "ACLReport complete."

'===End of the Main Program===

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

Sub WriteHeaders(objOutfile)
	Call objOutfile.Write(strTHeaderRowStart)
	Call objOutfile.Write("Object" _
		& strTColSep & "ACE#" _
		& strTColSep & "Trustee" _
		& strTColSep & "AccessMask" _
		& strTColSep & "AM Interpr" _
		& strTColSep & "AceFlags" _
		& strTColSep & "Inherit (AF)" _
		& strTColSep & "Inherit, No Propagate (AF)" _
		& strTColSep & "Inherit Only (AF)" _
		& strTColSep & "Inherited (AF)" _
		& strTColSep & "AceType" _
		& strTColSep & "AT Interpr" _
		& strTColSep & "Flags" _
		& strTColSep & "OT Present (Fl)" _
		& strTColSep & "IOT Present (Fl)" _
		& strTColSep & "ObjectType" _
		& strTColSep & "OT Interpr" _
		& strTColSep & "Inh ObjectType" _
		& strTColSep & "IOT Interpr")
	Call objOutfile.Write(strTRowEnd)
End Sub

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

Sub DisplayOneObject(strDN)
	Dim strOut, bolACEInherited, bolACEDeny, strDNClean

	If bolCScript Then WScript.Echo "Writing the ACEs of " & strDN

	'ADSI bind doesn't like a straight slash in DN
	strDNClean = Replace(strDN, "/", "\/", 1, -1, vbTextCompare)

	Set objADObject = GetObject("LDAP://" & strDNClean)

	Set objSecDesc = objADObject.Get("ntSecurityDescriptor")
	Set objDACL = objSecDesc.DiscretionaryAcl

	i = 0
	For Each objACE In objDACL
		i = i + 1
		bolACEDeny      = False

		strOut = _
			CleanHTML(strDN)                                  & strTColSep & _
			"ACE " & i                                        & strTColSep & _
			CleanHTML(objACE.Trustee)                         & strTColSep & _
			GetAccessMaskBits(objACE.AccessMask)              & strTColSep & _
			GetAceFlagBits(objACE.AceFlags,  bolACEInherited) & strTColSep & _
			GetStringAceType(objACE.AceType, bolACEDeny)      & strTColSep & _
			GetFlagBits(objACE.Flags)                         & strTColSep & _
			GetObjectType(objACE.ObjectType)                  & strTColSep & _
			GetInheritedObjectType(objACE.InheritedObjectType)

		If SCOPE_ALL_ACES Or Not bolACEInherited Then
			If Not bolACEInherited And Not bolACEDeny Then strOut = strTNormalRowStart        & strOut
			If     bolACEInherited And Not bolACEDeny Then strOut = strTInheritedRowStart     & strOut
			If Not bolACEInherited And     bolACEDeny Then strOut = strTDenyRowStart          & strOut
			If     bolACEInherited And     bolACEDeny Then strOut = strTInheritedDenyRowStart & strOut

			Call objOutfile.Write(strOut & strTRowEnd)
		End If
	Next
End Sub

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

Function CleanHTML(strInput)
	Dim strCleaned

	strCleaned = Replace(strInput, "<",     "&lt;",   1, -1, vbTextCompare)
	strCleaned = Replace(strInput, ">",     "&gt;",   1, -1, vbTextCompare)
	strCleaned = Replace(strInput, "&",     "&amp;",  1, -1, vbTextCompare)
	strCleaned = Replace(strInput, Chr(34), "&quot;", 1, -1, vbTextCompare)

	CleanHTML = strCleaned
End Function

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

Function GetAccessMaskBits(intBitfield)
	Dim strOut, i, bolFoundMatch, bolFirstMatch

	strOut = Hex(intBitfield) & strTColSep

	bolFoundMatch = False
	For i = LBound(arrADSRightCombinations) To UBound(arrADSRightCombinations)
		If intBitfield = arrADSRightCombinations(i,1) Then
			strOut = strOut & arrADSRightCombinations(i,0)
			bolFoundMatch = True
			Exit For
		End If
	Next

	If Not bolFoundMatch Then
		bolFirstMatch = True
		For i = LBound(arrADSRights) To UBound(arrADSRights)
			If intBitfield And arrADSRights(i,1) Then
				If bolFirstMatch Then
					strOut = strOut &        arrADSRights(i,0)
				Else
					strOut = strOut & ", " & arrADSRights(i,0)
				End If
				bolFirstMatch = False
			End If
		Next
	End If

	GetAccessMaskBits = strOut
End Function

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

Function GetAceFlagBits(intBitfield, ByRef bolACEInherited)
	Dim strOut, i

	strOut = Hex(intBitfield) & strTColSep

	For i = 0 To 3 'Inherit, No Propagate, Inherit_only, Inherited
		If intBitfield And arrADSACEFlags(i,1) Then
			strOut = strOut & YES
		Else
			strOut = strOut & NBSP
		End If
		If i < 3 Then strOut = strOut & strTColSep
	Next

	If intBitfield And arrADSACEFlags(3,1) Then
		bolACEInherited = True
	Else
		bolACEInherited = False
	End If

	GetAceFlagBits = strOut
End Function

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

Function GetStringAceType(intACEType, ByRef bolACEDeny)
	Dim strOut, i

	strOut = "unknown ACE type"
	For i = LBound(arrADSACETypes) To UBound(arrADSACETypes)
		If intACEType = arrADSACETypes(i,1) Then
			strOut = arrADSACETypes(i,0)
		End If
	Next

	bolACEDeny = (intACEType = arrADSACETypes(1,1)) Or (intACEType = arrADSACETypes(4,1))

	GetStringAceType = Hex(intACEType) & strTColSep & strOut
End Function

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

Function GetFlagBits(intBitfield)
	Dim strOut, i

	strOut = Hex(intBitfield) & strTColSep

	For i = 0 To 1 'Object type present, Inherited object type present
		If intBitfield And arrADSFlags(i,1) Then
			strOut = strOut & YES
		Else
			strOut = strOut & NBSP
		End If
		If i < 1 Then strOut = strOut & strTColSep
	Next

	GetFlagBits = strOut
End Function

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

Function GetObjectType(strGUID)
	GetObjectType = strGUID & strTColSep & CleanHTML(MapGUIDToMatchingName(strGUID))
End Function

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

Function GetInheritedObjectType(strGUID)
	GetInheritedObjectType = strGUID & strTColSep & CleanHTML(MapGUIDToMatchingName(strGUID))
End Function

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

Sub CacheRightsGuids()
    Dim objExtRights, objChild, intCounter

	If bolCScript Then WScript.Echo "Caching extended right and property set names..."

	Set dicRightsGuids = CreateObject("Scripting.Dictionary")
	Set objExtRights = GetObject("LDAP://CN=Extended-Rights," & _
		objDSE.Get("configurationNamingContext"))

	intCounter = 0
	For Each objChild In objExtRights
		'Actually all should be of the same class
		If objChild.Class = "controlAccessRight" Then
			If (objChild.validAccesses And &H130) > 0 Then 'filter out garbage, such as
                                                           'cn=Validated-DNS-Host-Name
				intCounter = intCounter + 1
				Call dicRightsGuids.Add( _
					UCase("{" & objChild.Get("rightsGuid") & "}"), _
					objChild.Get("displayName"))
				If intCounter Mod 20 = 0 Then
					If bolCScript Then WScript.Echo "Processed " & intCounter & _
						" extended rights and/or property sets"
				End If
			End If
		End If
	Next

	If bolCScript Then WScript.Echo "Extended right and property set names cached"
End Sub

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

Function MapGUIDToMatchingName(strGUIDAsString)
	Dim strOut, objSchemaRecordset, strLDAPname

	If strGUIDAsString = "" Then Exit Function

	strOut = ""

	If dicRightsGuids.Exists(UCase(strGUIDAsString)) Then
		strOut = dicRightsGuids.Item(UCase(strGUIDAsString))
	End If

	If strOut = "" Then  'Didn't find a match in extended rights
		If dicSchemaIDGUIDs.Exists(UCase(strGUIDAsString)) Then
			strOut = dicSchemaIDGUIDs.Item(UCase(strGUIDAsString))
		Else
			objCommand.CommandText = _
				"<LDAP://" & objDSE.Get("schemaNamingContext") & ">;" & _
				"(schemaIDGUID=" & GUIDStrFormatToEscapeBinFormat(strGUIDAsString) & ");" & _
				"lDAPDisplayName;subTree"
			Set objSchemaRecordset = objCommand.Execute

			If Not objSchemaRecordset.EOF Then
				strLDAPname = objSchemaRecordset.Fields("lDAPDisplayName")
				Call dicSchemaIDGUIDs.Add(UCase(strGUIDAsString), strLDAPname)
				strOut = strLDAPname
			End If
		End If
	End If

	MapGUIDToMatchingName = strOut
End Function

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

Function GetSchemaIDGUID(objSchemaObj)
	Dim arrValue, i, strByte, strGUID

	arrValue = objSchemaObj.Get("schemaIDGUID")
	strGUID = ""
	For i = 1 to LenB(arrValue)
		strByte = Hex(AscB(MidB(arrValue, i, 1)))
		If Len(strByte) = 1 Then strByte = "0" & strByte
		strGUID = strGUID & strByte
	Next
	GetSchemaIDGUID = GuidBinFormatToStrFormat(strGUID)
End Function

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

Function GUIDBinFormatToStrFormat(strGUIDBin)
	Dim i, strDest
	Dim arrBytes(16)		'We will use elements 1 to 16 but not 0

	For i = 1 To 16   'A GUID has 16 bytes
		arrBytes(i) = Mid(strGUIDBin, 2 * i - 1, 2)
	Next

	strDest = "{"
	For i = 1 To 4 : strDest = strDest & arrBytes(5 - i) : Next
	strDest = strDest & "-"
	For i = 1 To 2 : strDest = strDest & arrBytes(7 - i) : Next
	strDest = strDest & "-"
	For i = 1 To 2 : strDest = strDest & arrBytes(9 - i) : Next
	strDest = strDest & "-"
	For i = 1 To 2 : strDest = strDest & arrBytes(8 + i) : Next
	strDest = strDest & "-"
	For i = 1 To 6 : strDest = strDest & arrBytes(10 + i) : Next
	strDest = strDest & "}"

	GuidBinFormatToStrFormat = strDest
End Function

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

Function GUIDStrFormatToEscapeBinFormat(strGUID)
	Dim i, strDest, strDest2
	Dim arrBytes(16)		'We will use elements 1 to 16 but not 0

	strDest = Replace(strGUID, "{", "", 1, -1, vbTextCompare)
	strDest = Replace(strDest, "}", "", 1, -1, vbTextCompare)
	strDest = Replace(strDest, "-", "", 1, -1, vbTextCompare)

	strDest2 = ""
	For i = 1 To 4 : strDest2 = strDest2 & "\" & Mid(strDest,  2*4+1 - 2*i, 2) : Next
	For i = 1 To 2 : strDest2 = strDest2 & "\" & Mid(strDest,  2*6+1 - 2*i, 2) : Next
	For i = 1 To 2 : strDest2 = strDest2 & "\" & Mid(strDest,  2*8+1 - 2*i, 2) : Next
	For i = 1 To 2 : strDest2 = strDest2 & "\" & Mid(strDest,  2*8-1 + 2*i, 2) : Next
	For i = 1 To 6 : strDest2 = strDest2 & "\" & Mid(strDest, 2*10-1 + 2*i, 2) : Next

	GUIDStrFormatToEscapeBinFormat = strDest2
End Function

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

Sub CheckWSHEnvironment(ByRef bolCScript)
	Dim strScriptHostName, intYesNo

	strScriptHostName = WScript.FullName
	strScriptHostName = Right(strScriptHostName, Len(strScriptHostName) _
		- InStrRev(strScriptHostName,"\"))

	If UCase(strScriptHostName) = "CSCRIPT.EXE" Then
		bolCScript = True
	Else
		intYesNo = MsgBox( _
			"You should run this script in the CScript"        & vbCrLf & _
			"command line environment to get a number of"      & vbCrLf & _
			"progress messages.  Either type CSCRIPT"          & vbCrLf & _
			"before the script name or change CScript as"      & vbCrLf & _
			"the default environment with the command"         & vbCrLf & _
			"CSCRIPT //H:CSCRIPT"                              & vbCrLf & _
			""                                                 & vbCrLf & _
			"You may now continue, but you won't see these"    & vbCrLf & _
			"progress messages (except the Complete message)." & vbCrLf & _
			""                                                 & vbCrLf & _
			"Do you want to continue?", _
			vbYesNo + vbQuestion + vbDefaultButton2, _
			strTitleBar)

		If intYesNo = vbNo Then
			WScript.Quit(0)	'no error so no errorlevel
		Else
			bolCScript = False
		End If
	End If
End Sub