VBScript Enumerate Shortcuts

Enumerate shortcuts under all-users profile and report in XML format...

Option Explicit
Const strComputer = "."

Const rKey = "Software\Microsoft\Windows NT\CurrentVersion\ProfileList"
Const rVal = "ProfilesDirectory"
Const HKCU = &H80000001
Const HKLM = &H80000002

Dim objShell, objFSO, oReg, objRootFolder, psub, p
Dim objFolder, objLink, objFsub, linkpath, uid, objLnk

Set objShell = CreateObject("Wscript.Shell")
Set objFSO   = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")

If err.Number <> 0 Then
    wscript.echo "error: computer is not accessible"
    wscript.Quit(1)
End If

oReg.GetExpandedStringValue HKLM, rKey, rVal, p
If VarType(p) = vbNull Then
    wscript.echo "error: registry key not found"
    wscript.Quit(1)
End If

Set objRootFolder = objFSO.GetFolder(p)

wscript.echo ""
wscript.echo ""
For each objFolder in objRootFolder.SubFolders
    uid = objFolder.Name
    psub = p & "\" & uid & "\desktop"
    If objFSO.FolderExists(psub) Then
        wscript.echo vbTab & ""
        Set objFsub = objFSO.GetFolder(psub)
        For each objLink in objFsub.Files
            If InStr(1, ".lnk .url", Lcase(Right(objLink.Name,4))) <> 0 Then
                wscript.echo vbTab & vbTab & ""
                linkpath = psub & "\" & objLink.Name
                Set objLnk = objShell.CreateShortcut(linkpath)
                Select Case Lcase(Right(linkpath,4))
                    Case ".lnk":
                        ClosedTag 3, "name", objLnk.Name
                        ClosedTag 3, "fullname", objLnk.FullName
                        ClosedTag 3, "arguments", objLnk.Arguments
                        ClosedTag 3, "working", objLnk.WorkingDirectory
                        ClosedTag 3, "target", objLnk.TargetPath
                        ClosedTag 3, "icon", objLnk.IconLocation
                        ClosedTag 3, "hokey", objLnk.Hotkey
                        ClosedTag 3, "windowstyle", objLnk.WindowStyle
                        ClosedTag 3, "description", objLnk.Description
                        ClosedTag 3, "type", "filesystem"
                    Case ".url":
                        ClosedTag 3, "name", objLnk.Name
                        ClosedTag 3, "fullname", objLnk.FullName
                        ClosedTag 3, "target", objLnk.TargetPath
                        ClosedTag 3, "type", "internet"
                End Select
                wscript.echo vbTab & vbTab & ""
            End If
        Next
        wscript.echo vbTab & ""
    End If
Next
wscript.echo ""

Sub ClosedTag(indent, label, val)
    Dim i, s : s = ""
    For i = 1 to indent
        s = s & vbTab
    Next
    If Trim(val) = "" Then
        s = s & "<" & label & ">_"
    Else
        s = s & "<" & label & ">" & val & ""
    End If
    wscript.echo s
End Sub

Set objFolder = Nothing
Set objFSO = Nothing
Set objShell = Nothing