以管理员身份运行此程序2（或者如何在必要的时候获得UAC Admin许可证）

Question

可能的重复：
运行此命令以管理员身份运行程序（或者如何在必要的时候获得 UAC Admin 许可证）

这是第二次尝试接收问题的答案：以管理员身份运行此程序（或如何在必要时获取 UAC Admin 许可证）

不幸的是，我没有时间编辑第一个问题，主题已经关闭。 我非常抱歉，但我的英语很差，因此我很难解释我想要的，特别是在技术问题上:_(

我再次尝试，这次用一个具体的例子，这对我来说是必要的。

DelphiXe，Win7x64。用户以管理员权限工作。

给出了从一个地方复制文件到另一个地方的程序（示例）。 她应该以通常的方式启动（不代表管理员）。因此，不需要粘合到 manifes(*.rc) EXE 文件（它授予管理员权限 - 更真实地请求启动时）。 复制应按常规方式进行 - 仅在需要时才应请求管理员权限，且无需重新启动程序。

问题（在代码中标有“*”）： 1. 如何定义Windows UAC存在于系统中以及是否启用 2. 如何仅在需要时获得管理员权限的许可证（以推断消息 Windows UAC），并且实际上为程序获得此许可证而不重新启动它

示例 - 文件管理器“Far manager”（或“Total Commander”）可以这样做 - 他们在正常启动时复制文件（不代表管理员），并且仅当业务涉及系统文件夹时才引起UAC查询。因此，程序不会重新启动，并且首先会给出预防措施。

PS 感谢您对我的帖子的帮助和编辑。

程序：表单、一键式、opendialog、saveddialog

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    OpenDialogFROM: TOpenDialog;
    Button1: TButton;
    SaveDialogTO: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Function TestPathWrite(path:string):bool;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function IsWindowsUAC_Enabled:bool; // Test Windows UAC turn on (*)
begin
Result:=false;
// ????
// How to define, whether function UAC is included in system - enabled (we will admit, that we work in OS is more senior XP)
end;

Function TurnOnAdminRight:bool; // To activate the rights of the Administrator to operation (*)
begin
Result:=false;
// ????
// How to activate message Windows UAC (approximately "To allow to make to this program changes to the computer?" or something similar)
// and to get the licence of the Administrator for this program?
end;

Function TForm1.TestPathWrite(path:string):bool;
var f:file;Err:integer;
begin
Result:=false;assignfile(f,IncludeTrailingPathDelimiter(path)+'$$TestFile$$.tmp');
{$I-}
Rewrite(f);
{$I+}
Err:=IoResult;
If Err<>0 then begin
   if Err=5 then begin // Access denided
      if IsWindowsUAC_Enabled then // Windows UAC is ON
         if TurnOnAdminRight=True then TestPathWrite(path); // Repeated check, else exit whith error message
   end;
Showmessage('Error write to path: '+path+', Error: '+inttostr(Err));
Exit;
end;
CloseFile(f);Erase(f);Result:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
// Test procedure by which it can be demanded the rights of the Administrator
// It also could be record procedure in windows register or another by which the rights can be demanded, and can't be demanded
// The problem to request the rights (and to include) only when they are necessary

if OpenDialogFROM.Execute then if SaveDialogTO.Execute then
if FileExists(OpenDialogFROM.FileName)=true then
if TestPathWrite(ExtractfilePath(SaveDialogTO.FileName))=true then
if CopyFile(Pchar(OpenDialogFROM.FileName),Pchar(SaveDialogTO.FileName),true)=true then
Showmessage('File: '+OpenDialogFROM.FileName+' it is successfully copied as: '+SaveDialogTO.FileName);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SaveDialogTo.Options:=[ofNoTestFileCreate,ofEnableSizing,ofDontAddToRecent]; // SaveDialog does not do check on record
end;

end.

复制将正常，例如在

From d:\MyTest.txt in e:\MyNew.txt

中，并且应出现询问权限 UAC 的消息，例如在

From d:\MyTest .txt 在 c:\Windows\MyNew.txt

Answer 1

您可以使用此功能检查 UAC 是否处于活动状态

interface

uses
  Registry, SysUtils;

function IsUACActive: Boolean;

implementation

function IsUACActive: Boolean;
var
  Reg: TRegistry;
begin
  Result := FALSE;

  // There's a chance it's active as we're on Vista or Windows 7. Now check the registry
  if CheckWin32Version(6, 0) then
  begin
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;

      if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System') then
      begin
        if (Reg.ValueExists('EnableLUA')) and (Reg.ReadBool('EnableLUA')) then
          Result := TRUE;
      end;
    finally
      FreeAndNil(Reg);
    end;
  end;
end;

您可以使用以下功能运行提升的进程：

...

interface

uses
  Windows, ShellAPI, Forms;

type
  TExecuteFileOption = (
    eoHide,
    eoWait,
    eoElevate
  );
  TExecuteFileOptions = set of TExecuteFileOption;

function ExecuteFile(Handle: HWND; const Filename, Paramaters: String; Options: TExecuteFileOptions): Integer;

implementation

function ExecuteFile(Handle: HWND; const Filename, Paramaters: String; Options: TExecuteFileOptions): Integer;
var
  ShellExecuteInfo: TShellExecuteInfo;
  ExitCode: DWORD;
begin
  Result := -1;

  ZeroMemory(@ShellExecuteInfo, SizeOf(ShellExecuteInfo));
  ShellExecuteInfo.cbSize := SizeOf(TShellExecuteInfo);
  ShellExecuteInfo.Wnd := Handle;
  ShellExecuteInfo.fMask := SEE_MASK_NOCLOSEPROCESS;

  if (eoElevate in Options) and (IsUACActive) then
    ShellExecuteInfo.lpVerb := PChar('runas');

  ShellExecuteInfo.lpFile := PChar(Filename);

  if Paramaters <> '' then
    ShellExecuteInfo.lpParameters := PChar(Paramaters);

  // Show or hide the window
  if eoHide in Options then
    ShellExecuteInfo.nShow := SW_HIDE
  else
    ShellExecuteInfo.nShow := SW_SHOWNORMAL;

  if ShellExecuteEx(@ShellExecuteInfo) then
    Result := 0;

  if (Result = 0) and (eoWait in Options) then
  begin
    GetExitCodeProcess(ShellExecuteInfo.hProcess, ExitCode);

    while (ExitCode = STILL_ACTIVE) and
          (not Application.Terminated) do
    begin
      sleep(50);

      GetExitCodeProcess(ShellExecuteInfo.hProcess, ExitCode);
    end;

    Result := ExitCode;
  end;
end;

运行提升的隐藏进程并等待其退出：

ExecuteFile(Self.Handle, 'Filename', 'Parameters', [eoHide, eoWait, eoElevate]);

希望这会有所帮助