我需要一些代码，将管理员权限图标添加到命令按钮，并在单击此类按钮时显示提示。我怎么能在VB6中这样做？某些操作需要管理员权限，因为它们会替换Windows Vista / 7不允许程序正常访问文件的文件和内容。
答案 0 :(得分：7)
这是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
答案 1 :(得分：4)
代码示例可以真正运行，但这里有一个显示“我的第二个实例”方法的简单例子。
该程序有一个启动静态模块，其中包含一些公共函数，包括“提升操作”处理程序和一个只有一个CommandButton的Form：
Module1.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
Form1.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程序集。
答案 2 :(得分：1)
首先，获取有人单击按钮时运行的代码，并将其放在单独的exe中。更改按钮单击代码以使用ShellExecute启动exe。其次，为每个新exe构建外部清单，并指定requireAdministrator。第三，向您的按钮发送BCM_SETSHIELD消息（您可能需要查找消息ID的数值）以使屏蔽显示在它们上面。
答案 3 :(得分：1)
为了强制Vista及更高版本在UAC中以管理员身份运行VB6 exe，您必须将清单xml作为资源嵌入其中。步骤如下;
创建清单文件。将其命名为“YourProgram.exe.manifest”，它应包含以下内容。重要的一行是“requestedExecutionLevel”。更改属性以匹配您的exe。
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" processorArchitecture="X86" name="YourProgram" type="win32" > <description>application description</description> <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2"> <security <requestedPrivileges> <requestedExecutionLevel level="requireAdministrator" uiAccess="false"/> </requestedPrivileges> </security> </trustInfo> </assembly>
创建名为“YourProgram.exe.manifest.rc”的文件。它应包含以下内容。
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define RT_MANIFEST 24 CREATEPROCESS_MANIFEST_RESOURCE_ID
RT_MANIFEST“YourProgram.exe.manifest”
使用rc.exe编译资源。它默认位于C：\ Program Files \ Microsoft Visual Studio \ COMMON \ MSDev98 \ Bin中。这将创建一个名为YourProgram.exe.manifest.RES的文件。语法是;
rc /r YourProgram.exe.manifest.rc
将.RES文件添加到项目中。使用VB6中的资源编辑器加载项执行此操作。工具栏上的图标看起来像绿色块。如果您没有该图标，请确保在插件管理器中启用该图标。如果它不在插件管理器中，则需要在C：\ Program Files \ Microsoft Visual Studio \ VB98 \ Wizards \ Resedit.dll上使用regsvr32。打开资源编辑器后，单击“打开”并选择.RES文件。
编译项目。
要仔细检查清单是否已正确嵌入，您可以使用名为InspectExe的工具。在资源管理器中，转到exe的属性，如果嵌入了清单，则应该有一个清单选项卡（.Net程序集也将具有此清单选项卡）。
尝试在Vista或更高版本上运行程序。如果确实启用了UAC，它应该立即提出提示。