' $Id: helpers.vbs 96407 2022-08-22 17:43:14Z vboxsync $ '' @file ' Common VBScript helpers used by configure.vbs and later others. ' ' Requires the script including it to define a LogPrint function. ' ' ' Copyright (C) 2006-2022 Oracle and/or its affiliates. ' ' This file is part of VirtualBox base platform packages, as ' available from https://www.virtualbox.org. ' ' This program is free software; you can redistribute it and/or ' modify it under the terms of the GNU General Public License ' as published by the Free Software Foundation, in version 3 of the ' License. ' ' This program is distributed in the hope that it will be useful, but ' WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ' General Public License for more details. ' ' You should have received a copy of the GNU General Public License ' along with this program; if not, see . ' ' SPDX-License-Identifier: GPL-3.0-only ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Global Variables ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' dim g_objShell Set g_objShell = WScript.CreateObject("WScript.Shell") dim g_objFileSys Set g_objFileSys = WScript.CreateObject("Scripting.FileSystemObject") '' Whether to ignore (continue) on errors. dim g_blnContinueOnError g_blnContinueOnError = False '' The script's exit code (for ignored errors). dim g_rcScript g_rcScript = 0 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Paths ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Converts to unix slashes function UnixSlashes(str) UnixSlashes = replace(str, "\", "/") end function '' ' Converts to dos slashes function DosSlashes(str) DosSlashes = replace(str, "/", "\") end function '' ' Get the path of the parent directory. Returns root if root was specified. ' Expects abs path. function PathParent(str) PathParent = g_objFileSys.GetParentFolderName(DosSlashes(str)) end function '' ' Strips the filename from at path. function PathStripFilename(str) PathStripFilename = g_objFileSys.GetParentFolderName(DosSlashes(str)) end function '' ' Get the abs path, use the short version if necessary. function PathAbs(str) strAbs = g_objFileSys.GetAbsolutePathName(DosSlashes(str)) strParent = g_objFileSys.GetParentFolderName(strAbs) if strParent = "" then PathAbs = strAbs else strParent = PathAbs(strParent) ' Recurse to resolve parent paths. PathAbs = g_objFileSys.BuildPath(strParent, g_objFileSys.GetFileName(strAbs)) dim obj set obj = Nothing if FileExists(PathAbs) then set obj = g_objFileSys.GetFile(PathAbs) elseif DirExists(PathAbs) then set obj = g_objFileSys.GetFolder(PathAbs) end if if not (obj is nothing) then for each objSub in obj.ParentFolder.SubFolders if obj.Name = objSub.Name or obj.ShortName = objSub.ShortName then if InStr(1, objSub.Name, " ") > 0 _ Or InStr(1, objSub.Name, "&") > 0 _ Or InStr(1, objSub.Name, "$") > 0 _ then PathAbs = g_objFileSys.BuildPath(strParent, objSub.ShortName) if InStr(1, PathAbs, " ") > 0 _ Or InStr(1, PathAbs, "&") > 0 _ Or InStr(1, PathAbs, "$") > 0 _ then MsgFatal "PathAbs(" & str & ") attempted to return filename with problematic " _ & "characters in it (" & PathAbs & "). The tool/sdk referenced will probably " _ & "need to be copied or reinstalled to a location without 'spaces', '$', ';' " _ & "or '&' in the path name. (Unless it's a problem with this script of course...)" end if else PathAbs = g_objFileSys.BuildPath(strParent, objSub.Name) end if exit for end if next end if end if end function '' ' Get the abs path, use the long version. function PathAbsLong(str) strAbs = g_objFileSys.GetAbsolutePathName(DosSlashes(str)) strParent = g_objFileSys.GetParentFolderName(strAbs) if strParent = "" then PathAbsLong = strAbs else strParent = PathAbsLong(strParent) ' Recurse to resolve parent paths. PathAbsLong = g_objFileSys.BuildPath(strParent, g_objFileSys.GetFileName(strAbs)) dim obj set obj = Nothing if FileExists(PathAbsLong) then set obj = g_objFileSys.GetFile(PathAbsLong) elseif DirExists(PathAbsLong) then set obj = g_objFileSys.GetFolder(PathAbsLong) end if if not (obj is nothing) then for each objSub in obj.ParentFolder.SubFolders if obj.Name = objSub.Name or obj.ShortName = objSub.ShortName then PathAbsLong = g_objFileSys.BuildPath(strParent, objSub.Name) exit for end if next end if end if end function '' ' Compare two paths w/o abspathing them. ' ' Ignores case, slash direction, multiple slashes and single dot components. ' function PathMatch(strPath1, strPath2) PathMatch = true if StrComp(strPath1, strPath2, vbTextCompare) <> 0 then strPath1 = DosSlashes(strPath1) strPath2 = DosSlashes(strPath2) if StrComp(strPath1, strPath2, vbTextCompare) <> 0 then ' Compare character by character dim off1 : off1 = 1 dim off2 : off2 = 1 ' Compare UNC prefix if any, because the code below cannot handle it. UNC has exactly two slashes. if Mid(strPath1, 1, 2) = "\\" and Mid(strPath2, 1, 2) = "\\" then if (Mid(strPath1, 3, 1) = "\") <> (Mid(strPath2, 3, 1) = "\") then PathMatch = false exit function end if off1 = off1 + 2 off2 = off2 + 2 if Mid(strPath1, 3, 1) = "\" then off1 = PathMatchSkipSlashesAndSlashDotHelper(strPath1, off1) off2 = PathMatchSkipSlashesAndSlashDotHelper(strPath2, off2) end if end if ' Compare the rest. dim ch1, ch2 do while off1 <= Len(strPath1) and off2 <= Len(strPath2) ch1 = Mid(strPath1, off1, 1) ch2 = Mid(strPath2, off2, 1) if StrComp(ch1, ch2, vbTextCompare) = 0 then off1 = off1 + 1 off2 = off2 + 1 if ch1 = "\" then off1 = PathMatchSkipSlashesAndSlashDotHelper(strPath1, off1) off2 = PathMatchSkipSlashesAndSlashDotHelper(strPath2, off2) end if else PathMatch = False exit function end if loop ' One or both of the strings ran out. That's fine if we've only got slashes ' and "." components left in the other. if off1 <= Len(strPath1) and Mid(strPath1, off1, 1) = "\" then off1 = PathMatchSkipSlashesAndSlashDotHelper(strPath1, off1 + 1) end if if off2 <= Len(strPath2) and Mid(strPath2, off2, 1) = "\" then off2 = PathMatchSkipSlashesAndSlashDotHelper(strPath2, off2 + 1) end if PathMatch = off1 > Len(strPath1) and off2 > Len(strPath2) end if end if end function '' PathMatch helper function PathMatchSkipSlashesAndSlashDotHelper(strPath, off) dim ch do while off <= Len(strPath) ch = Mid(strPath, off, 1) if ch = "\" then off = off + 1 elseif ch = "." and off = Len(strPath) then off = off + 1 elseif ch = "." and Mid(strPath, off, 2) = ".\" then off = off + 2 else exit do end if loop PathMatchSkipSlashesAndSlashDotHelper = off end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Files and Dirs ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Read a file (typically the tmp file) into a string. function FileToString(strFilename) const ForReading = 1, TristateFalse = 0 dim objLogFile, str set objFile = g_objFileSys.OpenTextFile(DosSlashes(strFilename), ForReading, False, TristateFalse) str = objFile.ReadAll() objFile.Close() FileToString = str end function '' ' Deletes a file sub FileDelete(strFilename) if g_objFileSys.FileExists(DosSlashes(strFilename)) then g_objFileSys.DeleteFile(DosSlashes(strFilename)) end if end sub '' ' Appends a line to an ascii file. sub FileAppendLine(strFilename, str) const ForAppending = 8, TristateFalse = 0 dim objFile set objFile = g_objFileSys.OpenTextFile(DosSlashes(strFilename), ForAppending, True, TristateFalse) objFile.WriteLine(str) objFile.Close() end sub '' ' Checks if the file exists. function FileExists(strFilename) FileExists = g_objFileSys.FileExists(DosSlashes(strFilename)) DbgPrint "FileExists(" & strFilename & ") -> " & FileExists end function '' ' Checks if the directory exists. function DirExists(strDirectory) DirExists = g_objFileSys.FolderExists(DosSlashes(strDirectory)) DbgPrint "DirExists(" & strDirectory & ") -> " & DirExists end function '' ' Returns true if there are subfolders starting with the given string. function HasSubdirsStartingWith(strFolder, strStartingWith) HasSubdirsStartingWith = False if DirExists(strFolder) then dim obj set obj = g_objFileSys.GetFolder(strFolder) for each objSub in obj.SubFolders if StrComp(Left(objSub.Name, Len(strStartingWith)), strStartingWith) = 0 then HasSubdirsStartingWith = True LogPrint "# HasSubdirsStartingWith(" & strFolder & "," & strStartingWith & ") found " & objSub.Name exit for end if next end if end function '' ' Returns a sorted array of subfolder names that starts with the given string. function GetSubdirsStartingWith(strFolder, strStartingWith) if DirExists(strFolder) then dim obj, i set obj = g_objFileSys.GetFolder(strFolder) i = 0 for each objSub in obj.SubFolders if StrComp(Left(objSub.Name, Len(strStartingWith)), strStartingWith) = 0 then i = i + 1 end if next if i > 0 then redim arrResult(i - 1) i = 0 for each objSub in obj.SubFolders if StrComp(Left(objSub.Name, Len(strStartingWith)), strStartingWith) = 0 then arrResult(i) = objSub.Name i = i + 1 end if next GetSubdirsStartingWith = arrResult else GetSubdirsStartingWith = Array() end if else GetSubdirsStartingWith = Array() end if end function '' ' Returns a sorted array of subfolder names that starts with the given string. function GetSubdirsStartingWithVerSorted(strFolder, strStartingWith) GetSubdirsStartingWithVerSorted = ArrayVerSortStrings(GetSubdirsStartingWith(strFolder, strStartingWith)) end function '' ' Returns a reverse version sorted array of subfolder names that starts with the given string. function GetSubdirsStartingWithRVerSorted(strFolder, strStartingWith) GetSubdirsStartingWithRVerSorted = ArrayRVerSortStrings(GetSubdirsStartingWith(strFolder, strStartingWith)) end function '' ' Try find the specified file in the specified path variable. function WhichEx(strEnvVar, strFile) dim strPath, iStart, iEnd, str ' the path strPath = EnvGet(strEnvVar) iStart = 1 do while iStart <= Len(strPath) iEnd = InStr(iStart, strPath, ";") if iEnd <= 0 then iEnd = Len(strPath) + 1 if iEnd > iStart then str = Mid(strPath, iStart, iEnd - iStart) & "/" & strFile if FileExists(str) then WhichEx = str exit function end if end if iStart = iEnd + 1 loop ' registry or somewhere? WhichEx = "" end function '' ' Try find the specified file in the path. function Which(strFile) Which = WhichEx("Path", strFile) end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Processes ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Checks if this is a WOW64 process. function IsWow64() if g_objShell.Environment("PROCESS")("PROCESSOR_ARCHITEW6432") <> "" then IsWow64 = 1 else IsWow64 = 0 end if end function '' ' Executes a command in the shell catching output in strOutput function Shell(strCommand, blnBoth, ByRef strOutput) dim strShell, strCmdline, objExec, str strShell = g_objShell.ExpandEnvironmentStrings("%ComSpec%") if blnBoth = true then strCmdline = strShell & " /c " & strCommand & " 2>&1" else strCmdline = strShell & " /c " & strCommand & " 2>nul" end if LogPrint "# Shell: " & strCmdline Set objExec = g_objShell.Exec(strCmdLine) strOutput = objExec.StdOut.ReadAll() objExec.StdErr.ReadAll() do while objExec.Status = 0 Wscript.Sleep 20 strOutput = strOutput & objExec.StdOut.ReadAll() objExec.StdErr.ReadAll() loop LogPrint "# Status: " & objExec.ExitCode LogPrint "# Start of Output" LogPrint strOutput LogPrint "# End of Output" Shell = objExec.ExitCode end function '' ' Gets the SID of the current user. function GetSid() dim objNet, strUser, strDomain, offSlash, objWmiUser GetSid = "" ' Figure the user + domain set objNet = CreateObject("WScript.Network") strUser = objNet.UserName strDomain = objNet.UserDomain offSlash = InStr(1, strUser, "\") if offSlash > 0 then strDomain = Left(strUser, offSlash - 1) strUser = Right(strUser, Len(strUser) - offSlash) end if ' Lookup the user. on error resume next set objWmiUser = GetObject("winmgmts:{impersonationlevel=impersonate}!/root/cimv2:Win32_UserAccount." _ & "Domain='" & strDomain &"',Name='" & strUser & "'") if err.number = 0 then GetSid = objWmiUser.SID end if end function '' ' Gets the commandline used to invoke the script. function GetCommandline() dim str, i '' @todo find an api for querying it instead of reconstructing it like this... GetCommandline = "cscript configure.vbs" for i = 1 to WScript.Arguments.Count str = WScript.Arguments.Item(i - 1) if str = "" then str = """""" elseif (InStr(1, str, " ")) then str = """" & str & """" end if GetCommandline = GetCommandline & " " & str next end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Environment ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Gets an environment variable. function EnvGet(strName) EnvGet = g_objShell.Environment("PROCESS")(strName) end function '' ' Gets an environment variable with default value if not found. function EnvGetDef(strName, strDefault) dim strValue strValue = g_objShell.Environment("PROCESS")(strName) if strValue = "" or IsNull(strValue) or IsEmpty(strValue) then EnvGetDef = strDefault else EnvGetDef = strValue end if end function '' ' Gets an environment variable with default value if not found or not ' in the array of valid values. Issue warning about invalid values. function EnvGetDefValid(strName, strDefault, arrValidValues) dim strValue strValue = g_objShell.Environment("PROCESS")(strName) if strValue = "" or IsNull(strValue) or IsEmpty(strValue) then EnvGetDefValid = strDefault elseif not ArrayContainsString(arrValidValues, strValue) then MsgWarning "Invalid value " & strName & " value '" & EnvGetDefValid & "', using '" & strDefault & "' instead." EnvGetDefValid = strDefault else EnvGetDefValid = strValue end if end function '' ' Sets an environment variable. sub EnvSet(strName, strValue) g_objShell.Environment("PROCESS")(strName) = strValue LogPrint "EnvSet: " & strName & "=" & strValue end sub '' ' Prepends a string to an Path-like environment variable. function EnvPrependItemEx(strName, strItem, strSep, blnKeepEmpty, ByRef fnItemMatcher) dim strValue strValue = EnvRemoveItemEx(strName, strItem, strSep, blnKeepEmpty, fnItemMatcher, "EnvPrependItemEx") if strValue <> "" then strValue = strItem & strSep & strValue else strValue = strItem end if g_objShell.Environment("PROCESS")(strName) = strValue EnvPrependItemEx = strValue end function '' ' Appends a string to an Path-like environment variable, function EnvAppendItemEx(strName, strItem, strSep, blnKeepEmpty, ByRef fnItemMatcher) dim strValue strValue = EnvRemoveItemEx(strName, strItem, strSep, blnKeepEmpty, fnItemMatcher, "EnvAppendItemEx") if strValue <> "" then strValue = strValue & strSep & strItem else strValue = strItem end if g_objShell.Environment("PROCESS")(strName) = strValue EnvAppendItemEx = strValue end function '' ' Generic item remover. ' ' fnItemMatcher(strItem1, strItem2) ' function EnvRemoveItemEx(strName, strItem, strSep, blnKeepEmpty, ByRef fnItemMatcher, strCaller) dim strValue, off strValue = g_objShell.Environment("PROCESS")(strName) EnvRemoveItemEx = strValue if strValue <> "" then ' Split it up into an array of items dim arrItems : arrItems = Split(strValue, strSep, -1, vbTextCompare) ' Create an array of matching indexes that we should remove. dim cntToRemove : cntToRemove = 0 redim arrIdxToRemove(ArraySize(arrItems) - 1) dim i, strCur for i = LBound(arrItems) to UBound(arrItems) strCur = arrItems(i) if fnItemMatcher(strCur, strItem) or (not blnKeepEmpty and strCur = "") then arrIdxToRemove(cntToRemove) = i cntToRemove = cntToRemove + 1 end if next ' Did we find anthing to remove? if cntToRemove > 0 then ' Update the array and join it up again. for i = cntToRemove - 1 to 0 step -1 arrItems = ArrayRemove(arrItems, arrIdxToRemove(i)) next dim strNewValue : strNewValue = ArrayJoinString(arrItems, strSep) EnvRemoveItemEx = strNewValue ' Update the environment variable. LogPrint strCaller &": " & strName & ": '" & strValue & "' --> '" & strNewValue & "'" g_objShell.Environment("PROCESS")(strName) = strNewValue end if end if end function '' ' Generic case-insensitive item matcher. ' See also PathMatch(). function EnvItemMatch(strItem1, strItem2) EnvItemMatch = (StrComp(strItem1, strItem2) = 0) end function '' ' Prepends an item to an environment variable, after first removing any ' existing ones (case-insensitive, preserves empty elements). function EnvPrependItem(strName, strItem, strSep) EnvPrependItem = EnvPrependItemEx(strName, strItem, strSep, true, GetRef("EnvItemMatch")) LogPrint "EnvPrependItem: " & strName & "=" & EnvPrependPathItem end function '' ' Appends an item to an environment variable, after first removing any ' existing ones (case-insensitive, preserves empty elements). function EnvAppendItem(strName, strItem, strSep) EnvAppendItem = EnvAppendItemEx(strName, strItem, strSep, true, GetRef("EnvItemMatch")) LogPrint "EnvAppendItem: " & strName & "=" & EnvPrependPathItem end function '' ' Removes a string element from an environment variable, case ' insensitive but preserving empty elements. function EnvRemoveItem(strName, strItem, strSep) EnvRemoveItem = EnvRemoveItemEx(strName, strIten, strSep, true, GetRef("EnvItemMatch"), "EnvRemoveItem") end function '' ' Appends a string to an Path-like environment variable, function EnvPrependPathItem(strName, strItem, strSep) EnvPrependPathItem = EnvPrependItemEx(strName, strItem, strSep, false, GetRef("PathMatch")) LogPrint "EnvPrependPathItem: " & strName & "=" & EnvPrependPathItem end function '' ' Appends a string to an Path-like environment variable, function EnvAppendPathItem(strName, strItem, strSep) EnvAppendPathItem = EnvAppendItemEx(strName, strItem, strSep, false, GetRef("PathMatch")) LogPrint "EnvAppendPathItem: " & strName & "=" & EnvAppendPathItem end function '' ' Removes a string element from an Path-like environment variable, case ' insensitive and treating forward and backward slashes the same way. function EnvRemovePathItem(strName, strItem, strSep) EnvRemovePathItem = EnvRemoveItemEx(strName, strIten, strSep, false, GetRef("PathMatch"), "EnvRemovePathItem") end function '' ' Prepends a string to an environment variable sub EnvUnset(strName) g_objShell.Environment("PROCESS").Remove(strName) LogPrint "EnvUnset: " & strName end sub '' ' Gets the first non-empty environment variable of the given two. function EnvGetFirst(strName1, strName2) EnvGetFirst = g_objShell.Environment("PROCESS")(strName1) if EnvGetFirst = "" then EnvGetFirst = g_objShell.Environment("PROCESS")(strName2) end if end function '' ' Checks if the given enviornment variable exists. function EnvExists(strName) EnvExists = g_objShell.Environment("PROCESS")(strName) <> "" end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Strings ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Right pads a string with spaces to the given length function RightPad(str, cch) if Len(str) < cch then RightPad = str & String(cch - Len(str), " ") else RightPad = str end if end function '' ' Checks if the given character is a decimal digit function CharIsDigit(ch) CharIsDigit = (InStr(1, "0123456789", ch) > 0) end function '' ' Worker for StrVersionCompare ' The offset is updated to point to the first non-digit character. function CountDigitsIgnoreLeadingZeros(ByRef str, ByRef off) dim cntDigits, blnLeadingZeros, ch, offInt cntDigits = 0 if CharIsDigit(Mid(str, off, 1)) then ' Rewind to start of digest sequence. do while off > 1 if not CharIsDigit(Mid(str, off - 1, 1)) then exit do off = off - 1 loop ' Count digits, ignoring leading zeros. blnLeadingZeros = True for off = off to Len(str) ch = Mid(str, off, 1) if CharIsDigit(ch) then if ch <> "0" or blnLeadingZeros = False then cntDigits = cntDigits + 1 blnLeadingZeros = False end if else exit for end if next ' If all zeros, count one of them. if cntDigits = 0 then cntDigits = 1 end if CountDigitsIgnoreLeadingZeros = cntDigits end function '' ' Very simple version string compare function. ' @returns < 0 if str1 is smaller than str2 ' @returns 0 if str1 and str2 are equal ' @returns > 1 if str2 is larger than str1 function StrVersionCompare(str1, str2) ' Compare the strings. We can rely on StrComp if equal or one is empty. 'LogPrint "StrVersionCompare("&str1&","&str2&"):" StrVersionCompare = StrComp(str2, str1) if StrVersionCompare <> 0 then dim cch1, cch2, off1, off2, ch1, ch2, chPrev1, chPrev2, intDiff, cchDigits cch1 = Len(str1) cch2 = Len(str2) if cch1 > 0 and cch2 > 0 then ' Compare the common portion off1 = 1 off2 = 1 chPrev1 = "x" chPrev2 = "x" do while off1 <= cch1 and off2 <= cch2 ch1 = Mid(str1, off1, 1) ch2 = Mid(str2, off2, 1) if ch1 = ch2 then off1 = off1 + 1 off2 = off2 + 1 chPrev1 = ch1 chPrev2 = ch2 else ' Is there a digest sequence in play. This includes the scenario where one of the ' string ran out of digests. dim blnDigest1 : blnDigest1 = CharIsDigit(ch1) dim blnDigest2 : blnDigest2 = CharIsDigit(ch2) if (blnDigest1 = True or blnDigest2 = True) _ and (blnDigest1 = True or CharIsDigit(chPrev1) = True) _ and (blnDigest2 = True or CharIsDigit(chPrev2) = True) _ then 'LogPrint "StrVersionCompare: off1="&off1&" off2="&off2&" ch1="&ch1&" chPrev1="&chPrev1&" ch2="&ch2&" chPrev2="&chPrev2 if blnDigest1 = False then off1 = off1 - 1 if blnDigest2 = False then off2 = off2 - 1 ' The one with the fewer digits comes first. ' Note! off1 and off2 are adjusted to next non-digit character in the strings. cchDigits = CountDigitsIgnoreLeadingZeros(str1, off1) intDiff = cchDigits - CountDigitsIgnoreLeadingZeros(str2, off2) 'LogPrint "StrVersionCompare: off1="&off1&" off2="&off2&" cchDigits="&cchDigits if intDiff <> 0 then StrVersionCompare = intDiff 'LogPrint "StrVersionCompare: --> "&intDiff&" #1" exit function end if ' If the same number of digits, the smaller digit wins. However, because of ' potential leading zeros, we must redo the compare. Assume ASCII-like stuff ' and we can use StrComp for this. intDiff = StrComp(Mid(str1, off1 - cchDigits, cchDigits), Mid(str2, off2 - cchDigits, cchDigits)) if intDiff <> 0 then StrVersionCompare = intDiff 'LogPrint "StrVersionCompare: --> "&intDiff&" #2" exit function end if chPrev1 = "x" chPrev2 = "x" else if blnDigest1 then StrVersionCompare = -1 ' Digits before characters 'LogPrint "StrVersionCompare: --> -1 (#3)" elseif blnDigest2 then StrVersionCompare = 1 ' Digits before characters 'LogPrint "StrVersionCompare: --> 1 (#4)" else StrVersionCompare = StrComp(ch1, ch2) 'LogPrint "StrVersionCompare: --> "&StrVersionCompare&" (#5)" end if exit function end if end if loop ' The common part matches up, so the shorter string 'wins'. StrVersionCompare = (cch1 - off1) - (cch2 - off2) end if end if 'LogPrint "StrVersionCompare: --> "&StrVersionCompare&" (#6)" end function '' ' Returns the first list of the given string. function StrGetFirstLine(str) dim off off = InStr(1, str, Chr(10)) if off <= 0 then off = InStr(1, str, Chr(13)) if off > 0 then StrGetFirstLine = Mid(str, 1, off) else StrGetFirstLine = str end if end function '' ' Returns the first word in the given string. ' ' Only recognizes space, tab, newline and carriage return as word separators. ' function StrGetFirstWord(str) dim strSep, offWord, offEnd, offEnd2, strSeparators strSeparators = " " & Chr(9) & Chr(10) & Chr(13) ' Skip leading separators. for offWord = 1 to Len(str) if InStr(1, strSeparators, Mid(str, offWord, 1)) < 1 then exit for next ' Find the end. offEnd = Len(str) + 1 for offSep = 1 to Len(strSeparators) offEnd2 = InStr(offWord, str, Mid(strSeparators, offSep, 1)) if offEnd2 > 0 and offEnd2 < offEnd then offEnd = offEnd2 next StrGetFirstWord = Mid(str, offWord, offEnd - offWord) end function '' ' Checks if the string starts with the given prefix (case sensitive). function StrStartsWith(str, strPrefix) if len(str) >= Len(strPrefix) then StrStartsWith = (StrComp(Left(str, Len(strPrefix)), strPrefix, vbBinaryCompare) = 0) else StrStartsWith = false end if end function '' ' Checks if the string starts with the given prefix, case insenstive edition. function StrStartsWithI(str, strPrefix) if len(str) >= Len(strPrefix) then StrStartsWithI = (StrComp(Left(str, Len(strPrefix)), strPrefix, vbTextCompare) = 0) else StrStartsWithI = false end if end function '' ' Checks if the string ends with the given suffix (case sensitive). function StrEndsWith(str, strSuffix) if len(str) >= Len(strSuffix) then StrEndsWith = (StrComp(Right(str, Len(strSuffix)), strSuffix, vbBinaryCompare) = 0) else StrEndsWith = false end if end function '' ' Checks if the string ends with the given suffix, case insenstive edition. function StrEndsWithI(str, strSuffix) if len(str) >= Len(strSuffix) then StrEndsWithI = (StrComp(Right(str, Len(strSuffix)), strSuffix, vbTextCompare) = 0) else StrEndsWithI = false end if end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Arrays ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Returns a reverse array (copy). function ArrayReverse(arr) dim cnt, i, j, iHalf, objTmp cnt = UBound(arr) - LBound(arr) + 1 if cnt > 0 then j = UBound(arr) iHalf = Fix(LBound(arr) + cnt / 2) for i = LBound(arr) to iHalf - 1 objTmp = arr(i) arr(i) = arr(j) arr(j) = objTmp j = j - 1 next end if ArrayReverse = arr end function '' ' Returns a reverse sorted array (strings). function ArraySortStringsEx(arrStrings, ByRef fnCompare) dim str1, str2, i, j for i = LBound(arrStrings) to UBound(arrStrings) str1 = arrStrings(i) for j = i + 1 to UBound(arrStrings) str2 = arrStrings(j) if fnCompare(str2, str1) < 0 then arrStrings(j) = str1 str1 = str2 end if next arrStrings(i) = str1 next ArraySortStringsEx = arrStrings end function '' Wrapper for StrComp as GetRef("StrComp") fails. function WrapStrComp(str1, str2) WrapStrComp = StrComp(str1, str2) end function '' ' Returns a reverse sorted array (strings). function ArraySortStrings(arrStrings) ArraySortStrings = ArraySortStringsEx(arrStrings, GetRef("WrapStrComp")) end function '' ' Returns a reverse sorted array (strings). function ArrayVerSortStrings(arrStrings) ArrayVerSortStrings = ArraySortStringsEx(arrStrings, GetRef("StrVersionCompare")) end function '' Wrapper for StrComp as GetRef("StrComp") fails. function WrapStrCompNeg(str1, str2) WrapStrCompNeg = -StrComp(str1, str2) end function '' ' Returns a reverse sorted array (strings). function ArrayRSortStrings(arrStrings) ArrayRSortStrings = ArraySortStringsEx(arrStrings, GetRef("WrapStrCompNeg")) end function '' ' Returns a reverse version sorted array (strings). function ArrayRVerSortStrings(arrStrings) ArrayRVerSortStrings = ArrayReverse(ArraySortStringsEx(arrStrings, GetRef("StrVersionCompare"))) end function '' ' Prints a string array. sub ArrayPrintStrings(arrStrings, strPrefix) for i = LBound(arrStrings) to UBound(arrStrings) Print strPrefix & "arrStrings(" & i & ") = '" & arrStrings(i) & "'" next end sub '' ' Returns an Array() statement string function ArrayToString(arrStrings) dim strRet, i strRet = "Array(" for i = LBound(arrStrings) to UBound(arrStrings) if i <> LBound(arrStrings) then strRet = strRet & ", " strRet = strRet & """" & arrStrings(i) & """" next ArrayToString = strRet & ")" end function '' ' Joins the elements of an array into a string using the given item separator. ' @remark this is the same as Join() really. function ArrayJoinString(arrStrings, strSep) if ArraySize(arrStrings) = 0 then ArrayJoinString = "" else dim i ArrayJoinString = "" & arrStrings(LBound(arrStrings)) for i = LBound(arrStrings) + 1 to UBound(arrStrings) ArrayJoinString = ArrayJoinString & strSep & arrStrings(i) next end if end function '' ' Returns the input array with the string appended. ' @note This works by reference function ArrayAppend(ByRef arr, str) dim i redim preserve arr(UBound(arr) + 1) arr(UBound(arr)) = str ArrayAppend = arr end function '' ' Returns the input array with the string prepended. ' @note This works by reference function ArrayPrepend(ByRef arr, str) dim i redim preserve arr(UBound(arr) + 1) for i = UBound(arr) to (LBound(arr) + 1) step -1 arr(i) = arr(i - 1) next arr(LBound(arr)) = str ArrayPrepend = arr end function '' ' Returns the input array with the string prepended. ' @note This works by reference function ArrayRemove(ByRef arr, idx) dim i for i = idx to (UBound(arr) - 1) arr(i) = arr(i + 1) next redim preserve arr(UBound(arr) - 1) ArrayRemove = arr end function '' ' Checks if the array contains the given string (case sensitive). function ArrayContainsString(ByRef arr, str) dim strCur ArrayContainsString = False for each strCur in arr if StrComp(strCur, str) = 0 then ArrayContainsString = True exit function end if next end function '' ' Checks if the array contains the given string, using case insensitive compare. function ArrayContainsStringI(ByRef arr, str) dim strCur ArrayContainsStringI = False for each strCur in arr if StrComp(strCur, str, vbTextCompare) = 0 then ArrayContainsStringI = True exit function end if next end function '' ' Returns the index of the first occurance of the given string; -1 if not found. function ArrayFindString(ByRef arr, str) dim i for i = LBound(arr) to UBound(arr) if StrComp(arr(i), str, vbBinaryCompare) = 0 then ArrayFindString = i exit function end if next ArrayFindString = LBound(arr) - 1 end function '' ' Returns the index of the first occurance of the given string, -1 if not found, ' case insensitive edition. function ArrayFindStringI(ByRef arr, str) dim i for i = LBound(arr) to UBound(arr) if StrComp(arr(i), str, vbTextCompare) = 0 then ArrayFindStringI = i exit function end if next ArrayFindStringI = LBound(arr) - 1 end function '' ' Returns the number of entries in an array. function ArraySize(ByRef arr) if (UBound(arr) >= 0) then ArraySize = UBound(arr) - LBound(arr) + 1 else ArraySize = 0 end if end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Registry ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' The registry globals dim g_objReg, g_objRegCtx dim g_blnRegistry g_blnRegistry = false '' ' Init the register provider globals. function RegInit() RegInit = false On Error Resume Next if g_blnRegistry = false then set g_objRegCtx = CreateObject("WbemScripting.SWbemNamedValueSet") ' Comment out the following for lines if the cause trouble on your windows version. if IsWow64() then g_objRegCtx.Add "__ProviderArchitecture", 64 g_objRegCtx.Add "__RequiredArchitecture", true LogPrint "RegInit: WoW64" end if set objLocator = CreateObject("Wbemscripting.SWbemLocator") set objServices = objLocator.ConnectServer("", "root\default", "", "", , , , g_objRegCtx) set g_objReg = objServices.Get("StdRegProv") g_blnRegistry = true end if RegInit = true end function '' ' Translates a register root name to a value ' This will translate HKCU path to HKEY_USERS and fixing function RegTransRoot(strRoot, ByRef sSubKeyName) const HKEY_LOCAL_MACHINE = &H80000002 const HKEY_CURRENT_USER = &H80000001 const HKEY_USERS = &H80000003 select case strRoot case "HKLM" RegTransRoot = HKEY_LOCAL_MACHINE case "HKUS" RegTransRoot = HKEY_USERS case "HKCU" dim strCurrentSid strCurrentSid = GetSid() if strCurrentSid <> "" then sSubKeyName = strCurrentSid & "\" & sSubKeyName RegTransRoot = HKEY_USERS 'LogPrint "RegTransRoot: HKCU -> HKEY_USERS + " & sSubKeyName else RegTransRoot = HKEY_CURRENT_USER LogPrint "RegTransRoot: Warning! HKCU -> HKEY_USERS failed!" end if case else MsgFatal "RegTransRoot: Unknown root: '" & strRoot & "'" RegTransRoot = 0 end select end function '' ' Gets a value from the registry. Returns "" if string wasn't found / valid. function RegGetString(strName) RegGetString = "" if RegInit() then dim strRoot, strKey, strValue ' split up into root, key and value parts. strRoot = left(strName, instr(strName, "\") - 1) strKey = mid(strName, instr(strName, "\") + 1, instrrev(strName, "\") - instr(strName, "\")) strValue = mid(strName, instrrev(strName, "\") + 1) ' Must use ExecMethod to call the GetStringValue method because of the context. Set InParms = g_objReg.Methods_("GetStringValue").Inparameters InParms.hDefKey = RegTransRoot(strRoot, strKey) InParms.sSubKeyName = strKey InParms.sValueName = strValue On Error Resume Next set OutParms = g_objReg.ExecMethod_("GetStringValue", InParms, , g_objRegCtx) if OutParms.ReturnValue = 0 then if not IsNull(OutParms.sValue) then RegGetString = OutParms.sValue end if end if else ' fallback mode On Error Resume Next RegGetString = g_objShell.RegRead(strName) end if end function '' ' Gets a multi string value from the registry. Returns array of strings if found, otherwise empty array(). function RegGetMultiString(strName) RegGetMultiString = Array() if RegInit() then dim strRoot, strKey, strValue ' split up into root, key and value parts. strRoot = left(strName, instr(strName, "\") - 1) strKey = mid(strName, instr(strName, "\") + 1, instrrev(strName, "\") - instr(strName, "\")) strValue = mid(strName, instrrev(strName, "\") + 1) ' Must use ExecMethod to call the GetStringValue method because of the context. Set InParms = g_objReg.Methods_("GetMultiStringValue").Inparameters InParms.hDefKey = RegTransRoot(strRoot, strKey) InParms.sSubKeyName = strKey InParms.sValueName = strValue On Error Resume Next set OutParms = g_objReg.ExecMethod_("GetMultiStringValue", InParms, , g_objRegCtx) if OutParms.ReturnValue = 0 then if OutParms.sValue <> Null then RegGetMultiString = OutParms.sValue end if end if else ' fallback mode On Error Resume Next RegGetMultiString = g_objShell.RegRead(strName) end if end function '' ' Returns an array of subkey strings. function RegEnumSubKeys(strRoot, ByVal strKeyPath) RegEnumSubKeys = Array() if RegInit() then ' Must use ExecMethod to call the EnumKey method because of the context. Set InParms = g_objReg.Methods_("EnumKey").Inparameters InParms.hDefKey = RegTransRoot(strRoot, strKeyPath) InParms.sSubKeyName = strKeyPath On Error Resume Next set OutParms = g_objReg.ExecMethod_("EnumKey", InParms, , g_objRegCtx) 'LogPrint "RegEnumSubKeys(" & Hex(InParms.hDefKey) & "," & InParms.sSubKeyName &") -> " & OutParms.GetText_(1) if OutParms.ReturnValue = 0 then if OutParms.sNames <> Null then RegEnumSubKeys = OutParms.sNames end if end if else ' fallback mode dim objReg, rc, arrSubKeys set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") On Error Resume Next rc = objReg.EnumKey(RegTransRoot(strRoot, strKeyPath), strKeyPath, arrSubKeys) if rc = 0 then RegEnumSubKeys = arrSubKeys end if end if end function '' ' Returns an array of full path subkey strings. function RegEnumSubKeysFull(strRoot, strKeyPath) dim arrTmp arrTmp = RegEnumSubKeys(strRoot, strKeyPath) for i = LBound(arrTmp) to UBound(arrTmp) arrTmp(i) = strKeyPath & "\" & arrTmp(i) next RegEnumSubKeysFull = arrTmp end function '' ' Returns an rsorted array of subkey strings. function RegEnumSubKeysRVerSorted(strRoot, strKeyPath) RegEnumSubKeysRVerSorted = ArrayRVerSortStrings(RegEnumSubKeys(strRoot, strKeyPath)) end function '' ' Returns an rsorted array of subkey strings. function RegEnumSubKeysFullRVerSorted(strRoot, strKeyPath) RegEnumSubKeysFullRVerSorted = ArrayRVerSortStrings(RegEnumSubKeysFull(strRoot, strKeyPath)) end function '' ' Returns an array of value name strings. function RegEnumValueNames(strRoot, ByVal strKeyPath) RegEnumValueNames = Array() if RegInit() then ' Must use ExecMethod to call the EnumKey method because of the context. Set InParms = g_objReg.Methods_("EnumValues").Inparameters InParms.hDefKey = RegTransRoot(strRoot, strKeyPath) InParms.sSubKeyName = strKeyPath On Error Resume Next set OutParms = g_objReg.ExecMethod_("EnumValues", InParms, , g_objRegCtx) 'LogPrint "RegEnumValueNames(" & Hex(InParms.hDefKey) & "," & InParms.sSubKeyName &") -> " & OutParms.GetText_(1) if OutParms.ReturnValue = 0 then if OutParms.sNames <> Null then RegEnumValueNames = OutParms.sNames end if end if else ' fallback mode dim objReg, rc, arrSubKeys set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") On Error Resume Next rc = objReg.EnumValues(RegTransRoot(strRoot, strKeyPath), strKeyPath, arrSubKeys) if rc = 0 then RegEnumValueNames = arrSubKeys end if end if end function '' ' Returns an array of full path value name strings. function RegEnumValueNamesFull(strRoot, strKeyPath) dim arrTmp arrTmp = RegEnumValueNames(strRoot, strKeyPath) for i = LBound(arrTmp) to UBound(arrTmp) arrTmp(i) = strKeyPath & "\" & arrTmp(i) next RegEnumValueNamesFull = arrTmp end function '' ' Extract relevant paths from program links using a callback function. ' ' Enumerates start menu program links from "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\UFH\SHC" ' and similar, using the given callback to examine each and return a path if relevant. The relevant ' paths are returned in reverse sorted order. ' ' The callback prototype is as follows fnCallback(ByRef arrStrings, cStrings, ByRef objUser). ' Any non-empty return strings are collected, reverse sorted uniquely and returned. ' function CollectFromProgramItemLinks(ByRef fnCallback, ByRef objUser) dim arrValues, strValue, arrStrings, str, arrCandidates, iCandidates, cStrings CollectFromProgramItemLinks = Array() arrValues = RegEnumValueNamesFull("HKCU", "SOFTWARE\Microsoft\Windows\CurrentVersion\UFH\SHC") redim arrCandidates(UBound(arrValues) - LBound(arrValues) + 1) iCandidates = 0 for each strValue in arrValues arrStrings = RegGetMultiString("HKCU\" & strValue) if UBound(arrStrings) >= 0 then cStrings = UBound(arrStrings) + 1 - LBound(arrStrings) str = fnCallback(arrStrings, cStrings, objUser) if str <> "" then if not ArrayContainsStringI(arrCandidates, str) then arrCandidates(iCandidates) = str iCandidates = iCandidates + 1 end if end if end if next if iCandidates > 0 then redim preserve arrCandidates(iCandidates - 1) arrCandidates = ArrayRVerSortStrings(arrCandidates) for iCandidates = LBound(arrCandidates) to UBound(arrCandidates) LogPrint "CollectFromProgramItemLinks: #" & iCandidates & ": " & arrCandidates(iCandidates) next CollectFromProgramItemLinks = arrCandidates end if end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Messaging and Output ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Append text to the log file and echo it to stdout sub Print(str) LogPrint str Wscript.Echo str end sub '' ' Prints a test header sub PrintHdr(strTest) LogPrint "***** Checking for " & strTest & " *****" Wscript.Echo "Checking for " & StrTest & "..." end sub '' ' Prints a success message sub PrintResultMsg(strTest, strResult) dim cchPad LogPrint "** " & strTest & ": " & strResult Wscript.Echo " Found " & RightPad(strTest & ": ", 22) & strPad & strResult end sub '' ' Prints a successfully detected path sub PrintResult(strTest, strPath) strLongPath = PathAbsLong(strPath) if PathAbs(strPath) <> strLongPath then LogPrint "** " & strTest & ": " & strPath & " (" & UnixSlashes(strLongPath) & ")" Wscript.Echo " Found " & RightPad(strTest & ": ", 22) & strPath & " (" & UnixSlashes(strLongPath) & ")" else LogPrint "** " & strTest & ": " & strPath Wscript.Echo " Found " & RightPad(strTest & ": ", 22) & strPath end if end sub '' ' Info message. sub MsgInfo(strMsg) Print "info: " & strMsg end sub '' ' Warning message. sub MsgWarning(strMsg) Print "warning: " & strMsg end sub '' ' Fatal error. sub MsgFatal(strMsg) Print "fatal error: " & strMsg Wscript.Quit(1) end sub '' ' Error message, fatal unless flag to ignore errors is given. sub MsgError(strMsg) Print "error: " & strMsg if g_blnContinueOnError = False then Wscript.Quit(1) end if g_rcScript = 1 end sub '' ' Error message, fatal unless flag to ignore errors is given. ' @note does not return sub MsgSyntaxError(strMsg) Print "syntax error: " & strMsg Wscript.Quit(2) end sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Helpers: Misc ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Translate a kBuild / VBox architecture name to a windows one. function XlateArchitectureToWin(strArch) strArch = LCase(strArch) XlateArchitectureToWin = strArch if strArch = "amd64" then XlateArchitectureToWin = "x64" end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Testcases ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Self test for some of the above routines. ' sub SelfTest dim i, str str = "0123456789" for i = 1 to Len(str) if CharIsDigit(Mid(str, i, 1)) <> True then MsgFatal "SelfTest failed: CharIsDigit("&Mid(str, i, 1)&")" next str = "abcdefghijklmnopqrstuvwxyz~`!@#$%^&*()_+-=ABCDEFGHIJKLMNOPQRSTUVWXYZ/\[]{}" for i = 1 to Len(str) if CharIsDigit(Mid(str, i, 1)) <> False then MsgFatal "SelfTest failed: CharIsDigit("&Mid(str, i, 1)&")" next if StrVersionCompare("1234", "1234") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #1" if StrVersionCompare("1", "1") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #2" if StrVersionCompare("2", "1") <= 0 then MsgFatal "SelfTest failed: StrVersionCompare #3" if StrVersionCompare("1", "2") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #4" if StrVersionCompare("01", "1") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #5" if StrVersionCompare("01", "001") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #6" if StrVersionCompare("12", "123") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #7" if StrVersionCompare("v123", "123") <= 0 then MsgFatal "SelfTest failed: StrVersionCompare #8" if StrVersionCompare("v1.2.3", "v1.3.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #9" if StrVersionCompare("v1.02.3", "v1.3.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #10" if StrVersionCompare("v1.2.3", "v1.03.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #11" if StrVersionCompare("v1.2.4", "v1.23.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #12" if StrVersionCompare("v10.0.17163", "v10.00.18363") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #13" if StrVersionCompare("n 2.15.0", "2.12.0") <= 0 then MsgFatal "SelfTest failed: StrVersionCompare #14" if StrGetFirstWord("1") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #1" if StrGetFirstWord(" 1 ") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #2" if StrGetFirstWord(" 1 2 ") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #3" if StrGetFirstWord("1 2") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #4" if StrGetFirstWord("1234 5") <> "1234" then MsgFatal "SelfTest: StrGetFirstWord #5" if StrGetFirstWord(" ") <> "" then MsgFatal "SelfTest: StrGetFirstWord #6" dim arr arr = ArrayAppend(Array("0", "1"), "2") if ArraySize(arr) <> 3 then MsgFatal "SelfTest: Array #1: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #1: " & ArrayToString(arr) arr = ArrayPrepend(arr, "-1") if ArraySize(arr) <> 4 then MsgFatal "SelfTest: Array #2: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""-1"", ""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #2: " & ArrayToString(arr) ArrayPrepend arr, "-2" if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #3: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""-2"", ""-1"", ""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #3: " & ArrayToString(arr) ArrayRemove arr, 1 if ArraySize(arr) <> 4 then MsgFatal "SelfTest: Array #4: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""-2"", ""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #4: " & ArrayToString(arr) arr = ArrayRemove(arr, 2) if ArraySize(arr) <> 3 then MsgFatal "SelfTest: Array #5: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""-2"", ""0"", ""2"")" then MsgFatal "SelfTest: Array #5: " & ArrayToString(arr) arr = ArrayPrepend(arr, "42") arr = ArrayAppend(arr, "-42") if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #6: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""42"", ""-2"", ""0"", ""2"", ""-42"")" then MsgFatal "SelfTest: Array #6: " & ArrayToString(arr) arr = ArraySortStrings(arr) if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #7: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""-2"", ""-42"", ""0"", ""2"", ""42"")" then MsgFatal "SelfTest: Array #7: " & ArrayToString(arr) arr = ArrayRSortStrings(arr) if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #7: size:" & ArraySize(arr) if ArrayToString(arr) <> "Array(""42"", ""2"", ""0"", ""-42"", ""-2"")" then MsgFatal "SelfTest: Array #8: " & ArrayToString(arr) arr = ArrayVerSortStrings(Array("v10", "v1", "v0")) if ArrayToString(arr) <> "Array(""v0"", ""v1"", ""v10"")" then MsgFatal "SelfTest: Array #9: " & ArrayToString(arr) arr = ArrayRVerSortStrings(arr) if ArrayToString(arr) <> "Array(""v10"", ""v1"", ""v0"")" then MsgFatal "SelfTest: Array #10: " & ArrayToString(arr) if ArrayJoinString(arr, ":") <> "v10:v1:v0" then MsgFatal "SelfTest: Array #11: " & ArrayJoinString(arr, ":") if PathMatch("c:\", "C:\") <> true then MsgFatal "SelfTest: PathMatch #1" if PathMatch("c:\\\winDows/sysTem32", "C:\WindowS\.\\.\System32\.") <> true then MsgFatal "SelfTest: PathMatch #2" if PathMatch("c:\\\winDows/sysTem32", "C:\WindowS\.\\..\System32\.") <> false then MsgFatal "SelfTest: PathMatch #3" if PathMatch("\\x\", "\\\x\") <> false then MsgFatal "SelfTest: PathMatch #4" if PathMatch("\\x\", "\\x\") <> true then MsgFatal "SelfTest: PathMatch #5" if PathMatch("\\", "\\") <> true then MsgFatal "SelfTest: PathMatch #6" if PathMatch("\\x", "\\x") <> true then MsgFatal "SelfTest: PathMatch #7" end sub ' ' Run the self tests if we're executed directly. ' if StrEndsWithI(Wscript.ScriptFullName, "\tools\win\vbscript\helpers.vbs") then Wscript.echo "helpers.vbs: Running self test..." SelfTest Wscript.echo "helpers.vbs: Self test complete." end if