Wednesday, November 6, 2013

Programmatically Create a Shortcut and Run It As Administrator

I've recently ran into major problems getting a *.bat (DOS Batch) file generated on-the-fly by a web service I wrote to call another program on the same computer that is running the web service. The *.bat file generates a *.rsp file containing a bunch of input parameters and passes it to the program I want to run. On Windows XP there was no problem but on windows 7, the *.bat files needs more special commission. It didn't even matter that I was signed in as an administrator. The Bat file is not able to run properly. Then I discovered if I run the *.bat file "as administrator" by right-click on the *.bat file in windows Explorer the *.bat file runs just as I intended. Somehow I had to get my web service to run the *.bat file "as administrator". This was much more difficult to find an answer than I thought. I found out that if I create a short-cut to the *.bat file and run that shortcut "as administrator" it would work perfectly. Fortunately, it's possible to programmatically to both create the shortcut on the fly and set "the run Administrator" flag for the shortcut from my web service. My solution is based on the following article:

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


        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
        If UBound(aInput) < 50 Then fSetRunAsOnLNK = 114038 : Exit Function
        If (Asc(aInput(21)) And 32) = 0 Then
            aInput(21) = Chr(Asc(aInput(21)) + 32)
            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
        fSetRunAsOnLNK = 0
    End Function

Where path2file is the path to the shortcut.

No comments: