visual-studio-2010 - 如何在 MSI 安装程序创建的快捷方式上设置 "Run as administrator"标志

Question

我在 Visual Studio 2010 中有一个安装和部署项目。

我希望安装程序在我的解决方案中为另一个项目的可执行文件创建两个快捷方式。一个普通的快捷方式使用当前凭据简单地运行应用程序，另一个使用 以管理员身份运行 标志设置，从而确保在单击快捷方式时要求用户提供具有管理权限的凭据。



以管理权限运行应用程序可启用某些在其他情况下不可用的功能。

乍一看似乎不可能设置此标志。这可以直接在 Visual Studio 中完成吗？如果没有，还有其他选择吗？

编辑:如果没有，是否可以使用自定义安装程序类以编程方式修改快捷方式？

Answer 1

我知道这是一个很老的问题，但我需要找到答案，我想我可以帮助其他搜索者。我写了一个小函数来在 VBScript 中执行这个任务(粘贴在下面)。它很容易适应 VB.net/VB6。

从函数返回代码:
0 - 成功，更改快捷方式。
99 - 快捷方式标志已设置为以管理员身份运行。
114017 - 找不到文件
114038 - 数据文件格式无效(特别是文件太小)
所有其他非零 = 意外错误。

正如 Chada 在后面的帖子中提到的，这个脚本不适用于 msi Advertised 快捷方式。如果您使用此方法来操作快捷方式中的位，则它必须是标准的、未公开的快捷方式。

引用:
MS快捷方式LNK格式:http://msdn.microsoft.com/en-us/library/dd871305
一些灵感:Read and write binary file in VBscript

请注意，该函数不会检查有效的 LNK 快捷方式。事实上，你可以给它任何文件，它会改变文件中的十六进制字节 15h 以将第 32 位设置为打开。

如果在修改之前将原始快捷方式复制到 %TEMP%。

达兹。

'# D.Collins - 12:58 03/09/2012
'# Sets a shortcut to have the RunAs flag set.  Drag an LNK file onto this script to test

Option Explicit

Dim oArgs, ret

Set oArgs = WScript.Arguments

If oArgs.Count > 0 Then
    ret = fSetRunAsOnLNK(oArgs(0))
    MsgBox "Done, return = " & ret
Else
    MsgBox "No Args"
End If

Function fSetRunAsOnLNK(sInputLNK)
    Dim fso, wshShell, oFile, iSize, aInput(), ts, i
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wshShell = CreateObject("WScript.Shell")
    If Not fso.FileExists(sInputLNK) Then fSetRunAsOnLNK = 114017 : Exit Function
    Set oFile = fso.GetFile(sInputLNK)
    iSize = oFile.Size
    ReDim aInput(iSize)
    Set ts = oFile.OpenAsTextStream()
    i = 0
    Do While Not ts.AtEndOfStream
        aInput(i) = ts.Read(1)
        i = i + 1
    Loop
    ts.Close
    If UBound(aInput) < 50 Then fSetRunAsOnLNK = 114038 : Exit Function
    If (Asc(aInput(21)) And 32) = 0 Then 
        aInput(21) = Chr(Asc(aInput(21)) + 32)
    Else
        fSetRunAsOnLNK = 99 : Exit Function
    End If
    fso.CopyFile sInputLNK, wshShell.ExpandEnvironmentStrings("%temp%\" & oFile.Name & "." & Hour(Now()) & "-" & Minute(Now()) & "-" & Second(Now()))
    On Error Resume Next
    Set ts = fso.CreateTextFile(sInputLNK, True)
    If Err.Number <> 0 Then fSetRunAsOnLNK = Err.number : Exit Function
    ts.Write(Join(aInput, ""))
    If Err.Number <> 0 Then fSetRunAsOnLNK = Err.number : Exit Function
    ts.Close
    fSetRunAsOnLNK = 0
End Function