Files

543 lines
14 KiB
Plaintext

' // ***************************************************************************
' //
' // Copyright (c) Microsoft Corporation. All rights reserved.
' //
' // Microsoft Deployment Toolkit Solution Accelerator
' //
' // File: WizUtility.vbs
' //
' // Version: 6.3.8456.1000
' //
' // Purpose: Common Utility functions used by wizard UI Scripts
' //
' // ***************************************************************************
Function BrowseForFolder(sDefaultValue)
Dim iRetVal
iRetVal = Success
' Workaround for BrowseForFolder problem when called from an HTA: sometimes it doesn't show up.
oEnvironment.Item("DefaultFolderPath") = sDefaultValue
iRetVal = oShell.Run("wscript.exe """ & oUtility.ScriptDir & "\LTIGetFolder.wsf""", 1, true)
If iRetVal = 0 then
BrowseForFolder = oEnvironment.Item("FolderPath")
Else
BrowseForFolder = sDefaultValue
End if
End Function
'
' Call a VBScript and handle the errors
'
Function DisplayErrorIfAny ( sStatement )
Dim sError
If Err.Number = 0 then
Exit function
End if
'sError = sError & "Use Ctrl-C to copy the text of this message to the clipboard!" & vbNewLine
sError = sError & "A VBScript Runtime Error has occurred: " & vbNewLine & vbNewLine
sError = sError & "Error: " & Err.Number & " = " & Err.Description & vbNewLine & vbNewLine
sError = sError & "VBScript Code:" & vbNewLine & "-------------------" & vbNewLine
sError = sError & left(sStatement,800)
oLogging.CreateEntry sError ,LogTypeError
If oLogging.Debug then
sError = sError & vbNewLine & "-------------------" & vbNewLine
sError = sError & "Do you wish to attempt debugging on this script?"
DisplayErrorIfAny = MsgBox ( sError, vbYesNo , "VBScript Runtime Error" ) = vbYes
Else
Alert sError
DisplayErrorIfAny = FALSE
End if
End function
Function ExecuteWithErrorHandling ( statements )
Dim RunAgain
RunAgain = FALSE
On error resume Next
Err.Clear
ExecuteGlobal statements
ExecuteWithErrorHandling = err.number = 0
RunAgain = DisplayErrorIfAny (statements)
On error goto 0
If RunAgain then
ExecuteGlobal statements
End if
End function
Function EvalWithErrorHandling ( fn )
RunAgain = FALSE
On error resume Next
Err.Clear
EvalWithErrorHandling = eval(fn)
EvalWIthErrorHandling = EvalWIthErrorHandling and (err.number = 0)
RunAgain = DisplayErrorIfAny (fn)
On error goto 0
If RunAgain then
EvalWithErrorHandling = eval(fn)
End if
End function
'
' Create an XML Document Node with assoticated Elements and Attributes
'
' Parameters:
' oXMLDoc - XML DOM object ( Created from MSXML2.DOMDocument )
' oTargetNode - XML Document Element where the element is created
' sNodeName - Name of the Element Created
' oAttributes - VBScript Dictionary object containing a list of XML Attributes to add
' oElements - VBScript Dictionary object containing a list of XML Elements to add
'
' Example Usage:
' dim xmlDoc, oAttributes, oElements
' set oAttributes = CreateObject("Scripting.Dictionary")
' set oElements = CreateObject("Scripting.Dictionary")
' Set xmlDoc = CreateXMLDOMObject
'
' xmlDoc.Load "c:\SomeFile.xml" or xmlDoc.appendChild xmlDoc.createElement("MyRootElement")
'
' oAttributes.Add "guid", left( CreateObject("Scriptlet.TypeLib").GUID, 38 ) ' Strip trailing NULL's
' oElements.Add "Name","BuildName.value"
' oElements.Add "Version","1.0"
'
' CreateXMLNode xmlDoc, xmlDoc.documentElement, "MyElement", oAttributes, oElements
'
' xmlDoc.Save "c:\SomeFile.xml"
'
Function CreateXMLNode ( xmlDoc, oTargetNode, sNodeName, oAttributes , oElements)
Dim Key, oElement, oNodeRoot
Set oNodeRoot = xmlDoc.createElement(sNodeName)
For each key in oAttributes
If IsEmpty(key) then
Exit For
End if
oNodeRoot.setAttribute key, oAttributes.Item(key)
Next
For each key in oElements.Keys
If isempty(key) then exit for
Set oElement = xmlDoc.createElement(key)
oElement.text = oElements.Item(key)
oNodeRoot.appendChild oElement
Next
oTargetNode.appendChild oNodeRoot
End function
'
' hide/unhide an DHTML element
'
Sub HideUnhide ( oHTMLElement, isVisible )
If isVisible then
oHTMLElement.style.display = "inline"
Else
oHTMLElement.style.display = "none"
End if
End sub
'
' Copy Files to a folder
'
' More information:
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/folder/copyhere.asp
'
' WARNING: There is no way to tell if the user hits the Cancel Button during copy.
'
' Parameters:
' Source - Item or items to copy. Can be a file name string, a FolderItem object, or a FolderItems object.
' sDestDir - Target Destination Directory. If missing then this procedure will create the directory.
' Flags - Copy Flags for CopyHere (Typical settings: 2048 or 16 ===> 2064 ):
' CleanFirst - Clean the directory first.
'
Sub CopyFileWithProgressEx ( Source , sDestDir, Flags, CleanFirst )
Dim objFolder, hr
If CleanFirst and oFso.FolderExists( sDestDir ) then
oFSO.DeleteFolder sDestDir
End if
' Open the Destination Directory (Create if missing)
oUtility.VerifyPathExists sDestDir
Set objFolder = CreateObject("Shell.Application").NameSpace(sDestDir)
If objFolder is nothing then
Err.Raise 507,,"Destination Folder not set: " & sDestDir
Exit sub
End if
objFolder.CopyHere Source, Flags
Set objFolder = nothing
End sub
Sub CopyFileWithProgress ( Source , sDestDir )
' Common Settings
' 16 Respond with "Yes to All" for any dialog box that is displayed.
' 2048 Version 4.71. Do not copy the security attributes of the file.
CopyFileWithProgressEx Source , sDestDir, 2064, TRUE
End sub
'
' Tests a filename for invalid characters.
'
Function IsValidFileName (FileName)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = "[\x00-\x1F\<\>\:\""\/\\\|\%\*\?\']" 'Strict Subset
IsValidFileName = (not regEx.Test ( FileName )) and (trim(FileName) <> "") and len(trim(FileName)) <= 253
Select Case UCase(Trim(FileName))
Case "CON", "AUX", "COM1", "COM2", "COM3", "COM4", "LPT1", "LPT2", "LPT3", "PRN", "NUL"
IsValidFileName = FALSE
End select
End function
Function IsValidPath (FilePath)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = "[\x00-\x1F\<\>\""\%\*\?\']" 'Strict Subset
IsValidPath = (not regEx.Test ( FilePath )) and (trim(FilePath) <> "") and len(trim(FilePath)) <= 253
End function
Function IsValidComputerName ( OSDComputerName )
Dim regEx
Set regEx = New RegExp
regEx.Pattern = "[^a-zA-Z0-9\-\_]" 'Strict Subset
' regEx.Pattern = "[^a-zA-Z0-9\!\@\#\$\%\^\&\'\)\(\.\-\_\{\}\~ ]" ' SetComputerName compliant
IsValidComputerName = not regEx.Test ( OSDComputerName ) and len(OSDComputerName) <= 15
End function
Sub AddToList(byref List, Item, Delimiter)
oStrings.AddToList List,Item,Delimiter
End sub
Function ForceAsString ( InputVar )
ForceAsString = oStrings.ForceAsString ( InputVar )
End function
Function IsWhiteSpace (MyChar)
IsWhiteSpace = oStrings.IsWhiteSpace(MyChar)
End function
Function TrimAllWS( MyString )
TrimAllWS = oStrings.TrimAllWS( MyString )
End function
'
' Validate Credentials against either a Domain or a UNC Disk Resource
' Function will return TRUE if successfull, otherwise it will return an ERROR string!
'
Function CheckCredentials(sValidateUNC, sUserName, sDomain, sPassword)
Dim sFullUserName
Dim sJustUserName
Dim sUserObjectPath
Dim oWinNT
Dim oDomain ' As IADsDomain
Dim sDriveLetter
sFullUserName = sUserName
If sDomain <> "" then
sFullUserName = sDomain & "\" & sFullUserName
End if
If sValidateUNC = "" then
If oEnvironment.Item("ValidateAgainstUNCPath") <> "" then
sValidateUNC = oEnvironment.Item("ValidateAgainstUNCPath")
Else
sValidateUNC = oEnvironment.Item("DeployRoot")
For Each oDomain in objWMI.InstancesOf("Win32_ComputerSystem")
if oDomain.DomainRole = 1 or oDomain.DomainRole = 3 or oDomain.DomainRole = 4 or oDomain.DomainRole = 5 then
oLogging.CreateEntry "Computer is part of a domain, valiadate against domain.", LogTypeInfo
sValidateUNC = ""
End if
next
End if
End if
If sValidateUNC <> "" then
'
' Validate the credentials against an actual UNC disk resource
'
sDriveLetter = oUtility.MapNetworkDriveEx (sValidateUNC, sFullUserName, sPassword, LogTypeInfo )
If len(sDriveLetter) = 2 then
If bLeaveShareOpen <> TRUE and ucase(sValidateUNC) <> ucase(oEnvironment.Item("DeployRoot")) then
oNetwork.RemoveNetworkDrive sDriveLetter
End if
CheckCredentials = TRUE
Else
CheckCredentials = sDriveLetter ' If not a drive letter, then this is an error string
End if
Else
CheckCredentials = CheckCredentialsAD( "", sUserName, sDomain, sPassword)
End if
If CheckCredentials <> TRUE then
oLogging.CreateEntry "Credentials Script: " & CheckCredentials, LogTypeInfo
Exit function
End if
oEnvironment.Item("UserCredentials") = Cstr(TRUE)
If bDoNotSaveParameters = TRUE then
window.close
CheckCredentials = FALSE
End if
End Function
'
' Validate Credentials against a Domain
' Function will return TRUE if successfull, otherwise it will return an ERROR string!
'
Function CheckCredentialsAD(sJoinDomain, sUserName, sDomain, sPassword)
Dim sFullUserName
Dim sJustUserName
Dim sUserObjectPath
Dim oWinNT
Dim oDomain ' As IADsDomain
Dim sDriveLetter
Dim sJoinDomainNew
sJoinDomainNew = sJoinDomain
sFullUserName = sUserName
If sDomain <> "" then
sFullUserName = sDomain & "\" & sFullUserName
End if
'
' Validate the credentials against a domain or computer server using Active Directory authentication.
'
' The credentials can be in the form "BillG", "redmond\BillG", or "BillG@Microsoft.Com". Cleanup for use.
sJustUserName = sUserName
If Instr(1,sJustUserName,"@") <> 0 then
' Username is in form: BillG@redmond.corp.Microsoft.com, remove domain.
sJustUserName = left(sJustUserName, instr(1,sJustUserName,"@") - 1)
ElseIf instr(1,sJustUserName,"\") <> 0 then
' Username is in form: redmond\BillG, remove domain.
sJustUserName = mid(sJustUserName, instr(1,sJustUserName,"\") + 1 )
End if
On Error Resume Next
Set oWinNT = GetObject("WinNT:")
If Err then
If oEnvironment.Item("OSVersion") = "WinPE" then
oLogging.CreateEntry "Unable to verify domain credentials in Windows PE since ADSI is not available", LogTypeInfo
CheckCredentialsAD = TRUE
Err.Clear
Exit Function
Else
CheckCredentialsAD = Err.Description & " (" & Hex(Err.Number) & ")"
Exit Function
End if
End if
If sJoinDomainNew = "" then
sJoinDomainNew = sDomain
ElseIf Instr(1, sUserName, "\") <> 0 then
sJoinDomainNew = left(sUserName, instr(1, sUserName, "\") - 1)
ElseIf Instr(1, sUserName, "@") <> 0 then
sJoinDomainNew = mid(sJustUserName, instr(1,sJustUserName,"@") + 1 )
End if
' 1 = ADS_SECURE_AUTHENTICATION
Set oDomain = oWinNT.OpenDSObject("WinNT://" & sJoinDomainNew & "/" & sJustUserName & ",user" , sFullUserName, sPassword, 1 )
If Err.Number = &h80070035 then
CheckCredentialsAD = "Network path not found (80070035)"
ElseIf Err.Number = &H8007054B then
CheckCredentialsAD = "Domain could not be contacted (8007054B)"
ElseIf Err.Number = &h8007052E then
CheckCredentialsAD = "User ID or password is invalid (8007052E)"
ElseIf Err.Number = &h800708AD then
CheckCredentialsAD = "User ID is not valid (800708AD)"
ElseIf Err then
CheckCredentialsAD = Err.Description & " (" & Hex(Err.Number) & ")"
ElseIf oDomain is nothing then
CheckCredentialsAD = "Domain validation failed - " & Err.Description & " (" & Err.Number & ")"
Else
Err.Clear
CheckCredentialsAD = TRUE
End if
On error goto 0
If CheckCredentialsAD <> TRUE then
oLogging.CreateEntry "Credentials Script: " & CheckCredentialsAD, LogTypeInfo
Exit function
End if
oEnvironment.Item("UserCredentials") = Cstr(TRUE)
If bDoNotSaveParameters = TRUE then
window.close
CheckCredentialsAD = FALSE
End if
End Function
Function GetDomainDefault
Dim oComputer
' Get Local Domain
GetDomainDefault = ""
if oEnvironment.Item("UserDomain") <> "" then
GetDomainDefault = oEnvironment.Item("USERDOMAIN")
else
On Error Resume Next
For each oComputer in objWMI.InstancesOf("Win32_ComputerSystem")
If oComputer.DomainRole <> 0 then
GetDomainDefault = oComputer.Domain
End if
Next
On Error Goto 0
end if
End Function
Function GetDestDisk
' Preference search order is: oProperties, oEnvironment/CS.INI , and TS.XML ( DefaultDestinationXxx )
GetDestDisk = Property("DestinationDisk")
If GetDestDisk = "" then
GetDestDisk = Property("DefaultDestinationDisk")
End if
If GetDestDisk = "" then
GetDestDisk = "0"
End if
End function
Function GetDestPart
' Preference search order is: oProperties, oEnvironment/CS.INI , and TS.XML ( DefaultDestinationXxx )
GetDestPart = Property("DestinationPartition")
If GetDestPart = "" then
GetDestPart = Property("DefaultDestinationPartition")
End if
If GetDestPart = "" then
GetDestPart = "1"
End if
End function
Function HasGoodDestDisk( sDestDisk )
Dim oDisk, oDisks
Set oDisks = objWMI.ExecQuery("Select index from Win32_DiskDrive where MediaType like 'Fixed%hard disk%'")
HasGoodDestDisk = False
For Each oDisk in oDisks
If Cstr(oDisk.Index) = sDestDisk Then
oLogging.CreateEntry "Validated Disk exists", LogTypeInfo
HasGoodDestDisk = True
exit for
End If
Next
End function
Function HasGoodDestPart ( sDestDisk, sDestPart )
Dim sDestDrive
HasGoodDestPart = true
If Property("DeploymentType") = "REFRESH" Then
sDestDrive = oUtility.DetermineDriveFromDiskPart( sDestDisk, sDestPart )
HasGoodDestPart = sDestDrive = oEnv("SystemDrive")
oLogging.CreateEntry "oUtility.DetermineDriveFromDiskPart( " & sDestDisk& ", " & sDestPart& " ) = " & sDestDrive, LogTypeInfo
End if
End function
Function RmPropIfFound( Prop )
If oProperties.Exists(Prop) then
oProperties.Remove(Prop)
End if
End function