Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

539 lines
13 KiB

<?XML version="1.0" ?>
<package>
<comment>
Used in International and US BVT
</comment>
<comment>
Helps eliminate the need to download of perl executables
and scripts to BVT machine.
Sample destinations one may need to be wable to write:
AppData C:\WINDOWS\system32\config\systemprofile\Application Data
Cookies C:\Documents and Settings\Default User.WINDOWS\Cookies
Desktop C:\WINDOWS\system32\config\systemprofile\Desktop
Favorites C:\WINDOWS\system32\config\systemprofile\Favorites
NetHood C:\WINDOWS\system32\config\systemprofile\NetHood
Personal C:\WINDOWS\system32\config\systemprofile\My Documents
PrintHood C:\WINDOWS\system32\config\systemprofile\PrintHood
Recent C:\WINDOWS\system32\config\systemprofile\Recent
SendTo C:\WINDOWS\system32\config\systemprofile\SendTo
Start Menu C:\WINDOWS\system32\config\systemprofile\Start Menu
Templates C:\WINDOWS\system32\config\systemprofile\Templates
Programs C:\WINDOWS\system32\config\systemprofile\Start Menu\Programs
Startup C:\WINDOWS\system32\config\systemprofile\Start Menu\Programs\Startup
Local Settings C:\WINDOWS\system32\config\systemprofile\Local Settings
Local AppData C:\WINDOWS\system32\config\systemprofile\Local Settings\Application Data
Cache C:\Documents and Settings\Default User.WINDOWS\Local Settings\Temporary Internet Files
History C:\Documents and Settings\Default User.WINDOWS\Local Settings\History
My Pictures
My Music
Fonts C:\WINDOWS\Fonts
</comment>
<job>
<resource id ="destination">AllUsersDesktop</resource>
<resource id="icon">%SystemRoot%\system32\SHELL32.dll</resource>
<resource id="action">%SYSTEMROOT%\notepad.exe</resource>
<resource id="label">Safe Boot.lnk</resource>
<resource id="index">132</resource>
<resource id="comment">Reboot to SAFE</resource>
<resource id="Usage">
Name:
%SELF%
Creates a shortcut for given app at specified special folder [e.g. DESKTOP].
Usage:
%SELF% -c:%TEXT% -l:%NAME% -x:%EXEC% -h -d -i:%NUMBER% -y:%FOLDER%
Where
-h show this message
-d enable debugging
-y the destination special folder name. Default: %DESTINATION%
-l the name for the shortcut. Default: "%LABEL%"
-x executable to provide shortcut to. Default: %ACTION%
-i icon index in shell32.dll. Default: %INDEX%
-c optional comment for the shortcut. Default: "%COMMENT%"
Note: You may use single or double quotes to delimit arguments with spaces,
but not the mix.
Note: No shortcut will be created if the %EXEC% is not found on the system.
Existing shortcut will not be overwritten either.
</resource>
<script language="VBScript">
<![CDATA[
sub showUsage
Const VBEXPECTED = 5
on error resume next
Dim oGenRplaceVarNamXp
Dim oExRplaceVarNamXp
Dim aoRplaceMatches, oMatch, sMatch, sLabel, sResource
Set oGenRplaceVarNamXp = new RegExp
Set oExRplaceVarNamXp = new RegExp
With oGenRplaceVarNamXp
.Global = True
.IgnoreCase = True
.Pattern = "%\w+%"
End With
With oExRplaceVarNamXp
.Global = True
.IgnoreCase = True
.Pattern = "%\w+%"
End With
Dim sLine,asTest
asTest = ReadResource("Usage")
For Each sLine in asTest
sLine = Replace(sLine, "%SELF%", WScript.ScriptName,1,10)
Set aoRplaceMatches = oGenRplaceVarNamXp.Execute(sLine)
For Each oMatch in aoRplaceMatches
sMatch = oMatch.value
sMatch = UCase(Mid(sMatch, 2, Len(sMatch)-2))
sLabel = LCase(sMatch)
Err.clear
sResource = GetResource(sLabel)
If err = 0 Then
sMatch = sResource
ElseIf err = VBEXPECTED Then
sMatch = "<" & sMatch & ">"
Else
Raise Err
End If
oExRplaceVarNamXp.Pattern = oMatch.value
sLine = oExRplaceVarNamXp.Replace(sLine, sMatch)
Next
WScript.echo sLine
Next
WScript.Quit(0)
End sub
]]>
</script>
<script language="VBScript">
<![CDATA[
option explicit
Function ReadResource(sPresId)
On Error resume next
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Dim sPRes, asRes, uRes, tsRes
sPREs = GetResource(sPresId)
If Err.number <> 0 Then
Wscript.echo err.number & " " & err.description
' The Error description are not informative when failed getresource
IF Err.number = 7 Then
Wscript.echo chr(9) & "Null resource: " & _
sPresId
End If
IF Err.number = 5 Then
Wscript.echo chr(9) & "Undefined resource: " & _
sPresId
End If
Wscript.quit
End If
asRes = Split(WshShell.ExpandEnvironmentStrings(sPRes), VBNEWLINE)
Set ures = CreateObject("Scripting.Dictionary")
For Each tsRes in asRes
If 0 <> Len(tsRes) Then
uRes(tsRes) = 1
End If
Next
Dim tResource
tResource = uRes.Keys
If uBound(tResource) = 0 Then
ReadResource = tResource(0)
Else
ReadResource = tResource
End If
Set WshShell = Nothing
Set uRes = Nothing
End Function
]]>
</script>
<script language="VBScript">
<![CDATA[
Option Explicit
Dim spDestination
Dim opshell, opShortCut, spIconPath, spLinkLabel, spLinkAction, spLinkComment, npIconIndex
Dim siLinkComment, siLinkLabel, siLinkAction, siDestination, niIconIndex, Debug, Help, apCopyArgs, nRawArg
Dim sLinkTargetPath, aActionSplit, sDescriptionSplit
Set opShell = CreateObject("WScript.Shell")
spDestination = opShell.SpecialFolders.Item(CStr(GetResource("destination")))
spLinkLabel = CStr(GetResource("label"))
spIconPath = opShell.ExpandEnvironmentStrings(CStr(GetResource("icon")))
spLinkAction = opShell.ExpandEnvironmentStrings(CStr(GetResource("action")))
spLinkComment = CStr(GetResource("comment"))
npIconIndex = CInt(GetResource("index"))
apCopyArgs = Array()
Redim apCopyArgs (Wscript.arguments.Count)
For nRawArg = 0 to Wscript.arguments.Count - 1
apCopyArgs(nRawArg) = Wscript.arguments(nRawArg)
Next
apCopyArgs = reQuoteObjArgs(apCopyArgs)
Call GetParams("h d c: l: x: i: y:", _
"Help Debug siLinkComment siLinkLabel siLinkAction niIconIndex siDestination", apCopyArgs)
if Help <> "" Then
ShowUsage
End If
if niIconIndex <> "" Then
npIconIndex = CInt(niIconIndex)
End If
if siLinkLabel <> "" Then
spLinkLabel = siLinkLabel
End If
if siLinkAction <> "" Then
spLinkAction = opShell.ExpandEnvironmentStrings(siLinkAction)
End If
if siLinkComment <> "" Then
spLinkComment = siLinkComment
End If
if siDestination <> "" Then
spDestination = opShell.SpecialFolders.Item(CStr(siDestination))
WSCript.echo spDestination
if "" = spDestination Then
WSCript.echo "Unrecognized special folder: " & _
siDestination
WSCript.quit 17
End If
End If
if not bFileExistenceTest(spLinkAction) then
WScript.quit
End If
spIconPath = spIconPath & "," & CStr(npIconIndex)
spLinkLabel = spDestination & "\" & spLinkLabel
If not bFileExistenceTest(spLinkLabel) then
Set opShortCut = opShell.CreateShortcut(spLinkLabel)
aActionSplit = split(spLinkAction, " ")
sLinkTargetPath = aActionSplit(0)
sDescriptionSplit = ""
If UBound(aActionSplit) > 0 Then
For nRawArg = 1 To UBound(aActionSplit)
sDescriptionSplit = sDescriptionSplit & aActionSplit(nRawArg)
Next
With opShortCut
.Description = spLinkComment
.Arguments = sDescriptionSplit
.TargetPath = sLinkTargetPath
.IconLocation = spIconPath
.WorkingDirectory = "%TEMP%"
.save
End With
Else
With opShortCut
.Description = spLinkComment
.TargetPath = spLinkAction
.IconLocation = spIconPath
.WorkingDirectory = "%TEMP%"
.save
End With
End If
End If
Set opShortCut = Nothing
Set opShell = Nothing
WSCript.quit
Function bFileExistenceTest(spLine)
Dim aopExistenceTests, opExistenceTest, opNameSpace, sPreparedQueryName
Dim aspSplitFullName, spFullName
Dim spLinkAction
Set opNameSpace = GetObject("winmgmts:root\cimv2")
If isObject(opNameSpace) then ' a successful connection to winmgmts service
bFileExistenceTest = False
For Each spFullName in split(spLine, " ")
aspSplitFullName = split(spFullName, "\")
spFullName = join(aspSplitFullName, "\\")
sPreparedQueryName = "Select * from cim_datafile where name = """ & spFullName & """ "
Set aopExistenceTests = opNameSpace.execQuery("Select * from cim_datafile where name = """ & _
spFullName & _
"""", "WQL", 0)
For each opExistenceTest in aopExistenceTests
If True = Debug Then
Wscript.echo opExistenceTest.name & " is present on this system"
End If
bFileExistenceTest = True
Next
Set opExistenceTest = nothing
Set aopExistenceTests = nothing
Next
Else
Wscript.echo "cannot access namespace root\cimv2"
End if
Set opNameSpace = nothing
End Function
Public Function reQuoteObjArgs(objArgs)
Dim sLabelVar, sFoundLabel, sArgsDictionary, sArg, oArgs, nArg
Dim poQuotedCheckRegEx, poStringCheckRegEx, psQuotedCheckPt
Dim sConcatArgs, aRepArgs, spBadQuotedPart, spGoodQuotedPart, apQuoted
sConcatArgs = join(objArgs, " ")
psQuotedCheckPt = "\'[^\']+\'"
Set poQuotedCheckRegEx = New RegExp
With poQuotedCheckRegEx
.Global = True
.IgnoreCase = True
.Pattern = psQuotedCheckPt
End with
Set poStringCheckRegEx = New RegExp
With poQuotedCheckRegEx
.Global = True
.IgnoreCase = True
.Pattern = psQuotedCheckPt
End with
If True = poQuotedCheckRegEx.Test(sConcatArgs) Then
Set apQuoted = poQuotedCheckRegEx.Execute(sConcatArgs)
For each spBadQuotedPart in apQuoted
spGoodQuotedPart = Replace(spBadQuotedPart," ", "0x20", 1, 1000)
spGoodQuotedPart = Mid(spGoodQuotedPart,2, Len(spGoodQuotedPart) -2 )
poStringCheckRegEx.Pattern = Replace(spBadQuotedPart, "\", "\\", 1 ,100)
sConcatArgs = poStringCheckRegEx.Replace(sConcatArgs, spGoodQuotedPart)
Next
aRepArgs = Split(sConcatArgs, " ")
oArgs = Array()
Redim oArgs (ubound(aRepArgs) + 1)
For nArg = 0 To ubound(aRepArgs)
oArgs(nArg) = Replace(aRepArgs(nArg), "0x20", " ", 1, 100)
Next
reQuoteObjArgs = oArgs
Else
reQuoteObjArgs = objArgs
End If
End Function
Public Sub GetParams(sFlags, sVarNames, objArgs)
Dim sLabelVar, sFoundLabel, sArgsDictionary
Dim poKnownSwitchRegEx, psMaskKnownSwitch, nArg, mma, nma, nextlen, objargsnamed
Dim aFlags, aVarNames ' Arrays to split the sFlags and sVarNames
Set poKnownSwitchRegEx = New RegExp
Set sArgsDictionary = CreateObject("Scripting.Dictionary")
psMaskKnownSwitch = "[-/]\w+:?\b"
poKnownSwitchRegEx.Global = True
poKnownSwitchRegEx.IgnoreCase = True
poKnownSwitchRegEx.Pattern = psMaskKnownSwitch
If 0 = ubound(objArgs) Then
Exit Sub
End If
For nArg = 0 to uBound(objArgs)
If True = poKnownSwitchRegEx.Test(objArgs(nArg)) Then
Set mmA = poKnownSwitchRegEx.Execute(objArgs(nArg))
If mma.Count <> 1 Then
WScript.echo "Bad RegExp Count"
Err.Raise (1937)
Else
For each nma in mma
NextLen = nma.FirstIndex + nma.Length
sFoundLabel = CStr(Mid(objArgs(nArg), _
2 + nma.FirstIndex, _
nma.Length - 1))
' This is not If Right(sFoundLabel,1) = ":" Then
' required sFoundLabel = Left(sFoundLabel, len(sFoundLabel) - 1 )
' End If
If NextLen <> len(objArgs(nArg)) Then
sLabelVar = CStr(Mid(objArgs(nArg),NextLen + 1 ))
Else
sLabelVar = True
End If
sArgsDictionary.add sFoundLabel, sLabelVar
Next
End If
End If
Next
aFlags = split(sFlags)
aVarNames = split(sVarNames)
If Ubound(aFlags) <> Ubound(aVarNames) Then
Exit Sub
End If
Dim tnCnt
For tnCnt = 0 to Ubound(aFlags)
If sArgsDictionary.Exists(aFlags(tnCnt)) Then
FeedVar sArgsDictionary(aFlags(tnCnt)), aVarNames(tnCnt)
End If
Next
Set sArgsDictionary = Nothing
Set poKnownSwitchRegEx = Nothing
End Sub
Private Sub FeedVar(sLabelVar, sLabel)
If VarType(sLabelVar) <> vbString Then
Execute(sLabel & "=" & sLabelVar)
Else
Execute(sLabel & "=" & """" & sLabelVar & """" )
End If
End Sub
]]>
</script>
</job>
</package>