1 | ' $Id: helpers.vbs 106061 2024-09-16 14:03:52Z vboxsync $
|
---|
2 | '' @file
|
---|
3 | ' Common VBScript helpers used by configure.vbs and later others.
|
---|
4 | '
|
---|
5 | ' Requires the script including it to define a LogPrint function.
|
---|
6 | '
|
---|
7 |
|
---|
8 | '
|
---|
9 | ' Copyright (C) 2006-2024 Oracle and/or its affiliates.
|
---|
10 | '
|
---|
11 | ' This file is part of VirtualBox base platform packages, as
|
---|
12 | ' available from https://www.virtualbox.org.
|
---|
13 | '
|
---|
14 | ' This program is free software; you can redistribute it and/or
|
---|
15 | ' modify it under the terms of the GNU General Public License
|
---|
16 | ' as published by the Free Software Foundation, in version 3 of the
|
---|
17 | ' License.
|
---|
18 | '
|
---|
19 | ' This program is distributed in the hope that it will be useful, but
|
---|
20 | ' WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
21 | ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
---|
22 | ' General Public License for more details.
|
---|
23 | '
|
---|
24 | ' You should have received a copy of the GNU General Public License
|
---|
25 | ' along with this program; if not, see <https://www.gnu.org/licenses>.
|
---|
26 | '
|
---|
27 | ' SPDX-License-Identifier: GPL-3.0-only
|
---|
28 | '
|
---|
29 |
|
---|
30 |
|
---|
31 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
32 | ' Global Variables '
|
---|
33 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
34 | dim g_objShell
|
---|
35 | Set g_objShell = WScript.CreateObject("WScript.Shell")
|
---|
36 |
|
---|
37 | dim g_objFileSys
|
---|
38 | Set g_objFileSys = WScript.CreateObject("Scripting.FileSystemObject")
|
---|
39 |
|
---|
40 | '' Whether to ignore (continue) on errors.
|
---|
41 | dim g_blnContinueOnError
|
---|
42 | g_blnContinueOnError = False
|
---|
43 |
|
---|
44 | '' The script's exit code (for ignored errors).
|
---|
45 | dim g_rcScript
|
---|
46 | g_rcScript = 0
|
---|
47 |
|
---|
48 |
|
---|
49 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
50 | ' Helpers: Paths '
|
---|
51 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
52 |
|
---|
53 | ''
|
---|
54 | ' Converts to unix slashes
|
---|
55 | function UnixSlashes(str)
|
---|
56 | UnixSlashes = replace(str, "\", "/")
|
---|
57 | end function
|
---|
58 |
|
---|
59 |
|
---|
60 | ''
|
---|
61 | ' Converts to dos slashes
|
---|
62 | function DosSlashes(str)
|
---|
63 | DosSlashes = replace(str, "/", "\")
|
---|
64 | end function
|
---|
65 |
|
---|
66 |
|
---|
67 | ''
|
---|
68 | ' Get the path of the parent directory. Returns root if root was specified.
|
---|
69 | ' Expects abs path.
|
---|
70 | function PathParent(str)
|
---|
71 | PathParent = g_objFileSys.GetParentFolderName(DosSlashes(str))
|
---|
72 | end function
|
---|
73 |
|
---|
74 |
|
---|
75 | ''
|
---|
76 | ' Strips the filename from at path.
|
---|
77 | function PathStripFilename(str)
|
---|
78 | PathStripFilename = g_objFileSys.GetParentFolderName(DosSlashes(str))
|
---|
79 | end function
|
---|
80 |
|
---|
81 |
|
---|
82 | ''
|
---|
83 | ' Get the abs path, use the short version if necessary.
|
---|
84 | function PathAbs(str)
|
---|
85 | strAbs = g_objFileSys.GetAbsolutePathName(DosSlashes(str))
|
---|
86 | strParent = g_objFileSys.GetParentFolderName(strAbs)
|
---|
87 | if strParent = "" then
|
---|
88 | PathAbs = strAbs
|
---|
89 | else
|
---|
90 | strParent = PathAbs(strParent) ' Recurse to resolve parent paths.
|
---|
91 | PathAbs = g_objFileSys.BuildPath(strParent, g_objFileSys.GetFileName(strAbs))
|
---|
92 |
|
---|
93 | dim obj
|
---|
94 | set obj = Nothing
|
---|
95 | if FileExists(PathAbs) then
|
---|
96 | set obj = g_objFileSys.GetFile(PathAbs)
|
---|
97 | elseif DirExists(PathAbs) then
|
---|
98 | set obj = g_objFileSys.GetFolder(PathAbs)
|
---|
99 | end if
|
---|
100 |
|
---|
101 | if not (obj is nothing) then
|
---|
102 | for each objSub in obj.ParentFolder.SubFolders
|
---|
103 | if obj.Name = objSub.Name or obj.ShortName = objSub.ShortName then
|
---|
104 | if InStr(1, objSub.Name, " ") > 0 _
|
---|
105 | Or InStr(1, objSub.Name, "&") > 0 _
|
---|
106 | Or InStr(1, objSub.Name, "$") > 0 _
|
---|
107 | then
|
---|
108 | PathAbs = g_objFileSys.BuildPath(strParent, objSub.ShortName)
|
---|
109 | if InStr(1, PathAbs, " ") > 0 _
|
---|
110 | Or InStr(1, PathAbs, "&") > 0 _
|
---|
111 | Or InStr(1, PathAbs, "$") > 0 _
|
---|
112 | then
|
---|
113 | MsgFatal "PathAbs(" & str & ") attempted to return filename with problematic " _
|
---|
114 | & "characters in it (" & PathAbs & "). The tool/sdk referenced will probably " _
|
---|
115 | & "need to be copied or reinstalled to a location without 'spaces', '$', ';' " _
|
---|
116 | & "or '&' in the path name. (Unless it's a problem with this script of course...)"
|
---|
117 | end if
|
---|
118 | else
|
---|
119 | PathAbs = g_objFileSys.BuildPath(strParent, objSub.Name)
|
---|
120 | end if
|
---|
121 | exit for
|
---|
122 | end if
|
---|
123 | next
|
---|
124 | end if
|
---|
125 | end if
|
---|
126 | end function
|
---|
127 |
|
---|
128 |
|
---|
129 | ''
|
---|
130 | ' Get the abs path, use the long version.
|
---|
131 | function PathAbsLong(str)
|
---|
132 | strAbs = g_objFileSys.GetAbsolutePathName(DosSlashes(str))
|
---|
133 | strParent = g_objFileSys.GetParentFolderName(strAbs)
|
---|
134 | if strParent = "" then
|
---|
135 | PathAbsLong = strAbs
|
---|
136 | else
|
---|
137 | strParent = PathAbsLong(strParent) ' Recurse to resolve parent paths.
|
---|
138 | PathAbsLong = g_objFileSys.BuildPath(strParent, g_objFileSys.GetFileName(strAbs))
|
---|
139 |
|
---|
140 | dim obj
|
---|
141 | set obj = Nothing
|
---|
142 | if FileExists(PathAbsLong) then
|
---|
143 | set obj = g_objFileSys.GetFile(PathAbsLong)
|
---|
144 | elseif DirExists(PathAbsLong) then
|
---|
145 | set obj = g_objFileSys.GetFolder(PathAbsLong)
|
---|
146 | end if
|
---|
147 |
|
---|
148 | if not (obj is nothing) then
|
---|
149 | for each objSub in obj.ParentFolder.SubFolders
|
---|
150 | if obj.Name = objSub.Name or obj.ShortName = objSub.ShortName then
|
---|
151 | PathAbsLong = g_objFileSys.BuildPath(strParent, objSub.Name)
|
---|
152 | exit for
|
---|
153 | end if
|
---|
154 | next
|
---|
155 | end if
|
---|
156 | end if
|
---|
157 | end function
|
---|
158 |
|
---|
159 |
|
---|
160 | ''
|
---|
161 | ' Compare two paths w/o abspathing them.
|
---|
162 | '
|
---|
163 | ' Ignores case, slash direction, multiple slashes and single dot components.
|
---|
164 | '
|
---|
165 | function PathMatch(strPath1, strPath2)
|
---|
166 | PathMatch = true
|
---|
167 | if StrComp(strPath1, strPath2, vbTextCompare) <> 0 then
|
---|
168 | strPath1 = DosSlashes(strPath1)
|
---|
169 | strPath2 = DosSlashes(strPath2)
|
---|
170 | if StrComp(strPath1, strPath2, vbTextCompare) <> 0 then
|
---|
171 | ' Compare character by character
|
---|
172 | dim off1 : off1 = 1
|
---|
173 | dim off2 : off2 = 1
|
---|
174 |
|
---|
175 | ' Compare UNC prefix if any, because the code below cannot handle it. UNC has exactly two slashes.
|
---|
176 | if Mid(strPath1, 1, 2) = "\\" and Mid(strPath2, 1, 2) = "\\" then
|
---|
177 | if (Mid(strPath1, 3, 1) = "\") <> (Mid(strPath2, 3, 1) = "\") then
|
---|
178 | PathMatch = false
|
---|
179 | exit function
|
---|
180 | end if
|
---|
181 | off1 = off1 + 2
|
---|
182 | off2 = off2 + 2
|
---|
183 | if Mid(strPath1, 3, 1) = "\" then
|
---|
184 | off1 = PathMatchSkipSlashesAndSlashDotHelper(strPath1, off1)
|
---|
185 | off2 = PathMatchSkipSlashesAndSlashDotHelper(strPath2, off2)
|
---|
186 | end if
|
---|
187 | end if
|
---|
188 |
|
---|
189 | ' Compare the rest.
|
---|
190 | dim ch1, ch2
|
---|
191 | do while off1 <= Len(strPath1) and off2 <= Len(strPath2)
|
---|
192 | ch1 = Mid(strPath1, off1, 1)
|
---|
193 | ch2 = Mid(strPath2, off2, 1)
|
---|
194 | if StrComp(ch1, ch2, vbTextCompare) = 0 then
|
---|
195 | off1 = off1 + 1
|
---|
196 | off2 = off2 + 1
|
---|
197 | if ch1 = "\" then
|
---|
198 | off1 = PathMatchSkipSlashesAndSlashDotHelper(strPath1, off1)
|
---|
199 | off2 = PathMatchSkipSlashesAndSlashDotHelper(strPath2, off2)
|
---|
200 | end if
|
---|
201 | else
|
---|
202 | PathMatch = False
|
---|
203 | exit function
|
---|
204 | end if
|
---|
205 | loop
|
---|
206 |
|
---|
207 | ' One or both of the strings ran out. That's fine if we've only got slashes
|
---|
208 | ' and "." components left in the other.
|
---|
209 | if off1 <= Len(strPath1) and Mid(strPath1, off1, 1) = "\" then
|
---|
210 | off1 = PathMatchSkipSlashesAndSlashDotHelper(strPath1, off1 + 1)
|
---|
211 | end if
|
---|
212 | if off2 <= Len(strPath2) and Mid(strPath2, off2, 1) = "\" then
|
---|
213 | off2 = PathMatchSkipSlashesAndSlashDotHelper(strPath2, off2 + 1)
|
---|
214 | end if
|
---|
215 | PathMatch = off1 > Len(strPath1) and off2 > Len(strPath2)
|
---|
216 | end if
|
---|
217 | end if
|
---|
218 | end function
|
---|
219 |
|
---|
220 | '' PathMatch helper
|
---|
221 | function PathMatchSkipSlashesAndSlashDotHelper(strPath, off)
|
---|
222 | dim ch
|
---|
223 | do while off <= Len(strPath)
|
---|
224 | ch = Mid(strPath, off, 1)
|
---|
225 | if ch = "\" then
|
---|
226 | off = off + 1
|
---|
227 | elseif ch = "." and off = Len(strPath) then
|
---|
228 | off = off + 1
|
---|
229 | elseif ch = "." and Mid(strPath, off, 2) = ".\" then
|
---|
230 | off = off + 2
|
---|
231 | else
|
---|
232 | exit do
|
---|
233 | end if
|
---|
234 | loop
|
---|
235 | PathMatchSkipSlashesAndSlashDotHelper = off
|
---|
236 | end function
|
---|
237 |
|
---|
238 |
|
---|
239 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
240 | ' Helpers: Files and Dirs '
|
---|
241 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
242 |
|
---|
243 | ''
|
---|
244 | ' Read a file (typically the tmp file) into a string.
|
---|
245 | function FileToString(strFilename)
|
---|
246 | const ForReading = 1, TristateFalse = 0
|
---|
247 | dim objLogFile, str
|
---|
248 |
|
---|
249 | set objFile = g_objFileSys.OpenTextFile(DosSlashes(strFilename), ForReading, False, TristateFalse)
|
---|
250 | str = objFile.ReadAll()
|
---|
251 | objFile.Close()
|
---|
252 |
|
---|
253 | FileToString = str
|
---|
254 | end function
|
---|
255 |
|
---|
256 |
|
---|
257 | ''
|
---|
258 | ' Deletes a file
|
---|
259 | sub FileDelete(strFilename)
|
---|
260 | if g_objFileSys.FileExists(DosSlashes(strFilename)) then
|
---|
261 | g_objFileSys.DeleteFile(DosSlashes(strFilename))
|
---|
262 | end if
|
---|
263 | end sub
|
---|
264 |
|
---|
265 |
|
---|
266 | ''
|
---|
267 | ' Appends a line to an ascii file.
|
---|
268 | sub FileAppendLine(strFilename, str)
|
---|
269 | const ForAppending = 8, TristateFalse = 0
|
---|
270 | dim objFile
|
---|
271 |
|
---|
272 | set objFile = g_objFileSys.OpenTextFile(DosSlashes(strFilename), ForAppending, True, TristateFalse)
|
---|
273 | objFile.WriteLine(str)
|
---|
274 | objFile.Close()
|
---|
275 | end sub
|
---|
276 |
|
---|
277 |
|
---|
278 | ''
|
---|
279 | ' Checks if the file exists.
|
---|
280 | function FileExists(strFilename)
|
---|
281 | FileExists = g_objFileSys.FileExists(DosSlashes(strFilename))
|
---|
282 | DbgPrint "FileExists(" & strFilename & ") -> " & FileExists
|
---|
283 | end function
|
---|
284 |
|
---|
285 |
|
---|
286 | ''
|
---|
287 | ' Checks if the directory exists.
|
---|
288 | function DirExists(strDirectory)
|
---|
289 | DirExists = g_objFileSys.FolderExists(DosSlashes(strDirectory))
|
---|
290 | DbgPrint "DirExists(" & strDirectory & ") -> " & DirExists
|
---|
291 | end function
|
---|
292 |
|
---|
293 |
|
---|
294 | ''
|
---|
295 | ' Returns true if there are subfolders starting with the given string.
|
---|
296 | function HasSubdirsStartingWith(strFolder, strStartingWith)
|
---|
297 | HasSubdirsStartingWith = False
|
---|
298 | if DirExists(strFolder) then
|
---|
299 | dim obj
|
---|
300 | set obj = g_objFileSys.GetFolder(strFolder)
|
---|
301 | for each objSub in obj.SubFolders
|
---|
302 | if StrComp(Left(objSub.Name, Len(strStartingWith)), strStartingWith) = 0 then
|
---|
303 | HasSubdirsStartingWith = True
|
---|
304 | LogPrint "# HasSubdirsStartingWith(" & strFolder & "," & strStartingWith & ") found " & objSub.Name
|
---|
305 | exit for
|
---|
306 | end if
|
---|
307 | next
|
---|
308 | end if
|
---|
309 | end function
|
---|
310 |
|
---|
311 |
|
---|
312 | ''
|
---|
313 | ' Returns a sorted array of subfolder names that starts with the given string.
|
---|
314 | function GetSubdirsStartingWith(strFolder, strStartingWith)
|
---|
315 | if DirExists(strFolder) then
|
---|
316 | dim obj, i
|
---|
317 | set obj = g_objFileSys.GetFolder(strFolder)
|
---|
318 | i = 0
|
---|
319 | for each objSub in obj.SubFolders
|
---|
320 | if StrComp(Left(objSub.Name, Len(strStartingWith)), strStartingWith) = 0 then
|
---|
321 | i = i + 1
|
---|
322 | end if
|
---|
323 | next
|
---|
324 | if i > 0 then
|
---|
325 | redim arrResult(i - 1)
|
---|
326 | i = 0
|
---|
327 | for each objSub in obj.SubFolders
|
---|
328 | if StrComp(Left(objSub.Name, Len(strStartingWith)), strStartingWith) = 0 then
|
---|
329 | arrResult(i) = objSub.Name
|
---|
330 | i = i + 1
|
---|
331 | end if
|
---|
332 | next
|
---|
333 | GetSubdirsStartingWith = arrResult
|
---|
334 | else
|
---|
335 | GetSubdirsStartingWith = Array()
|
---|
336 | end if
|
---|
337 | else
|
---|
338 | GetSubdirsStartingWith = Array()
|
---|
339 | end if
|
---|
340 | end function
|
---|
341 |
|
---|
342 |
|
---|
343 | ''
|
---|
344 | ' Returns a sorted array of subfolder names that starts with the given string.
|
---|
345 | function GetSubdirsStartingWithVerSorted(strFolder, strStartingWith)
|
---|
346 | GetSubdirsStartingWithVerSorted = ArrayVerSortStrings(GetSubdirsStartingWith(strFolder, strStartingWith))
|
---|
347 | end function
|
---|
348 |
|
---|
349 |
|
---|
350 | ''
|
---|
351 | ' Returns a reverse version sorted array of subfolder names that starts with the given string.
|
---|
352 | function GetSubdirsStartingWithRVerSorted(strFolder, strStartingWith)
|
---|
353 | GetSubdirsStartingWithRVerSorted = ArrayRVerSortStrings(GetSubdirsStartingWith(strFolder, strStartingWith))
|
---|
354 | end function
|
---|
355 |
|
---|
356 |
|
---|
357 | ''
|
---|
358 | ' Try find the specified file in the specified path variable.
|
---|
359 | function WhichEx(strEnvVar, strFile)
|
---|
360 | dim strPath, iStart, iEnd, str
|
---|
361 |
|
---|
362 | ' the path
|
---|
363 | strPath = EnvGet(strEnvVar)
|
---|
364 | iStart = 1
|
---|
365 | do while iStart <= Len(strPath)
|
---|
366 | iEnd = InStr(iStart, strPath, ";")
|
---|
367 | if iEnd <= 0 then iEnd = Len(strPath) + 1
|
---|
368 | if iEnd > iStart then
|
---|
369 | str = Mid(strPath, iStart, iEnd - iStart) & "/" & strFile
|
---|
370 | if FileExists(str) then
|
---|
371 | WhichEx = str
|
---|
372 | exit function
|
---|
373 | end if
|
---|
374 | end if
|
---|
375 | iStart = iEnd + 1
|
---|
376 | loop
|
---|
377 |
|
---|
378 | ' registry or somewhere?
|
---|
379 |
|
---|
380 | WhichEx = ""
|
---|
381 | end function
|
---|
382 |
|
---|
383 |
|
---|
384 | ''
|
---|
385 | ' Try find the specified file in the path.
|
---|
386 | function Which(strFile)
|
---|
387 | Which = WhichEx("Path", strFile)
|
---|
388 | end function
|
---|
389 |
|
---|
390 |
|
---|
391 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
392 | ' Helpers: Processes '
|
---|
393 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
394 |
|
---|
395 | ''
|
---|
396 | ' Checks if this is a WOW64 process.
|
---|
397 | function IsWow64()
|
---|
398 | if g_objShell.Environment("PROCESS")("PROCESSOR_ARCHITEW6432") <> "" then
|
---|
399 | IsWow64 = 1
|
---|
400 | else
|
---|
401 | IsWow64 = 0
|
---|
402 | end if
|
---|
403 | end function
|
---|
404 |
|
---|
405 |
|
---|
406 | ''
|
---|
407 | ' Executes a command in the shell catching output in strOutput
|
---|
408 | function Shell(strCommand, blnBoth, ByRef strOutput)
|
---|
409 | dim strShell, strCmdline, objExec, str
|
---|
410 |
|
---|
411 | strShell = g_objShell.ExpandEnvironmentStrings("%ComSpec%")
|
---|
412 | if blnBoth = true then
|
---|
413 | strCmdline = strShell & " /c " & strCommand & " 2>&1"
|
---|
414 | else
|
---|
415 | strCmdline = strShell & " /c " & strCommand & " 2>nul"
|
---|
416 | end if
|
---|
417 |
|
---|
418 | LogPrint "# Shell: " & strCmdline
|
---|
419 | Set objExec = g_objShell.Exec(strCmdLine)
|
---|
420 | strOutput = objExec.StdOut.ReadAll()
|
---|
421 | objExec.StdErr.ReadAll()
|
---|
422 | do while objExec.Status = 0
|
---|
423 | Wscript.Sleep 20
|
---|
424 | strOutput = strOutput & objExec.StdOut.ReadAll()
|
---|
425 | objExec.StdErr.ReadAll()
|
---|
426 | loop
|
---|
427 |
|
---|
428 | LogPrint "# Status: " & objExec.ExitCode
|
---|
429 | LogPrint "# Start of Output"
|
---|
430 | LogPrint strOutput
|
---|
431 | LogPrint "# End of Output"
|
---|
432 |
|
---|
433 | Shell = objExec.ExitCode
|
---|
434 | end function
|
---|
435 |
|
---|
436 |
|
---|
437 | ''
|
---|
438 | ' Gets the SID of the current user.
|
---|
439 | function GetSid()
|
---|
440 | dim objNet, strUser, strDomain, offSlash, objWmiUser
|
---|
441 | GetSid = ""
|
---|
442 |
|
---|
443 | ' Figure the user + domain
|
---|
444 | set objNet = CreateObject("WScript.Network")
|
---|
445 | strUser = objNet.UserName
|
---|
446 | strDomain = objNet.UserDomain
|
---|
447 | offSlash = InStr(1, strUser, "\")
|
---|
448 | if offSlash > 0 then
|
---|
449 | strDomain = Left(strUser, offSlash - 1)
|
---|
450 | strUser = Right(strUser, Len(strUser) - offSlash)
|
---|
451 | end if
|
---|
452 |
|
---|
453 | ' Lookup the user.
|
---|
454 | on error resume next
|
---|
455 | set objWmiUser = GetObject("winmgmts:{impersonationlevel=impersonate}!/root/cimv2:Win32_UserAccount." _
|
---|
456 | & "Domain='" & strDomain &"',Name='" & strUser & "'")
|
---|
457 | if err.number = 0 then
|
---|
458 | GetSid = objWmiUser.SID
|
---|
459 | end if
|
---|
460 | end function
|
---|
461 |
|
---|
462 |
|
---|
463 | ''
|
---|
464 | ' Gets the commandline used to invoke the script.
|
---|
465 | function GetCommandline()
|
---|
466 | dim str, i
|
---|
467 |
|
---|
468 | '' @todo find an api for querying it instead of reconstructing it like this...
|
---|
469 | GetCommandline = "cscript configure.vbs"
|
---|
470 | for i = 1 to WScript.Arguments.Count
|
---|
471 | str = WScript.Arguments.Item(i - 1)
|
---|
472 | if str = "" then
|
---|
473 | str = """"""
|
---|
474 | elseif (InStr(1, str, " ")) then
|
---|
475 | str = """" & str & """"
|
---|
476 | end if
|
---|
477 | GetCommandline = GetCommandline & " " & str
|
---|
478 | next
|
---|
479 | end function
|
---|
480 |
|
---|
481 |
|
---|
482 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
483 | ' Helpers: Environment '
|
---|
484 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
485 |
|
---|
486 | ''
|
---|
487 | ' Gets an environment variable.
|
---|
488 | function EnvGet(strName)
|
---|
489 | EnvGet = g_objShell.Environment("PROCESS")(strName)
|
---|
490 | end function
|
---|
491 |
|
---|
492 |
|
---|
493 | ''
|
---|
494 | ' Gets an environment variable with default value if not found.
|
---|
495 | function EnvGetDef(strName, strDefault)
|
---|
496 | dim strValue
|
---|
497 | strValue = g_objShell.Environment("PROCESS")(strName)
|
---|
498 | if strValue = "" or IsNull(strValue) or IsEmpty(strValue) then
|
---|
499 | EnvGetDef = strDefault
|
---|
500 | else
|
---|
501 | EnvGetDef = strValue
|
---|
502 | end if
|
---|
503 | end function
|
---|
504 |
|
---|
505 |
|
---|
506 | ''
|
---|
507 | ' Gets an environment variable with default value if not found or not
|
---|
508 | ' in the array of valid values. Issue warning about invalid values.
|
---|
509 | function EnvGetDefValid(strName, strDefault, arrValidValues)
|
---|
510 | dim strValue
|
---|
511 | strValue = g_objShell.Environment("PROCESS")(strName)
|
---|
512 | if strValue = "" or IsNull(strValue) or IsEmpty(strValue) then
|
---|
513 | EnvGetDefValid = strDefault
|
---|
514 | elseif not ArrayContainsString(arrValidValues, strValue) then
|
---|
515 | MsgWarning "Invalid value " & strName & " value '" & EnvGetDefValid & "', using '" & strDefault & "' instead."
|
---|
516 | EnvGetDefValid = strDefault
|
---|
517 | else
|
---|
518 | EnvGetDefValid = strValue
|
---|
519 | end if
|
---|
520 | end function
|
---|
521 |
|
---|
522 |
|
---|
523 | ''
|
---|
524 | ' Sets an environment variable.
|
---|
525 | sub EnvSet(strName, strValue)
|
---|
526 | g_objShell.Environment("PROCESS")(strName) = strValue
|
---|
527 | LogPrint "EnvSet: " & strName & "=" & strValue
|
---|
528 | end sub
|
---|
529 |
|
---|
530 |
|
---|
531 | ''
|
---|
532 | ' Prepends a string to an Path-like environment variable.
|
---|
533 | function EnvPrependItemEx(strName, strItem, strSep, blnKeepEmpty, ByRef fnItemMatcher)
|
---|
534 | dim strValue
|
---|
535 | strValue = EnvRemoveItemEx(strName, strItem, strSep, blnKeepEmpty, fnItemMatcher, "EnvPrependItemEx")
|
---|
536 | if strValue <> "" then
|
---|
537 | strValue = strItem & strSep & strValue
|
---|
538 | else
|
---|
539 | strValue = strItem
|
---|
540 | end if
|
---|
541 | g_objShell.Environment("PROCESS")(strName) = strValue
|
---|
542 | EnvPrependItemEx = strValue
|
---|
543 | end function
|
---|
544 |
|
---|
545 |
|
---|
546 | ''
|
---|
547 | ' Appends a string to an Path-like environment variable,
|
---|
548 | function EnvAppendItemEx(strName, strItem, strSep, blnKeepEmpty, ByRef fnItemMatcher)
|
---|
549 | dim strValue
|
---|
550 | strValue = EnvRemoveItemEx(strName, strItem, strSep, blnKeepEmpty, fnItemMatcher, "EnvAppendItemEx")
|
---|
551 | if strValue <> "" then
|
---|
552 | strValue = strValue & strSep & strItem
|
---|
553 | else
|
---|
554 | strValue = strItem
|
---|
555 | end if
|
---|
556 | g_objShell.Environment("PROCESS")(strName) = strValue
|
---|
557 | EnvAppendItemEx = strValue
|
---|
558 | end function
|
---|
559 |
|
---|
560 |
|
---|
561 | ''
|
---|
562 | ' Generic item remover.
|
---|
563 | '
|
---|
564 | ' fnItemMatcher(strItem1, strItem2)
|
---|
565 | '
|
---|
566 | function EnvRemoveItemEx(strName, strItem, strSep, blnKeepEmpty, ByRef fnItemMatcher, strCaller)
|
---|
567 | dim strValue, off
|
---|
568 | strValue = g_objShell.Environment("PROCESS")(strName)
|
---|
569 | EnvRemoveItemEx = strValue
|
---|
570 | if strValue <> "" then
|
---|
571 | ' Split it up into an array of items
|
---|
572 | dim arrItems : arrItems = Split(strValue, strSep, -1, vbTextCompare)
|
---|
573 |
|
---|
574 | ' Create an array of matching indexes that we should remove.
|
---|
575 | dim cntToRemove : cntToRemove = 0
|
---|
576 | redim arrIdxToRemove(ArraySize(arrItems) - 1)
|
---|
577 | dim i, strCur
|
---|
578 | for i = LBound(arrItems) to UBound(arrItems)
|
---|
579 | strCur = arrItems(i)
|
---|
580 | if fnItemMatcher(strCur, strItem) or (not blnKeepEmpty and strCur = "") then
|
---|
581 | arrIdxToRemove(cntToRemove) = i
|
---|
582 | cntToRemove = cntToRemove + 1
|
---|
583 | end if
|
---|
584 | next
|
---|
585 |
|
---|
586 | ' Did we find anthing to remove?
|
---|
587 | if cntToRemove > 0 then
|
---|
588 | ' Update the array and join it up again.
|
---|
589 | for i = cntToRemove - 1 to 0 step -1
|
---|
590 | arrItems = ArrayRemove(arrItems, arrIdxToRemove(i))
|
---|
591 | next
|
---|
592 | dim strNewValue : strNewValue = ArrayJoinString(arrItems, strSep)
|
---|
593 | EnvRemoveItemEx = strNewValue
|
---|
594 |
|
---|
595 | ' Update the environment variable.
|
---|
596 | LogPrint strCaller &": " & strName & ": '" & strValue & "' --> '" & strNewValue & "'"
|
---|
597 | g_objShell.Environment("PROCESS")(strName) = strNewValue
|
---|
598 | end if
|
---|
599 | end if
|
---|
600 | end function
|
---|
601 |
|
---|
602 |
|
---|
603 | ''
|
---|
604 | ' Generic case-insensitive item matcher.
|
---|
605 | ' See also PathMatch().
|
---|
606 | function EnvItemMatch(strItem1, strItem2)
|
---|
607 | EnvItemMatch = (StrComp(strItem1, strItem2) = 0)
|
---|
608 | end function
|
---|
609 |
|
---|
610 |
|
---|
611 | ''
|
---|
612 | ' Prepends an item to an environment variable, after first removing any
|
---|
613 | ' existing ones (case-insensitive, preserves empty elements).
|
---|
614 | function EnvPrependItem(strName, strItem, strSep)
|
---|
615 | EnvPrependItem = EnvPrependItemEx(strName, strItem, strSep, true, GetRef("EnvItemMatch"))
|
---|
616 | LogPrint "EnvPrependItem: " & strName & "=" & EnvPrependPathItem
|
---|
617 | end function
|
---|
618 |
|
---|
619 |
|
---|
620 | ''
|
---|
621 | ' Appends an item to an environment variable, after first removing any
|
---|
622 | ' existing ones (case-insensitive, preserves empty elements).
|
---|
623 | function EnvAppendItem(strName, strItem, strSep)
|
---|
624 | EnvAppendItem = EnvAppendItemEx(strName, strItem, strSep, true, GetRef("EnvItemMatch"))
|
---|
625 | LogPrint "EnvAppendItem: " & strName & "=" & EnvPrependPathItem
|
---|
626 | end function
|
---|
627 |
|
---|
628 |
|
---|
629 | ''
|
---|
630 | ' Removes a string element from an environment variable, case
|
---|
631 | ' insensitive but preserving empty elements.
|
---|
632 | function EnvRemoveItem(strName, strItem, strSep)
|
---|
633 | EnvRemoveItem = EnvRemoveItemEx(strName, strIten, strSep, true, GetRef("EnvItemMatch"), "EnvRemoveItem")
|
---|
634 | end function
|
---|
635 |
|
---|
636 |
|
---|
637 | ''
|
---|
638 | ' Appends a string to an Path-like environment variable,
|
---|
639 | function EnvPrependPathItem(strName, strItem, strSep)
|
---|
640 | EnvPrependPathItem = EnvPrependItemEx(strName, strItem, strSep, false, GetRef("PathMatch"))
|
---|
641 | LogPrint "EnvPrependPathItem: " & strName & "=" & EnvPrependPathItem
|
---|
642 | end function
|
---|
643 |
|
---|
644 |
|
---|
645 | ''
|
---|
646 | ' Appends a string to an Path-like environment variable,
|
---|
647 | function EnvAppendPathItem(strName, strItem, strSep)
|
---|
648 | EnvAppendPathItem = EnvAppendItemEx(strName, strItem, strSep, false, GetRef("PathMatch"))
|
---|
649 | LogPrint "EnvAppendPathItem: " & strName & "=" & EnvAppendPathItem
|
---|
650 | end function
|
---|
651 |
|
---|
652 |
|
---|
653 | ''
|
---|
654 | ' Removes a string element from an Path-like environment variable, case
|
---|
655 | ' insensitive and treating forward and backward slashes the same way.
|
---|
656 | function EnvRemovePathItem(strName, strItem, strSep)
|
---|
657 | EnvRemovePathItem = EnvRemoveItemEx(strName, strIten, strSep, false, GetRef("PathMatch"), "EnvRemovePathItem")
|
---|
658 | end function
|
---|
659 |
|
---|
660 |
|
---|
661 | ''
|
---|
662 | ' Prepends a string to an environment variable
|
---|
663 | sub EnvUnset(strName)
|
---|
664 | g_objShell.Environment("PROCESS").Remove(strName)
|
---|
665 | LogPrint "EnvUnset: " & strName
|
---|
666 | end sub
|
---|
667 |
|
---|
668 |
|
---|
669 | ''
|
---|
670 | ' Gets the first non-empty environment variable of the given two.
|
---|
671 | function EnvGetFirst(strName1, strName2)
|
---|
672 | EnvGetFirst = g_objShell.Environment("PROCESS")(strName1)
|
---|
673 | if EnvGetFirst = "" then
|
---|
674 | EnvGetFirst = g_objShell.Environment("PROCESS")(strName2)
|
---|
675 | end if
|
---|
676 | end function
|
---|
677 |
|
---|
678 | ''
|
---|
679 | ' Checks if the given enviornment variable exists.
|
---|
680 | function EnvExists(strName)
|
---|
681 | EnvExists = g_objShell.Environment("PROCESS")(strName) <> ""
|
---|
682 | end function
|
---|
683 |
|
---|
684 |
|
---|
685 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
686 | ' Helpers: Strings '
|
---|
687 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
688 |
|
---|
689 | ''
|
---|
690 | ' Right pads a string with spaces to the given length
|
---|
691 | function RightPad(str, cch)
|
---|
692 | if Len(str) < cch then
|
---|
693 | RightPad = str & String(cch - Len(str), " ")
|
---|
694 | else
|
---|
695 | RightPad = str
|
---|
696 | end if
|
---|
697 | end function
|
---|
698 |
|
---|
699 |
|
---|
700 | ''
|
---|
701 | ' Checks if the given character is a decimal digit
|
---|
702 | function CharIsDigit(ch)
|
---|
703 | CharIsDigit = (InStr(1, "0123456789", ch) > 0)
|
---|
704 | end function
|
---|
705 |
|
---|
706 | ''
|
---|
707 | ' Worker for StrVersionCompare
|
---|
708 | ' The offset is updated to point to the first non-digit character.
|
---|
709 | function CountDigitsIgnoreLeadingZeros(ByRef str, ByRef off)
|
---|
710 | dim cntDigits, blnLeadingZeros, ch, offInt
|
---|
711 | cntDigits = 0
|
---|
712 | if CharIsDigit(Mid(str, off, 1)) then
|
---|
713 | ' Rewind to start of digest sequence.
|
---|
714 | do while off > 1
|
---|
715 | if not CharIsDigit(Mid(str, off - 1, 1)) then exit do
|
---|
716 | off = off - 1
|
---|
717 | loop
|
---|
718 | ' Count digits, ignoring leading zeros.
|
---|
719 | blnLeadingZeros = True
|
---|
720 | for off = off to Len(str)
|
---|
721 | ch = Mid(str, off, 1)
|
---|
722 | if CharIsDigit(ch) then
|
---|
723 | if ch <> "0" or blnLeadingZeros = False then
|
---|
724 | cntDigits = cntDigits + 1
|
---|
725 | blnLeadingZeros = False
|
---|
726 | end if
|
---|
727 | else
|
---|
728 | exit for
|
---|
729 | end if
|
---|
730 | next
|
---|
731 | ' If all zeros, count one of them.
|
---|
732 | if cntDigits = 0 then cntDigits = 1
|
---|
733 | end if
|
---|
734 | CountDigitsIgnoreLeadingZeros = cntDigits
|
---|
735 | end function
|
---|
736 |
|
---|
737 | ''
|
---|
738 | ' Very simple version string compare function.
|
---|
739 | ' @returns < 0 if str1 is smaller than str2
|
---|
740 | ' @returns 0 if str1 and str2 are equal
|
---|
741 | ' @returns > 1 if str2 is larger than str1
|
---|
742 | function StrVersionCompare(str1, str2)
|
---|
743 | ' Compare the strings. We can rely on StrComp if equal or one is empty.
|
---|
744 | 'LogPrint "StrVersionCompare("&str1&","&str2&"):"
|
---|
745 | StrVersionCompare = StrComp(str2, str1)
|
---|
746 | if StrVersionCompare <> 0 then
|
---|
747 | dim cch1, cch2, off1, off2, ch1, ch2, chPrev1, chPrev2, intDiff, cchDigits
|
---|
748 | cch1 = Len(str1)
|
---|
749 | cch2 = Len(str2)
|
---|
750 | if cch1 > 0 and cch2 > 0 then
|
---|
751 | ' Compare the common portion
|
---|
752 | off1 = 1
|
---|
753 | off2 = 1
|
---|
754 | chPrev1 = "x"
|
---|
755 | chPrev2 = "x"
|
---|
756 | do while off1 <= cch1 and off2 <= cch2
|
---|
757 | ch1 = Mid(str1, off1, 1)
|
---|
758 | ch2 = Mid(str2, off2, 1)
|
---|
759 | if ch1 = ch2 then
|
---|
760 | off1 = off1 + 1
|
---|
761 | off2 = off2 + 1
|
---|
762 | chPrev1 = ch1
|
---|
763 | chPrev2 = ch2
|
---|
764 | else
|
---|
765 | ' Is there a digest sequence in play. This includes the scenario where one of the
|
---|
766 | ' string ran out of digests.
|
---|
767 | dim blnDigest1 : blnDigest1 = CharIsDigit(ch1)
|
---|
768 | dim blnDigest2 : blnDigest2 = CharIsDigit(ch2)
|
---|
769 | if (blnDigest1 = True or blnDigest2 = True) _
|
---|
770 | and (blnDigest1 = True or CharIsDigit(chPrev1) = True) _
|
---|
771 | and (blnDigest2 = True or CharIsDigit(chPrev2) = True) _
|
---|
772 | then
|
---|
773 | 'LogPrint "StrVersionCompare: off1="&off1&" off2="&off2&" ch1="&ch1&" chPrev1="&chPrev1&" ch2="&ch2&" chPrev2="&chPrev2
|
---|
774 | if blnDigest1 = False then off1 = off1 - 1
|
---|
775 | if blnDigest2 = False then off2 = off2 - 1
|
---|
776 | ' The one with the fewer digits comes first.
|
---|
777 | ' Note! off1 and off2 are adjusted to next non-digit character in the strings.
|
---|
778 | cchDigits = CountDigitsIgnoreLeadingZeros(str1, off1)
|
---|
779 | intDiff = cchDigits - CountDigitsIgnoreLeadingZeros(str2, off2)
|
---|
780 | 'LogPrint "StrVersionCompare: off1="&off1&" off2="&off2&" cchDigits="&cchDigits
|
---|
781 | if intDiff <> 0 then
|
---|
782 | StrVersionCompare = intDiff
|
---|
783 | 'LogPrint "StrVersionCompare: --> "&intDiff&" #1"
|
---|
784 | exit function
|
---|
785 | end if
|
---|
786 |
|
---|
787 | ' If the same number of digits, the smaller digit wins. However, because of
|
---|
788 | ' potential leading zeros, we must redo the compare. Assume ASCII-like stuff
|
---|
789 | ' and we can use StrComp for this.
|
---|
790 | intDiff = StrComp(Mid(str1, off1 - cchDigits, cchDigits), Mid(str2, off2 - cchDigits, cchDigits))
|
---|
791 | if intDiff <> 0 then
|
---|
792 | StrVersionCompare = intDiff
|
---|
793 | 'LogPrint "StrVersionCompare: --> "&intDiff&" #2"
|
---|
794 | exit function
|
---|
795 | end if
|
---|
796 | chPrev1 = "x"
|
---|
797 | chPrev2 = "x"
|
---|
798 | else
|
---|
799 | if blnDigest1 then
|
---|
800 | StrVersionCompare = -1 ' Digits before characters
|
---|
801 | 'LogPrint "StrVersionCompare: --> -1 (#3)"
|
---|
802 | elseif blnDigest2 then
|
---|
803 | StrVersionCompare = 1 ' Digits before characters
|
---|
804 | 'LogPrint "StrVersionCompare: --> 1 (#4)"
|
---|
805 | else
|
---|
806 | StrVersionCompare = StrComp(ch1, ch2)
|
---|
807 | 'LogPrint "StrVersionCompare: --> "&StrVersionCompare&" (#5)"
|
---|
808 | end if
|
---|
809 | exit function
|
---|
810 | end if
|
---|
811 | end if
|
---|
812 | loop
|
---|
813 |
|
---|
814 | ' The common part matches up, so the shorter string 'wins'.
|
---|
815 | StrVersionCompare = (cch1 - off1) - (cch2 - off2)
|
---|
816 | end if
|
---|
817 | end if
|
---|
818 | 'LogPrint "StrVersionCompare: --> "&StrVersionCompare&" (#6)"
|
---|
819 | end function
|
---|
820 |
|
---|
821 |
|
---|
822 | ''
|
---|
823 | ' Returns the first list of the given string.
|
---|
824 | function StrGetFirstLine(str)
|
---|
825 | dim off
|
---|
826 | off = InStr(1, str, Chr(10))
|
---|
827 | if off <= 0 then off = InStr(1, str, Chr(13))
|
---|
828 | if off > 0 then
|
---|
829 | StrGetFirstLine = Mid(str, 1, off)
|
---|
830 | else
|
---|
831 | StrGetFirstLine = str
|
---|
832 | end if
|
---|
833 | end function
|
---|
834 |
|
---|
835 |
|
---|
836 | ''
|
---|
837 | ' Returns the first word in the given string.
|
---|
838 | '
|
---|
839 | ' Only recognizes space, tab, newline and carriage return as word separators.
|
---|
840 | '
|
---|
841 | function StrGetFirstWord(str)
|
---|
842 | dim strSep, offWord, offEnd, offEnd2, strSeparators
|
---|
843 | strSeparators = " " & Chr(9) & Chr(10) & Chr(13)
|
---|
844 |
|
---|
845 | ' Skip leading separators.
|
---|
846 | for offWord = 1 to Len(str)
|
---|
847 | if InStr(1, strSeparators, Mid(str, offWord, 1)) < 1 then exit for
|
---|
848 | next
|
---|
849 |
|
---|
850 | ' Find the end.
|
---|
851 | offEnd = Len(str) + 1
|
---|
852 | for offSep = 1 to Len(strSeparators)
|
---|
853 | offEnd2 = InStr(offWord, str, Mid(strSeparators, offSep, 1))
|
---|
854 | if offEnd2 > 0 and offEnd2 < offEnd then offEnd = offEnd2
|
---|
855 | next
|
---|
856 |
|
---|
857 | StrGetFirstWord = Mid(str, offWord, offEnd - offWord)
|
---|
858 | end function
|
---|
859 |
|
---|
860 |
|
---|
861 | ''
|
---|
862 | ' Checks if the string starts with the given prefix (case sensitive).
|
---|
863 | function StrStartsWith(str, strPrefix)
|
---|
864 | if len(str) >= Len(strPrefix) then
|
---|
865 | StrStartsWith = (StrComp(Left(str, Len(strPrefix)), strPrefix, vbBinaryCompare) = 0)
|
---|
866 | else
|
---|
867 | StrStartsWith = false
|
---|
868 | end if
|
---|
869 | end function
|
---|
870 |
|
---|
871 |
|
---|
872 | ''
|
---|
873 | ' Checks if the string starts with the given prefix, case insenstive edition.
|
---|
874 | function StrStartsWithI(str, strPrefix)
|
---|
875 | if len(str) >= Len(strPrefix) then
|
---|
876 | StrStartsWithI = (StrComp(Left(str, Len(strPrefix)), strPrefix, vbTextCompare) = 0)
|
---|
877 | else
|
---|
878 | StrStartsWithI = false
|
---|
879 | end if
|
---|
880 | end function
|
---|
881 |
|
---|
882 |
|
---|
883 | ''
|
---|
884 | ' Checks if the string ends with the given suffix (case sensitive).
|
---|
885 | function StrEndsWith(str, strSuffix)
|
---|
886 | if len(str) >= Len(strSuffix) then
|
---|
887 | StrEndsWith = (StrComp(Right(str, Len(strSuffix)), strSuffix, vbBinaryCompare) = 0)
|
---|
888 | else
|
---|
889 | StrEndsWith = false
|
---|
890 | end if
|
---|
891 | end function
|
---|
892 |
|
---|
893 |
|
---|
894 | ''
|
---|
895 | ' Checks if the string ends with the given suffix, case insenstive edition.
|
---|
896 | function StrEndsWithI(str, strSuffix)
|
---|
897 | if len(str) >= Len(strSuffix) then
|
---|
898 | StrEndsWithI = (StrComp(Right(str, Len(strSuffix)), strSuffix, vbTextCompare) = 0)
|
---|
899 | else
|
---|
900 | StrEndsWithI = false
|
---|
901 | end if
|
---|
902 | end function
|
---|
903 |
|
---|
904 |
|
---|
905 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
906 | ' Helpers: Arrays '
|
---|
907 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
908 |
|
---|
909 | ''
|
---|
910 | ' Returns a reverse array (copy).
|
---|
911 | function ArrayReverse(arr)
|
---|
912 | dim cnt, i, j, iHalf, objTmp
|
---|
913 | cnt = UBound(arr) - LBound(arr) + 1
|
---|
914 | if cnt > 0 then
|
---|
915 | j = UBound(arr)
|
---|
916 | iHalf = Fix(LBound(arr) + cnt / 2)
|
---|
917 | for i = LBound(arr) to iHalf - 1
|
---|
918 | objTmp = arr(i)
|
---|
919 | arr(i) = arr(j)
|
---|
920 | arr(j) = objTmp
|
---|
921 | j = j - 1
|
---|
922 | next
|
---|
923 | end if
|
---|
924 | ArrayReverse = arr
|
---|
925 | end function
|
---|
926 |
|
---|
927 |
|
---|
928 | ''
|
---|
929 | ' Returns a reverse sorted array (strings).
|
---|
930 | function ArraySortStringsEx(arrStrings, ByRef fnCompare)
|
---|
931 | dim str1, str2, i, j
|
---|
932 | for i = LBound(arrStrings) to UBound(arrStrings)
|
---|
933 | str1 = arrStrings(i)
|
---|
934 | for j = i + 1 to UBound(arrStrings)
|
---|
935 | str2 = arrStrings(j)
|
---|
936 | if fnCompare(str2, str1) < 0 then
|
---|
937 | arrStrings(j) = str1
|
---|
938 | str1 = str2
|
---|
939 | end if
|
---|
940 | next
|
---|
941 | arrStrings(i) = str1
|
---|
942 | next
|
---|
943 | ArraySortStringsEx = arrStrings
|
---|
944 | end function
|
---|
945 |
|
---|
946 | '' Wrapper for StrComp as GetRef("StrComp") fails.
|
---|
947 | function WrapStrComp(str1, str2)
|
---|
948 | WrapStrComp = StrComp(str1, str2)
|
---|
949 | end function
|
---|
950 |
|
---|
951 | ''
|
---|
952 | ' Returns a reverse sorted array (strings).
|
---|
953 | function ArraySortStrings(arrStrings)
|
---|
954 | ArraySortStrings = ArraySortStringsEx(arrStrings, GetRef("WrapStrComp"))
|
---|
955 | end function
|
---|
956 |
|
---|
957 |
|
---|
958 | ''
|
---|
959 | ' Returns a reverse sorted array (strings).
|
---|
960 | function ArrayVerSortStrings(arrStrings)
|
---|
961 | ArrayVerSortStrings = ArraySortStringsEx(arrStrings, GetRef("StrVersionCompare"))
|
---|
962 | end function
|
---|
963 |
|
---|
964 |
|
---|
965 | '' Wrapper for StrComp as GetRef("StrComp") fails.
|
---|
966 | function WrapStrCompNeg(str1, str2)
|
---|
967 | WrapStrCompNeg = -StrComp(str1, str2)
|
---|
968 | end function
|
---|
969 |
|
---|
970 | ''
|
---|
971 | ' Returns a reverse sorted array (strings).
|
---|
972 | function ArrayRSortStrings(arrStrings)
|
---|
973 | ArrayRSortStrings = ArraySortStringsEx(arrStrings, GetRef("WrapStrCompNeg"))
|
---|
974 | end function
|
---|
975 |
|
---|
976 |
|
---|
977 | ''
|
---|
978 | ' Returns a reverse version sorted array (strings).
|
---|
979 | function ArrayRVerSortStrings(arrStrings)
|
---|
980 | ArrayRVerSortStrings = ArrayReverse(ArraySortStringsEx(arrStrings, GetRef("StrVersionCompare")))
|
---|
981 | end function
|
---|
982 |
|
---|
983 |
|
---|
984 | ''
|
---|
985 | ' Prints a string array.
|
---|
986 | sub ArrayPrintStrings(arrStrings, strPrefix)
|
---|
987 | for i = LBound(arrStrings) to UBound(arrStrings)
|
---|
988 | Print strPrefix & "arrStrings(" & i & ") = '" & arrStrings(i) & "'"
|
---|
989 | next
|
---|
990 | end sub
|
---|
991 |
|
---|
992 |
|
---|
993 | ''
|
---|
994 | ' Returns an Array() statement string
|
---|
995 | function ArrayToString(arrStrings)
|
---|
996 | dim strRet, i
|
---|
997 | strRet = "Array("
|
---|
998 | for i = LBound(arrStrings) to UBound(arrStrings)
|
---|
999 | if i <> LBound(arrStrings) then strRet = strRet & ", "
|
---|
1000 | strRet = strRet & """" & arrStrings(i) & """"
|
---|
1001 | next
|
---|
1002 | ArrayToString = strRet & ")"
|
---|
1003 | end function
|
---|
1004 |
|
---|
1005 |
|
---|
1006 | ''
|
---|
1007 | ' Joins the elements of an array into a string using the given item separator.
|
---|
1008 | ' @remark this is the same as Join() really.
|
---|
1009 | function ArrayJoinString(arrStrings, strSep)
|
---|
1010 | if ArraySize(arrStrings) = 0 then
|
---|
1011 | ArrayJoinString = ""
|
---|
1012 | else
|
---|
1013 | dim i
|
---|
1014 | ArrayJoinString = "" & arrStrings(LBound(arrStrings))
|
---|
1015 | for i = LBound(arrStrings) + 1 to UBound(arrStrings)
|
---|
1016 | ArrayJoinString = ArrayJoinString & strSep & arrStrings(i)
|
---|
1017 | next
|
---|
1018 | end if
|
---|
1019 | end function
|
---|
1020 |
|
---|
1021 |
|
---|
1022 | ''
|
---|
1023 | ' Returns the input array with the string appended.
|
---|
1024 | ' @note This works by reference
|
---|
1025 | function ArrayAppend(ByRef arr, str)
|
---|
1026 | dim i
|
---|
1027 | redim preserve arr(UBound(arr) + 1)
|
---|
1028 | arr(UBound(arr)) = str
|
---|
1029 | ArrayAppend = arr
|
---|
1030 | end function
|
---|
1031 |
|
---|
1032 |
|
---|
1033 | ''
|
---|
1034 | ' Returns the input array with the string prepended.
|
---|
1035 | ' @note This works by reference
|
---|
1036 | function ArrayPrepend(ByRef arr, str)
|
---|
1037 | dim i
|
---|
1038 | redim preserve arr(UBound(arr) + 1)
|
---|
1039 | for i = UBound(arr) to (LBound(arr) + 1) step -1
|
---|
1040 | arr(i) = arr(i - 1)
|
---|
1041 | next
|
---|
1042 | arr(LBound(arr)) = str
|
---|
1043 | ArrayPrepend = arr
|
---|
1044 | end function
|
---|
1045 |
|
---|
1046 |
|
---|
1047 | ''
|
---|
1048 | ' Returns the input array with the string prepended.
|
---|
1049 | ' @note This works by reference
|
---|
1050 | function ArrayRemove(ByRef arr, idx)
|
---|
1051 | dim i
|
---|
1052 | for i = idx to (UBound(arr) - 1)
|
---|
1053 | arr(i) = arr(i + 1)
|
---|
1054 | next
|
---|
1055 | redim preserve arr(UBound(arr) - 1)
|
---|
1056 | ArrayRemove = arr
|
---|
1057 | end function
|
---|
1058 |
|
---|
1059 |
|
---|
1060 | ''
|
---|
1061 | ' Checks if the array contains the given string (case sensitive).
|
---|
1062 | function ArrayContainsString(ByRef arr, str)
|
---|
1063 | dim strCur
|
---|
1064 | ArrayContainsString = False
|
---|
1065 | for each strCur in arr
|
---|
1066 | if StrComp(strCur, str) = 0 then
|
---|
1067 | ArrayContainsString = True
|
---|
1068 | exit function
|
---|
1069 | end if
|
---|
1070 | next
|
---|
1071 | end function
|
---|
1072 |
|
---|
1073 |
|
---|
1074 | ''
|
---|
1075 | ' Checks if the array contains the given string, using case insensitive compare.
|
---|
1076 | function ArrayContainsStringI(ByRef arr, str)
|
---|
1077 | dim strCur
|
---|
1078 | ArrayContainsStringI = False
|
---|
1079 | for each strCur in arr
|
---|
1080 | if StrComp(strCur, str, vbTextCompare) = 0 then
|
---|
1081 | ArrayContainsStringI = True
|
---|
1082 | exit function
|
---|
1083 | end if
|
---|
1084 | next
|
---|
1085 | end function
|
---|
1086 |
|
---|
1087 |
|
---|
1088 | ''
|
---|
1089 | ' Returns the index of the first occurance of the given string; -1 if not found.
|
---|
1090 | function ArrayFindString(ByRef arr, str)
|
---|
1091 | dim i
|
---|
1092 | for i = LBound(arr) to UBound(arr)
|
---|
1093 | if StrComp(arr(i), str, vbBinaryCompare) = 0 then
|
---|
1094 | ArrayFindString = i
|
---|
1095 | exit function
|
---|
1096 | end if
|
---|
1097 | next
|
---|
1098 | ArrayFindString = LBound(arr) - 1
|
---|
1099 | end function
|
---|
1100 |
|
---|
1101 |
|
---|
1102 | ''
|
---|
1103 | ' Returns the index of the first occurance of the given string, -1 if not found,
|
---|
1104 | ' case insensitive edition.
|
---|
1105 | function ArrayFindStringI(ByRef arr, str)
|
---|
1106 | dim i
|
---|
1107 | for i = LBound(arr) to UBound(arr)
|
---|
1108 | if StrComp(arr(i), str, vbTextCompare) = 0 then
|
---|
1109 | ArrayFindStringI = i
|
---|
1110 | exit function
|
---|
1111 | end if
|
---|
1112 | next
|
---|
1113 | ArrayFindStringI = LBound(arr) - 1
|
---|
1114 | end function
|
---|
1115 |
|
---|
1116 |
|
---|
1117 | ''
|
---|
1118 | ' Returns the number of entries in an array.
|
---|
1119 | function ArraySize(ByRef arr)
|
---|
1120 | if (UBound(arr) >= 0) then
|
---|
1121 | ArraySize = UBound(arr) - LBound(arr) + 1
|
---|
1122 | else
|
---|
1123 | ArraySize = 0
|
---|
1124 | end if
|
---|
1125 | end function
|
---|
1126 |
|
---|
1127 |
|
---|
1128 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1129 | ' Helpers: Registry '
|
---|
1130 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1131 |
|
---|
1132 | '' The registry globals
|
---|
1133 | dim g_objReg, g_objRegCtx
|
---|
1134 | dim g_blnRegistry
|
---|
1135 | g_blnRegistry = false
|
---|
1136 |
|
---|
1137 |
|
---|
1138 | ''
|
---|
1139 | ' Init the register provider globals.
|
---|
1140 | function RegInit()
|
---|
1141 | RegInit = false
|
---|
1142 | On Error Resume Next
|
---|
1143 | if g_blnRegistry = false then
|
---|
1144 | set g_objRegCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
|
---|
1145 | ' Comment out the following for lines if the cause trouble on your windows version.
|
---|
1146 | if IsWow64() then
|
---|
1147 | g_objRegCtx.Add "__ProviderArchitecture", 64
|
---|
1148 | g_objRegCtx.Add "__RequiredArchitecture", true
|
---|
1149 | LogPrint "RegInit: WoW64"
|
---|
1150 | end if
|
---|
1151 | set objLocator = CreateObject("Wbemscripting.SWbemLocator")
|
---|
1152 | set objServices = objLocator.ConnectServer("", "root\default", "", "", , , , g_objRegCtx)
|
---|
1153 | set g_objReg = objServices.Get("StdRegProv")
|
---|
1154 | g_blnRegistry = true
|
---|
1155 | end if
|
---|
1156 | RegInit = true
|
---|
1157 | end function
|
---|
1158 |
|
---|
1159 |
|
---|
1160 | ''
|
---|
1161 | ' Translates a register root name to a value
|
---|
1162 | ' This will translate HKCU path to HKEY_USERS and fixing
|
---|
1163 | function RegTransRoot(strRoot, ByRef sSubKeyName)
|
---|
1164 | const HKEY_LOCAL_MACHINE = &H80000002
|
---|
1165 | const HKEY_CURRENT_USER = &H80000001
|
---|
1166 | const HKEY_USERS = &H80000003
|
---|
1167 |
|
---|
1168 | select case strRoot
|
---|
1169 | case "HKLM"
|
---|
1170 | RegTransRoot = HKEY_LOCAL_MACHINE
|
---|
1171 | case "HKUS"
|
---|
1172 | RegTransRoot = HKEY_USERS
|
---|
1173 | case "HKCU"
|
---|
1174 | dim strCurrentSid
|
---|
1175 | strCurrentSid = GetSid()
|
---|
1176 | if strCurrentSid <> "" then
|
---|
1177 | sSubKeyName = strCurrentSid & "\" & sSubKeyName
|
---|
1178 | RegTransRoot = HKEY_USERS
|
---|
1179 | 'LogPrint "RegTransRoot: HKCU -> HKEY_USERS + " & sSubKeyName
|
---|
1180 | else
|
---|
1181 | RegTransRoot = HKEY_CURRENT_USER
|
---|
1182 | LogPrint "RegTransRoot: Warning! HKCU -> HKEY_USERS failed!"
|
---|
1183 | end if
|
---|
1184 | case else
|
---|
1185 | MsgFatal "RegTransRoot: Unknown root: '" & strRoot & "'"
|
---|
1186 | RegTransRoot = 0
|
---|
1187 | end select
|
---|
1188 | end function
|
---|
1189 |
|
---|
1190 |
|
---|
1191 | ''
|
---|
1192 | ' Gets a value from the registry. Returns "" if string wasn't found / valid.
|
---|
1193 | function RegGetString(strName)
|
---|
1194 | RegGetString = ""
|
---|
1195 | if RegInit() then
|
---|
1196 | dim strRoot, strKey, strValue
|
---|
1197 |
|
---|
1198 | ' split up into root, key and value parts.
|
---|
1199 | strRoot = left(strName, instr(strName, "\") - 1)
|
---|
1200 | strKey = mid(strName, instr(strName, "\") + 1, instrrev(strName, "\") - instr(strName, "\"))
|
---|
1201 | strValue = mid(strName, instrrev(strName, "\") + 1)
|
---|
1202 |
|
---|
1203 | ' Must use ExecMethod to call the GetStringValue method because of the context.
|
---|
1204 | Set InParms = g_objReg.Methods_("GetStringValue").Inparameters
|
---|
1205 | InParms.hDefKey = RegTransRoot(strRoot, strKey)
|
---|
1206 | InParms.sSubKeyName = strKey
|
---|
1207 | InParms.sValueName = strValue
|
---|
1208 | On Error Resume Next
|
---|
1209 | set OutParms = g_objReg.ExecMethod_("GetStringValue", InParms, , g_objRegCtx)
|
---|
1210 | if OutParms.ReturnValue = 0 then
|
---|
1211 | if not IsNull(OutParms.sValue) then
|
---|
1212 | RegGetString = OutParms.sValue
|
---|
1213 | end if
|
---|
1214 | end if
|
---|
1215 | else
|
---|
1216 | ' fallback mode
|
---|
1217 | On Error Resume Next
|
---|
1218 | RegGetString = g_objShell.RegRead(strName)
|
---|
1219 | end if
|
---|
1220 | end function
|
---|
1221 |
|
---|
1222 |
|
---|
1223 | ''
|
---|
1224 | ' Gets a multi string value from the registry. Returns array of strings if found, otherwise empty array().
|
---|
1225 | function RegGetMultiString(strName)
|
---|
1226 | RegGetMultiString = Array()
|
---|
1227 | if RegInit() then
|
---|
1228 | dim strRoot, strKey, strValue
|
---|
1229 |
|
---|
1230 | ' split up into root, key and value parts.
|
---|
1231 | strRoot = left(strName, instr(strName, "\") - 1)
|
---|
1232 | strKey = mid(strName, instr(strName, "\") + 1, instrrev(strName, "\") - instr(strName, "\"))
|
---|
1233 | strValue = mid(strName, instrrev(strName, "\") + 1)
|
---|
1234 |
|
---|
1235 | ' Must use ExecMethod to call the GetStringValue method because of the context.
|
---|
1236 | Set InParms = g_objReg.Methods_("GetMultiStringValue").Inparameters
|
---|
1237 | InParms.hDefKey = RegTransRoot(strRoot, strKey)
|
---|
1238 | InParms.sSubKeyName = strKey
|
---|
1239 | InParms.sValueName = strValue
|
---|
1240 | On Error Resume Next
|
---|
1241 | set OutParms = g_objReg.ExecMethod_("GetMultiStringValue", InParms, , g_objRegCtx)
|
---|
1242 | if OutParms.ReturnValue = 0 then
|
---|
1243 | if OutParms.sValue <> Null then
|
---|
1244 | RegGetMultiString = OutParms.sValue
|
---|
1245 | end if
|
---|
1246 | end if
|
---|
1247 | else
|
---|
1248 | ' fallback mode
|
---|
1249 | On Error Resume Next
|
---|
1250 | RegGetMultiString = g_objShell.RegRead(strName)
|
---|
1251 | end if
|
---|
1252 | end function
|
---|
1253 |
|
---|
1254 |
|
---|
1255 | ''
|
---|
1256 | ' Returns an array of subkey strings.
|
---|
1257 | function RegEnumSubKeys(strRoot, ByVal strKeyPath)
|
---|
1258 | RegEnumSubKeys = Array()
|
---|
1259 | if RegInit() then
|
---|
1260 | ' Must use ExecMethod to call the EnumKey method because of the context.
|
---|
1261 | Set InParms = g_objReg.Methods_("EnumKey").Inparameters
|
---|
1262 | InParms.hDefKey = RegTransRoot(strRoot, strKeyPath)
|
---|
1263 | InParms.sSubKeyName = strKeyPath
|
---|
1264 | On Error Resume Next
|
---|
1265 | set OutParms = g_objReg.ExecMethod_("EnumKey", InParms, , g_objRegCtx)
|
---|
1266 | 'LogPrint "RegEnumSubKeys(" & Hex(InParms.hDefKey) & "," & InParms.sSubKeyName &") -> " & OutParms.GetText_(1)
|
---|
1267 | if OutParms.ReturnValue = 0 then
|
---|
1268 | if OutParms.sNames <> Null then
|
---|
1269 | RegEnumSubKeys = OutParms.sNames
|
---|
1270 | end if
|
---|
1271 | end if
|
---|
1272 | else
|
---|
1273 | ' fallback mode
|
---|
1274 | dim objReg, rc, arrSubKeys
|
---|
1275 | set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
|
---|
1276 | On Error Resume Next
|
---|
1277 | rc = objReg.EnumKey(RegTransRoot(strRoot, strKeyPath), strKeyPath, arrSubKeys)
|
---|
1278 | if rc = 0 then
|
---|
1279 | RegEnumSubKeys = arrSubKeys
|
---|
1280 | end if
|
---|
1281 | end if
|
---|
1282 | end function
|
---|
1283 |
|
---|
1284 |
|
---|
1285 | ''
|
---|
1286 | ' Returns an array of full path subkey strings.
|
---|
1287 | function RegEnumSubKeysFull(strRoot, strKeyPath)
|
---|
1288 | dim arrTmp
|
---|
1289 | arrTmp = RegEnumSubKeys(strRoot, strKeyPath)
|
---|
1290 | for i = LBound(arrTmp) to UBound(arrTmp)
|
---|
1291 | arrTmp(i) = strKeyPath & "\" & arrTmp(i)
|
---|
1292 | next
|
---|
1293 | RegEnumSubKeysFull = arrTmp
|
---|
1294 | end function
|
---|
1295 |
|
---|
1296 |
|
---|
1297 | ''
|
---|
1298 | ' Returns an rsorted array of subkey strings.
|
---|
1299 | function RegEnumSubKeysRVerSorted(strRoot, strKeyPath)
|
---|
1300 | RegEnumSubKeysRVerSorted = ArrayRVerSortStrings(RegEnumSubKeys(strRoot, strKeyPath))
|
---|
1301 | end function
|
---|
1302 |
|
---|
1303 |
|
---|
1304 | ''
|
---|
1305 | ' Returns an rsorted array of subkey strings.
|
---|
1306 | function RegEnumSubKeysFullRVerSorted(strRoot, strKeyPath)
|
---|
1307 | RegEnumSubKeysFullRVerSorted = ArrayRVerSortStrings(RegEnumSubKeysFull(strRoot, strKeyPath))
|
---|
1308 | end function
|
---|
1309 |
|
---|
1310 |
|
---|
1311 | ''
|
---|
1312 | ' Returns an array of value name strings.
|
---|
1313 | function RegEnumValueNames(strRoot, ByVal strKeyPath)
|
---|
1314 | RegEnumValueNames = Array()
|
---|
1315 | if RegInit() then
|
---|
1316 | ' Must use ExecMethod to call the EnumKey method because of the context.
|
---|
1317 | Set InParms = g_objReg.Methods_("EnumValues").Inparameters
|
---|
1318 | InParms.hDefKey = RegTransRoot(strRoot, strKeyPath)
|
---|
1319 | InParms.sSubKeyName = strKeyPath
|
---|
1320 | On Error Resume Next
|
---|
1321 | set OutParms = g_objReg.ExecMethod_("EnumValues", InParms, , g_objRegCtx)
|
---|
1322 | 'LogPrint "RegEnumValueNames(" & Hex(InParms.hDefKey) & "," & InParms.sSubKeyName &") -> " & OutParms.GetText_(1)
|
---|
1323 | if OutParms.ReturnValue = 0 then
|
---|
1324 | if OutParms.sNames <> Null then
|
---|
1325 | RegEnumValueNames = OutParms.sNames
|
---|
1326 | end if
|
---|
1327 | end if
|
---|
1328 | else
|
---|
1329 | ' fallback mode
|
---|
1330 | dim objReg, rc, arrSubKeys
|
---|
1331 | set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
|
---|
1332 | On Error Resume Next
|
---|
1333 | rc = objReg.EnumValues(RegTransRoot(strRoot, strKeyPath), strKeyPath, arrSubKeys)
|
---|
1334 | if rc = 0 then
|
---|
1335 | RegEnumValueNames = arrSubKeys
|
---|
1336 | end if
|
---|
1337 | end if
|
---|
1338 | end function
|
---|
1339 |
|
---|
1340 |
|
---|
1341 | ''
|
---|
1342 | ' Returns an array of full path value name strings.
|
---|
1343 | function RegEnumValueNamesFull(strRoot, strKeyPath)
|
---|
1344 | dim arrTmp
|
---|
1345 | arrTmp = RegEnumValueNames(strRoot, strKeyPath)
|
---|
1346 | for i = LBound(arrTmp) to UBound(arrTmp)
|
---|
1347 | arrTmp(i) = strKeyPath & "\" & arrTmp(i)
|
---|
1348 | next
|
---|
1349 | RegEnumValueNamesFull = arrTmp
|
---|
1350 | end function
|
---|
1351 |
|
---|
1352 |
|
---|
1353 | ''
|
---|
1354 | ' Extract relevant paths from program links using a callback function.
|
---|
1355 | '
|
---|
1356 | ' Enumerates start menu program links from "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\UFH\SHC"
|
---|
1357 | ' and similar, using the given callback to examine each and return a path if relevant. The relevant
|
---|
1358 | ' paths are returned in reverse sorted order.
|
---|
1359 | '
|
---|
1360 | ' The callback prototype is as follows fnCallback(ByRef arrStrings, cStrings, ByRef objUser).
|
---|
1361 | ' Any non-empty return strings are collected, reverse sorted uniquely and returned.
|
---|
1362 | '
|
---|
1363 | function CollectFromProgramItemLinks(ByRef fnCallback, ByRef objUser)
|
---|
1364 | dim arrValues, strValue, arrStrings, str, arrCandidates, iCandidates, cStrings
|
---|
1365 | CollectFromProgramItemLinks = Array()
|
---|
1366 |
|
---|
1367 | arrValues = RegEnumValueNamesFull("HKCU", "SOFTWARE\Microsoft\Windows\CurrentVersion\UFH\SHC")
|
---|
1368 | redim arrCandidates(UBound(arrValues) - LBound(arrValues) + 1)
|
---|
1369 | iCandidates = 0
|
---|
1370 | for each strValue in arrValues
|
---|
1371 | arrStrings = RegGetMultiString("HKCU\" & strValue)
|
---|
1372 | if UBound(arrStrings) >= 0 then
|
---|
1373 | cStrings = UBound(arrStrings) + 1 - LBound(arrStrings)
|
---|
1374 | str = fnCallback(arrStrings, cStrings, objUser)
|
---|
1375 | if str <> "" then
|
---|
1376 | if not ArrayContainsStringI(arrCandidates, str) then
|
---|
1377 | arrCandidates(iCandidates) = str
|
---|
1378 | iCandidates = iCandidates + 1
|
---|
1379 | end if
|
---|
1380 | end if
|
---|
1381 | end if
|
---|
1382 | next
|
---|
1383 | if iCandidates > 0 then
|
---|
1384 | redim preserve arrCandidates(iCandidates - 1)
|
---|
1385 | arrCandidates = ArrayRVerSortStrings(arrCandidates)
|
---|
1386 | for iCandidates = LBound(arrCandidates) to UBound(arrCandidates)
|
---|
1387 | LogPrint "CollectFromProgramItemLinks: #" & iCandidates & ": " & arrCandidates(iCandidates)
|
---|
1388 | next
|
---|
1389 | CollectFromProgramItemLinks = arrCandidates
|
---|
1390 | end if
|
---|
1391 | end function
|
---|
1392 |
|
---|
1393 |
|
---|
1394 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1395 | ' Helpers: Messaging and Output '
|
---|
1396 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1397 |
|
---|
1398 | ''
|
---|
1399 | ' Append text to the log file and echo it to stdout
|
---|
1400 | sub Print(str)
|
---|
1401 | LogPrint str
|
---|
1402 | Wscript.Echo str
|
---|
1403 | end sub
|
---|
1404 |
|
---|
1405 |
|
---|
1406 | ''
|
---|
1407 | ' Prints a test header
|
---|
1408 | sub PrintHdr(strTest)
|
---|
1409 | LogPrint "***** Checking for " & strTest & " *****"
|
---|
1410 | Wscript.Echo "Checking for " & StrTest & "..."
|
---|
1411 | end sub
|
---|
1412 |
|
---|
1413 |
|
---|
1414 | ''
|
---|
1415 | ' Prints a success message
|
---|
1416 | sub PrintResultMsg(strTest, strResult)
|
---|
1417 | dim cchPad
|
---|
1418 | LogPrint "** " & strTest & ": " & strResult
|
---|
1419 | Wscript.Echo " Found " & RightPad(strTest & ": ", 22) & strPad & strResult
|
---|
1420 | end sub
|
---|
1421 |
|
---|
1422 |
|
---|
1423 | ''
|
---|
1424 | ' Prints a successfully detected path
|
---|
1425 | sub PrintResult(strTest, strPath)
|
---|
1426 | strLongPath = PathAbsLong(strPath)
|
---|
1427 | if PathAbs(strPath) <> strLongPath then
|
---|
1428 | LogPrint "** " & strTest & ": " & strPath & " (" & UnixSlashes(strLongPath) & ")"
|
---|
1429 | Wscript.Echo " Found " & RightPad(strTest & ": ", 22) & strPath & " (" & UnixSlashes(strLongPath) & ")"
|
---|
1430 | else
|
---|
1431 | LogPrint "** " & strTest & ": " & strPath
|
---|
1432 | Wscript.Echo " Found " & RightPad(strTest & ": ", 22) & strPath
|
---|
1433 | end if
|
---|
1434 | end sub
|
---|
1435 |
|
---|
1436 |
|
---|
1437 | ''
|
---|
1438 | ' Info message.
|
---|
1439 | sub MsgInfo(strMsg)
|
---|
1440 | Print "info: " & strMsg
|
---|
1441 | end sub
|
---|
1442 |
|
---|
1443 |
|
---|
1444 | ''
|
---|
1445 | ' Warning message.
|
---|
1446 | sub MsgWarning(strMsg)
|
---|
1447 | Print "warning: " & strMsg
|
---|
1448 | end sub
|
---|
1449 |
|
---|
1450 |
|
---|
1451 | ''
|
---|
1452 | ' Fatal error.
|
---|
1453 | sub MsgFatal(strMsg)
|
---|
1454 | Print "fatal error: " & strMsg
|
---|
1455 | Wscript.Quit(1)
|
---|
1456 | end sub
|
---|
1457 |
|
---|
1458 |
|
---|
1459 | ''
|
---|
1460 | ' Error message, fatal unless flag to ignore errors is given.
|
---|
1461 | sub MsgError(strMsg)
|
---|
1462 | Print "error: " & strMsg
|
---|
1463 | if g_blnContinueOnError = False then
|
---|
1464 | Wscript.Quit(1)
|
---|
1465 | end if
|
---|
1466 | g_rcScript = 1
|
---|
1467 | end sub
|
---|
1468 |
|
---|
1469 | ''
|
---|
1470 | ' Error message, fatal unless flag to ignore errors is given.
|
---|
1471 | ' @note does not return
|
---|
1472 | sub MsgSyntaxError(strMsg)
|
---|
1473 | Print "syntax error: " & strMsg
|
---|
1474 | Wscript.Quit(2)
|
---|
1475 | end sub
|
---|
1476 |
|
---|
1477 |
|
---|
1478 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1479 | ' Helpers: Misc '
|
---|
1480 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1481 |
|
---|
1482 | ''
|
---|
1483 | ' Translate a kBuild / VBox architecture name to a windows one.
|
---|
1484 | function XlateArchitectureToWin(strArch)
|
---|
1485 | strArch = LCase(strArch)
|
---|
1486 | XlateArchitectureToWin = strArch
|
---|
1487 | if strArch = "amd64" then XlateArchitectureToWin = "x64"
|
---|
1488 | end function
|
---|
1489 |
|
---|
1490 |
|
---|
1491 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1492 | ' Testcases '
|
---|
1493 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
---|
1494 |
|
---|
1495 | ''
|
---|
1496 | ' Self test for some of the above routines.
|
---|
1497 | '
|
---|
1498 | sub SelfTest
|
---|
1499 | dim i, str
|
---|
1500 | str = "0123456789"
|
---|
1501 | for i = 1 to Len(str)
|
---|
1502 | if CharIsDigit(Mid(str, i, 1)) <> True then MsgFatal "SelfTest failed: CharIsDigit("&Mid(str, i, 1)&")"
|
---|
1503 | next
|
---|
1504 | str = "abcdefghijklmnopqrstuvwxyz~`!@#$%^&*()_+-=ABCDEFGHIJKLMNOPQRSTUVWXYZ/\[]{}"
|
---|
1505 | for i = 1 to Len(str)
|
---|
1506 | if CharIsDigit(Mid(str, i, 1)) <> False then MsgFatal "SelfTest failed: CharIsDigit("&Mid(str, i, 1)&")"
|
---|
1507 | next
|
---|
1508 |
|
---|
1509 | if StrVersionCompare("1234", "1234") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #1"
|
---|
1510 | if StrVersionCompare("1", "1") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #2"
|
---|
1511 | if StrVersionCompare("2", "1") <= 0 then MsgFatal "SelfTest failed: StrVersionCompare #3"
|
---|
1512 | if StrVersionCompare("1", "2") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #4"
|
---|
1513 | if StrVersionCompare("01", "1") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #5"
|
---|
1514 | if StrVersionCompare("01", "001") <> 0 then MsgFatal "SelfTest failed: StrVersionCompare #6"
|
---|
1515 | if StrVersionCompare("12", "123") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #7"
|
---|
1516 | if StrVersionCompare("v123", "123") <= 0 then MsgFatal "SelfTest failed: StrVersionCompare #8"
|
---|
1517 | if StrVersionCompare("v1.2.3", "v1.3.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #9"
|
---|
1518 | if StrVersionCompare("v1.02.3", "v1.3.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #10"
|
---|
1519 | if StrVersionCompare("v1.2.3", "v1.03.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #11"
|
---|
1520 | if StrVersionCompare("v1.2.4", "v1.23.4") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #12"
|
---|
1521 | if StrVersionCompare("v10.0.17163", "v10.00.18363") >= 0 then MsgFatal "SelfTest failed: StrVersionCompare #13"
|
---|
1522 | if StrVersionCompare("n 2.15.0", "2.12.0") <= 0 then MsgFatal "SelfTest failed: StrVersionCompare #14"
|
---|
1523 |
|
---|
1524 | if StrGetFirstWord("1") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #1"
|
---|
1525 | if StrGetFirstWord(" 1 ") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #2"
|
---|
1526 | if StrGetFirstWord(" 1 2 ") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #3"
|
---|
1527 | if StrGetFirstWord("1 2") <> "1" then MsgFatal "SelfTest: StrGetFirstWord #4"
|
---|
1528 | if StrGetFirstWord("1234 5") <> "1234" then MsgFatal "SelfTest: StrGetFirstWord #5"
|
---|
1529 | if StrGetFirstWord(" ") <> "" then MsgFatal "SelfTest: StrGetFirstWord #6"
|
---|
1530 |
|
---|
1531 | dim arr
|
---|
1532 | arr = ArrayAppend(Array("0", "1"), "2")
|
---|
1533 | if ArraySize(arr) <> 3 then MsgFatal "SelfTest: Array #1: size:" & ArraySize(arr)
|
---|
1534 | if ArrayToString(arr) <> "Array(""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #1: " & ArrayToString(arr)
|
---|
1535 |
|
---|
1536 | arr = ArrayPrepend(arr, "-1")
|
---|
1537 | if ArraySize(arr) <> 4 then MsgFatal "SelfTest: Array #2: size:" & ArraySize(arr)
|
---|
1538 | if ArrayToString(arr) <> "Array(""-1"", ""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #2: " & ArrayToString(arr)
|
---|
1539 |
|
---|
1540 | ArrayPrepend arr, "-2"
|
---|
1541 | if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #3: size:" & ArraySize(arr)
|
---|
1542 | if ArrayToString(arr) <> "Array(""-2"", ""-1"", ""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #3: " & ArrayToString(arr)
|
---|
1543 |
|
---|
1544 | ArrayRemove arr, 1
|
---|
1545 | if ArraySize(arr) <> 4 then MsgFatal "SelfTest: Array #4: size:" & ArraySize(arr)
|
---|
1546 | if ArrayToString(arr) <> "Array(""-2"", ""0"", ""1"", ""2"")" then MsgFatal "SelfTest: Array #4: " & ArrayToString(arr)
|
---|
1547 |
|
---|
1548 | arr = ArrayRemove(arr, 2)
|
---|
1549 | if ArraySize(arr) <> 3 then MsgFatal "SelfTest: Array #5: size:" & ArraySize(arr)
|
---|
1550 | if ArrayToString(arr) <> "Array(""-2"", ""0"", ""2"")" then MsgFatal "SelfTest: Array #5: " & ArrayToString(arr)
|
---|
1551 |
|
---|
1552 | arr = ArrayPrepend(arr, "42")
|
---|
1553 | arr = ArrayAppend(arr, "-42")
|
---|
1554 | if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #6: size:" & ArraySize(arr)
|
---|
1555 | if ArrayToString(arr) <> "Array(""42"", ""-2"", ""0"", ""2"", ""-42"")" then MsgFatal "SelfTest: Array #6: " & ArrayToString(arr)
|
---|
1556 |
|
---|
1557 | arr = ArraySortStrings(arr)
|
---|
1558 | if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #7: size:" & ArraySize(arr)
|
---|
1559 | if ArrayToString(arr) <> "Array(""-2"", ""-42"", ""0"", ""2"", ""42"")" then MsgFatal "SelfTest: Array #7: " & ArrayToString(arr)
|
---|
1560 |
|
---|
1561 | arr = ArrayRSortStrings(arr)
|
---|
1562 | if ArraySize(arr) <> 5 then MsgFatal "SelfTest: Array #7: size:" & ArraySize(arr)
|
---|
1563 | if ArrayToString(arr) <> "Array(""42"", ""2"", ""0"", ""-42"", ""-2"")" then MsgFatal "SelfTest: Array #8: " & ArrayToString(arr)
|
---|
1564 |
|
---|
1565 | arr = ArrayVerSortStrings(Array("v10", "v1", "v0"))
|
---|
1566 | if ArrayToString(arr) <> "Array(""v0"", ""v1"", ""v10"")" then MsgFatal "SelfTest: Array #9: " & ArrayToString(arr)
|
---|
1567 |
|
---|
1568 | arr = ArrayRVerSortStrings(arr)
|
---|
1569 | if ArrayToString(arr) <> "Array(""v10"", ""v1"", ""v0"")" then MsgFatal "SelfTest: Array #10: " & ArrayToString(arr)
|
---|
1570 |
|
---|
1571 | if ArrayJoinString(arr, ":") <> "v10:v1:v0" then MsgFatal "SelfTest: Array #11: " & ArrayJoinString(arr, ":")
|
---|
1572 |
|
---|
1573 | if PathMatch("c:\", "C:\") <> true then MsgFatal "SelfTest: PathMatch #1"
|
---|
1574 | if PathMatch("c:\\\winDows/sysTem32", "C:\WindowS\.\\.\System32\.") <> true then MsgFatal "SelfTest: PathMatch #2"
|
---|
1575 | if PathMatch("c:\\\winDows/sysTem32", "C:\WindowS\.\\..\System32\.") <> false then MsgFatal "SelfTest: PathMatch #3"
|
---|
1576 | if PathMatch("\\x\", "\\\x\") <> false then MsgFatal "SelfTest: PathMatch #4"
|
---|
1577 | if PathMatch("\\x\", "\\x\") <> true then MsgFatal "SelfTest: PathMatch #5"
|
---|
1578 | if PathMatch("\\", "\\") <> true then MsgFatal "SelfTest: PathMatch #6"
|
---|
1579 | if PathMatch("\\x", "\\x") <> true then MsgFatal "SelfTest: PathMatch #7"
|
---|
1580 |
|
---|
1581 | end sub
|
---|
1582 |
|
---|
1583 | '
|
---|
1584 | ' Run the self tests if we're executed directly.
|
---|
1585 | '
|
---|
1586 | if StrEndsWithI(Wscript.ScriptFullName, "\tools\win\vbscript\helpers.vbs") then
|
---|
1587 | Wscript.echo "helpers.vbs: Running self test..."
|
---|
1588 | SelfTest
|
---|
1589 | Wscript.echo "helpers.vbs: Self test complete."
|
---|
1590 | end if
|
---|