如何将UAC集成到我的VB6程序中？

Question

我需要一些代码,将管理员权限图标添加到命令按钮,并在单击这些按钮时显示提示.我怎么能在VB6中这样做？某些操作需要管理员权限,因为它们会替换Windows Vista/7不允许程序正常访问文件的文件和内容.

Answer 1

这是ShellExecuteEx的VB6示例,它允许您选择性地执行具有管理员权限的任何进程.您可以将其放入模块或类中.

Option Explicit

Private Const SEE_MASK_DEFAULT = &H0

Public Enum EShellShowConstants
        essSW_HIDE = 0
        essSW_SHOWNORMAL = 1
        essSW_SHOWMINIMIZED = 2
        essSW_MAXIMIZE = 3
        essSW_SHOWMAXIMIZED = 3
        essSW_SHOWNOACTIVATE = 4
        essSW_SHOW = 5
        essSW_MINIMIZE = 6
        essSW_SHOWMINNOACTIVE = 7
        essSW_SHOWNA = 8
        essSW_RESTORE = 9
        essSW_SHOWDEFAULT = 10
End Enum

Private Type SHELLEXECUTEINFO
        cbSize        As Long
        fMask         As Long
        hwnd          As Long
        lpVerb        As String
        lpFile        As String
        lpParameters  As String
        lpDirectory   As String
        nShow         As Long
        hInstApp      As Long
        lpIDList      As Long     'Optional
        lpClass       As String   'Optional
        hkeyClass     As Long     'Optional
        dwHotKey      As Long     'Optional
        hIcon         As Long     'Optional
        hProcess      As Long     'Optional
End Type

Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpSEI As SHELLEXECUTEINFO) As Long

Public Function ExecuteProcess(ByVal FilePath As String, ByVal hWndOwner As Long, ShellShowType As EShellShowConstants, Optional EXEParameters As String = "", Optional LaunchElevated As Boolean = False) As Boolean
    Dim SEI As SHELLEXECUTEINFO

    On Error GoTo Err

    'Fill the SEI structure
    With SEI
        .cbSize = Len(SEI)                  ' Bytes of the structure
        .fMask = SEE_MASK_DEFAULT           ' Check MSDN for more info on Mask
        .lpFile = FilePath                  ' Program Path
        .nShow = ShellShowType              ' How the program will be displayed
        .lpDirectory = PathGetFolder(FilePath)
        .lpParameters = EXEParameters       ' Each parameter must be separated by space. If the lpFile member specifies a document file, lpParameters should be NULL.
        .hwnd = hWndOwner                   ' Owner window handle

        ' Determine launch type (would recommend checking for Vista or greater here also)
        If LaunchElevated = True Then ' And m_OpSys.IsVistaOrGreater = True
            .lpVerb = "runas"
        Else
            .lpVerb = "Open"
        End If
    End With

     ExecuteProcess = ShellExecuteEx(SEI)   ' Execute the program, return success or failure

    Exit Function
Err:
    ' TODO: Log Error
    ExecuteProcess = False
End Function

Private Function PathGetFolder(psPath As String) As String
    On Error Resume Next
    Dim lPos As Long
    lPos = InStrRev(psPath, "\")
    PathGetFolder = Left$(psPath, lPos - 1)
End Function

Answer 2

代码示例确实可以继续运行，但这里有一个简单的示例，展示了“我的第二个实例”方法。

该程序有一个带有一些公共函数的启动静态模块，包括一个“提升操作”处理程序，以及一个只有一个命令按钮的表单：

模块1.bas

Option Explicit

Private Const BCM_SETSHIELD As Long = &H160C&

Private Declare Sub InitCommonControls Lib "comctl32" ()

Private Declare Function IsUserAnAdmin Lib "shell32" () As Long

Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long

Private Declare Function ShellExecute Lib "shell32" _
    Alias "ShellExecuteA" ( _
    ByVal hWnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As VbAppWinStyle) As Long

Private mblnIsElevated As Boolean

Public Function IsElevated() As Boolean
    IsElevated = mblnIsElevated
End Function

Public Sub OperationRequiringElevation(ByRef Params As Variant)
    MsgBox "Insert logic here for: " & vbNewLine _
         & Join(Params, vbNewLine)
End Sub

Public Sub RequestOperation( _
    ByVal hWnd As Long, _
    ByVal Focus As VbAppWinStyle, _
    ByRef Params As Variant)

    ShellExecute hWnd, "runas", App.EXEName & ".exe", _
                 Join(Params, " "), CurDir$(), Focus
End Sub

Public Sub SetShield(ByVal hWnd As Long)
    SendMessage hWnd, BCM_SETSHIELD, 0&, 1&
End Sub

Private Sub Main()
    If Len(Command$()) > 0 Then
        'Assume we've been run elevated to execute an operation
        'specified as a set of space-delimited strings.
        OperationRequiringElevation Split(Command$(), " ")
    Else
        mblnIsElevated = IsUserAnAdmin()
        InitCommonControls
        Form1.Show
    End If
End Sub

表格1.frm

Option Explicit

Private Sub Command1_Click()
    Dim Params As Variant

    Params = Array("ReplaceFile", "abc", "123")
    If IsElevated() Then
        OperationRequiringElevation Params
    Else
        RequestOperation hWnd, vbHide, Params
    End If
End Sub

Private Sub Form_Load()
    If Not IsElevated() Then
        SetShield Command1.hWnd
    End If
End Sub

该应用程序有一个简单的“asInvoker”清单，用于选择 Common Controls 6.0 程序集。