Question

可能重复：
Run this program as an administrator (Or how to get the licence UAC Admin during the necessary moment)

这是第二次尝试接收问题的答案：Run this program as an administrator (Or how to get the licence UAC Admin during the necessary moment)

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

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

DelphiXe，Win7x64。 Windows Uac已开启。用户使用管理员的权限。

应该给出应该从另一个地方复制文件的程序（示例）。她应该以通常的方式（不是代表管理员）开始。因此，不需要粘贴到显示（*。rc）EXE文件（授予管理员权限 - 更真实地启动请求）。复制应以通常的方式进行 - 只有在需要时才需要管理员的权利，并且不需要重新启动程序。

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

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

P.S。非常感谢帮助和编辑我的帖子。

程序：表单，一个按钮，opendialog，savedialog

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.

复制将是正常的，例如在

来自e：\ MyNew.txt

中的d：\ MyTest.txt

并且询问权利UAC的消息应该出现在例如

来自c：\ Windows \ MyNew.txt

中的d：\ MyTest.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]);

希望这有帮助

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

程序：表单，一个按钮，opendialog，savedialog

1 个答案: