'RDSCompatibilityUsingAppV - Create short cut to run under App-V

Option Explicit
Dim WS, FSO, ObjRegistry, Title, SftApp, SourceApp, DestPath, SourceAppExtn, SftTrayRegDataName, HKLM, RegValueName, RegValueData, SourceAppIcon
Dim NoOfArgs,  WrongArgs, HelpString, intCompare1, intCompare2, ClearLog, ResetErrorLevel, QueryClient, FindResult,  LoadDefaultApp, Usage, ArgsString
Dim objFile, found, colMatches, strSearchString, TempFolder, count, loadMatches, isLoaded, shortcutPath, DefaultAppName, NamedArguments, UnnamedArguments

'Set required objects.
Set WS = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ObjRegistry = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Set NamedArguments = WScript.Arguments.Named
Set UnnamedArguments = WScript.Arguments.Unnamed

NoOfArgs = UnnamedArguments.Length

Title = "RDS Compatibility Using App-V"
'Help String.
Usage = "Usage"  & vbCrLf & vbCrLf &_
        "RDS Compatibility Using App-V for Applications" & vbCrLf &_
        "    WScript RDSCompatibilityUsingAppV.vbs Executable [ShortcutPath]" & vbCrLf &_ 
        "          Executable - Path of the executable" & vbCrLf &_
        "          ShortcutPath - Folder path for Shortcut creation" & vbCrLf &_
        "Help" & vbCrLf & "    WScript RDSCompatibilityUsingAppV.vbs /Help" & vbCrLf & vbCrLf &_ 
        "Switches " & vbCrLf &_
        "/d:DefaultAppName" & vbCrLf &_
        "          DefaultAppName - Name of the Default Softgrid Application Published" & vbCrLf & vbCrLf

'If user doesn't provide any arguments then show help.
If (NoOfArgs = 0) Then
    MsgBox Usage, 0, Title
    WScript.Quit
End If

'Show help on /Help or /? option or if he provides more than 2 arguments.
HelpString = UnnamedArguments.Item(NoOfArgs-1)
intCompare1 = StrComp(HelpString, "/Help", vbTextCompare)
intCompare2 = StrComp(HelpString, "/?", vbTextCompare)
If ((intCompare1 = 0)  OR (intCompare2 = 0) OR (NoOfArgs > 2)) Then
    MsgBox Usage, 0, Title
    WScript.Quit
End If

'Check if the DefaultAppName is provided by the user, if not use Default SoftGrid Application
If (NamedArguments.Length > 0) Then
    If ((NamedArguments.Length > 1)  OR ( NOT NamedArguments.Exists("d"))) Then
        MsgBox Usage, 0, Title
        WScript.Quit
    End If
    DefaultAppName = NamedArguments.Item("d")
Else
    DefaultAppName = "Default SoftGrid Application"
End If


'Read the Source and destination for creating short cut.
'SourceApp - The executable that needs a shourtcut.
'Folder path for shortcut creation.
SourceApp = UnnamedArguments.Item(0)
SourceAppIcon = SourceApp

If (NoOfArgs = 1) Then
    DestPath = WS.SpecialFolders("Desktop")
Else
    DestPath = UnnamedArguments.Item(1)
    'If the shortcut creation path is invalid then it will be defaulted to desktop.
    If NOT FSO.FolderExists(DestPath) Then
        MsgBox "Shortcut creation path is not valid, so creating the shortcut on desktop.", 48, Title
        DestPath = WS.SpecialFolders("Desktop")
    End If
End If

'We accept only exe, cmd and bat files. Any other format is not supported.
If FSO.FileExists(SourceApp) Then
    SourceAppExtn = FSO.GetExtensionName(SourceApp)
    SourceApp = Chr(34) & FSO.GetAbsolutePathName(SourceApp) & Chr(34)
    If NOT ((StrComp(SourceAppExtn, "exe", vbTextCompare) = 0) OR (StrComp(SourceAppExtn, "cmd", vbTextCompare) = 0) OR (StrComp(SourceAppExtn, "bat", vbTextCompare) = 0)) Then
        MsgBox "The Script supports only exe, cmd and bat executables.", 48, Title
        Cleanup
    End If
Else
    MsgBox "The executable provided for shortcut creation doesn't exist.", 48, Title
    Cleanup
End If

'Check for SoftGrid 4.5 installation in x86 or x64 machines. Also save the sfttray.exe path into SftApp.
HKLM = &H80000002
RegValueName = ""
SftTrayRegDataName = "Software\Microsoft\Windows\CurrentVersion\App Paths\Sfttray.exe"
ObjRegistry.GetStringValue HKLM, SftTrayRegDataName, RegValueName, RegValueData
If IsNull(RegValueData) Then
    SftTrayRegDataName = "Software\Microsoft\Windows\Wow6432Node\CurrentVersion\App Paths\Sfttray.exe"
    ObjRegistry.GetStringValue HKLM, SftTrayRegDataName, RegValueName, RegValueData
    If IsNull(RegValueData) Then
        MsgBox "SoftGrid Client 4.5 should be installed to use this script.", 48, Title
        Cleanup
    End If
End If

SftApp = Chr(34) & RegValueData & Chr(34)

'Temp file is used to store the Sftmime query date intermediately. Delete this if already exists.
Const TemporaryFolder = 2
TempFolder = FSO.GetSpecialFolder(TemporaryFolder)
If FSO.FileExists(TempFolder & "\tempRDSAppV.log") Then
    FSO.DeleteFile(TempFolder & "\tempRDSAppV.log")
    WScript.Sleep 2000
End If
'Query using Sftmime for list deployed apps and store the result in tempRDSAppV.log.
QueryClient = "sftmime query obj:app /log %temp%\tempRDSAppV.log"
WS.Run QueryClient
WScript.Sleep 3000

'Read the tempRDSAppV.log file to find whether the Default SoftGrid Application is published or not. 
Const ForReading = 1
found = false
isLoaded = false
Set objFile = FSO.OpenTextFile(TempFolder & "\tempRDSAppV.log", ForReading)
Do Until objFile.AtEndOfStream
    strSearchString = objFile.ReadLine
    strSearchString = Replace(strSearchString, vbTab, " ")
    colMatches = InStr(1, strSearchString, DefaultAppName)  
    If (colMatches >0) Then
        found = true
        loadMatches = InStr(1, strSearchString, "100%")
        If (loadMatches >0) Then
            isLoaded = true
        End If
        Exit Do
    End If            
Loop
objFile.Close
'Default SoftGrid Application is not deployed.
If Not (found AND isLoaded) Then
    MsgBox DefaultAppName & " is not published on the client. Please check the name and case of the application name if you have provided it via /d switch.", 48, Title
    Cleanup
End If

'Check if shortcut already exists. If it exists then append integer at the end of filename untill it is unique.
shortcutPath = DestPath & "\" & FSO.GetBaseName(SourceApp) & ".lnk"
For count = 0 To 100
    If FSO.FileExists(shortcutPath) Then
        shortcutPath = DestPath & "\" & FSO.GetBaseName(SourceApp) & "(" & count & ")" & ".lnk"
    Else
        Exit For
    End If
Next
'Create Shortcut with the name of the exe.lnk and save in destination folder.
'Set the Icon path path as exe path.
'Handled the Access denied error separately.
On Error Resume Next
For count = 0 To 1
    With WS.CreateShortcut(shortcutPath)
        .TargetPath = SftApp
        .Arguments = "/exe " & SourceApp & " /launch " & Chr(34)& DefaultAppName & Chr(34)
        .IconLocation = SourceAppIcon & ", 0"
        .Save 
    End With
Next
If Err <> 0 Then
    If Err.number = -2147024891 Then
        MsgBox "Access is denied. Creating shortcut in the specified Files required administrative privileges." &_
            vbCrLf & "Error Code: " & Hex(Err.number) & vbCrLf & "Source: " & Err.Source , 48, Title
        Err.Clear
    Else
        MsgBox Err.Description & vbCrLf & "Error Code: " & Hex(Err.number) & vbCrLf & "Source: " & Err.Source, 48, Title
        Err.Clear
    End If
Else
    MsgBox "Shortcut created at :" & shortcutPath, 0, Title
End If

Cleanup
'Reset the variables for cleanup.
Sub Cleanup
    Set WS = Nothing
    Set FSO = Nothing
    Set ObjRegistry = Nothing
    WScript.Quit
End Sub