以管理员身份运行此程序2(或如何在必要时获取许可证UAC Admin)

问题描述

这是第二次尝试接收问题的答案:以如下方式运行该程序管理员(或如何在必要的时间获取许可证UAC Admin)

It is the second attempt to receive the answer on a question: Run this program as an administrator (Or how to get the licence UAC Admin during the necessary moment)

很遗憾，我还没有时间编辑第一个问题，一个主题已经结束.我很抱歉，但是我的英语很不好，因此我很难解释我想要的，尤其是在技术问题中:_(

Unfortunately I have not had time to edit the first question and a theme have closed.Very much I apologise, but my English very bad, therefore it is very difficult to me to explain that I want, especially in technical questions :_(

这次，我再举一个具体的例子，对我来说是必要的.

I try once again, this time with a concrete example, that it is necessary for me.

DelphiXe，Win7x64.Windows Uac已打开.用户使用管理员的权限进行工作.

DelphiXe, Win7x64. Windows Uac is On. The user works with the rights of the Administrator.

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

The program (example) which should copy files from one place in another is given.She should be started by usual way (not on behalf of the Admin). Therefore gluing to a manifes(*.rc) EXE-file (which grants the rights of the Admin - requests at start more truly) is not required.Copying should be carried out by usual way - the rights of Admin should be requested only in case of need and without restart of the program.

问题(在代码中标记为"*"):1.如何定义系统中是否存在Windows UAC以及是否已启用2.仅在需要的情况下如何获取管理权限的许可证(以推断出消息Windows UAC)，并且实际上是在不重新启动程序的情况下获得该许可证的

Problem (in a code are marked "*"):1. How to define that Windows UAC is present at system and whether it is Enabled2. How to get the licence of Admin right (to deduce message Windows UAC) only in case of need and actually to get this licence for the program not restarting it

示例-文件管理器远距离管理器"(或总指挥官")可以这样做-他们在正常启动时复制文件(不代表管理员)，并且仅在业务涉及系统文件夹时才引起查询UAC.因此程序不会重新启动，并且首先给出了预防措施.

Example - file managers 'Far manager' (or 'Total Commander') can so to do - they copy files at usual start (not on behalf of the Admin), and cause inquiry UAC only when business concerns system folders. Thus programs are not restarted and at first give out the prevention.

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

P.S. It is grateful for the help and editing of my posts.

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.

例如，正常复制

来自d:\ MyTest.txt，位于e:\ MyNew.txt

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

例如，带有问询UAC的消息应出现在

And the message with inquiry of rights UAC should to appear for example at

来自c:\ Windows \ MyNew.txt中的d:\ MyTest.txt

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

推荐答案

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

You can check if UAC is active using this function

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;

您可以使用以下功能运行提升的流程:

You can run an elevated process using the following function:

...

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;

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

To run an elevated, hidden process and wait for it to exit:

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

希望这会有所帮助

这篇关于以管理员身份运行此程序2(或如何在必要时获取许可证UAC Admin)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！