windows-nt/Source/XPSP1/NT/tools/postbuildscripts/addlink.wsf

<?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>