helpers.vbs@ 86869

Last change on this file since 86869 was 85842, checked in by vboxsync, 4 years ago
helpers.vbs: Added StrEndsWith and StrEndsWithI. Execute SelfTest if executed directly (handy for syntax errors).
Property svn:eol-style set to `CRLF` Property svn:keywords set to `Id`
File size: 54.4 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format