Я знаю, что это довольно старый вопрос, но мне нужно было найти ответ, и я подумал, что смогу помочь другим искателям. Я написал небольшую функцию для выполнения этой задачи в VBScript (вставлено ниже). Он легко адаптируется к VB.net / VB6.
Коды возврата из функции:
0 - успех, изменение ярлыка.
99 - флаг ярлыка уже установлен для запуска от имени администратора.
114017 - файл не найден
114038 - Недопустимый формат файла данных (в частности, файл слишком мал)
Все остальные ненулевые = непредвиденные ошибки.
Как упоминал Чада в более позднем посте, этот сценарий не будет работать на объявленных ярлыках MSI. Если вы используете этот метод для управления битами в ярлыке, это должен быть стандартный нерекламированный ярлык.
Ссылка:
Формат ярлыка MS LNK: http://msdn.microsoft.com/en-us/library/dd871305
Некоторое вдохновение: Чтение и запись двоичного файла в VBscript
Обратите внимание, что функция не проверяет правильность ярлыка LNK. Фактически, вы можете передать ему ЛЮБОЙ файл, и он изменит шестнадцатеричный байт 15h в файле, чтобы установить бит 32 в значение.
Если копировать исходный ярлык в% TEMP%, прежде чем вносить в него изменения.
Daz.
'# 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