Question

这是第二次尝试在一个问题上得到答案。我很抱歉，但我的英语非常糟糕，因此我很难解释我想要的，特别是在技术问题上：_（

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

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

我认为您需要使用提升的权限启动另一个进程（使用清单...）。这可以是单独的EXE，也可以是相同的EXE（可能带有一些适当的命令行参数）。

当然，对于最终用户，如果原始进程以某种方式“神奇地”获得了提升权限，那么看起来就像。

Answer 2

一旦进程以用户权限级别启动，此进程就无法获得管理员权限。这是必要的，因为权限级别是完整性级别的两倍。因此，您需要以某种方式启动新的提升流程或与现有的提升流程进行通信。

Answer 3

您可以使用此功能检查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]);

希望这有帮助

Answer 4

这个问题很难理解......因为毫无疑问。

根据您所写的内容，我猜您要执行一些需要管理员已过时权限的操作。

以管理员身份运行是不够的，以便能够执行所有操作。

UAC希望提升当前用户权利，即使他/她是本地管理员，也可以执行一些与安全相关的操作。

阅读this technical article from Microsoft，了解有关UAC如何运作的分步指导。

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

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

4 个答案: