How to set “Run as administrator” flag on shortcut created by MSI installer
Here is the code, I use.
'Create Shortcuts
Dim VbsObj As Object
VbsObj = CreateObject("WScript.Shell")
Dim MyShortcut As Object
MyShortcut = VbsObj.CreateShortcut(pathe2file & "\GetFVSstand" & ".lnk")
MyShortcut.TargetPath = pathe2file & "\GetFVSstand.bat"
MyShortcut.WorkingDirectory = pathe2file
MyShortcut.Save()
Dim ret As Integer
ret = fSetRunAsOnLNK(pathe2file & "\GetFVSstand" & ".lnk")
Public Function fSetRunAsOnLNK(ByVal sInputLNK As String)
Dim fso As Object, wshShell, oFile, iSize, aInput(), ts, i
fso = CreateObject("Scripting.FileSystemObject")
wshShell = CreateObject("WScript.Shell")
If Not fso.FileExists(sInputLNK) Then fSetRunAsOnLNK = 114017 : Exit Function
oFile = fso.GetFile(sInputLNK)
iSize = oFile.Size
ReDim aInput(iSize)
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
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
Where path2file is the path to the shortcut.
No comments:
Post a Comment