如何在Delphi中运行具有管理员权限的命令？

Question

I am trying to stop mysql from Delphi XE2 on Win 7. I have written some code based on something I found on the web for Delphi 7, that was supposed to do this, but it doesn't work:

function StopMySQL: boolean;
const
  UserName = 'Mark';
  Domain = 'PC-Mark';
  Command = 'net stop mysql';
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;
  result := CreateProcessWithLogonW(Username, Domain, Password, 0, nil, Command, 0,     nil, nil, StartupInfo, ProcessInfo);
  if result then
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
end;

Does anyone know how to do this?

TIA Mark Patterson

Answer 1

Since Vista you will need an elevated access to start/stop a service.
One simple way would be to use RunAs with Shellexecute(Ex).

ShellExecute(handle,'RunAs','net','stop mysql',nil,sw_Show);

The better way would be using a manifest, which could look like this:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <dependency>
    <dependentAssembly>
      <assemblyIdentity
        type="win32"
        name="Microsoft.Windows.Common-Controls"
        version="6.0.0.0"
        publicKeyToken="6595b64144ccf1df"
        language="*"
        processorArchitecture="*"/>
    </dependentAssembly>
  </dependency>
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
    <security>
      <requestedPrivileges>
       <requestedExecutionLevel level="requireAdministrator" />
      </requestedPrivileges> 
    </security>
  </trustInfo>
</assembly>

a minimum solution, no need of "net", could look like this, there should be more done, eg. testing if the service is running, but thats ut to you and can be done wit WinSvc to:

implementation
uses WinSvc;
{$R *.dfm}
{$R administrator.res}

function ServiceStop(Machine, ServiceName: string): Boolean;

var
  ServiceControlManager, ServiceHandle: SC_Handle;
  ServiceStatus: TServiceStatus;
  dwCheckPoint: DWORD;
begin
  ServiceControlManager := OpenSCManager(PChar(Machine), nil, SC_MANAGER_CONNECT);
  if ServiceControlManager > 0 then
  begin
    ServiceHandle := OpenService(ServiceControlManager, PChar(ServiceName),
      SERVICE_STOP or SERVICE_QUERY_STATUS);
    if ServiceHandle > 0 then
    begin
      if (ControlService(ServiceHandle, SERVICE_CONTROL_STOP, ServiceStatus)) then
      begin
        if (QueryServiceStatus(ServiceHandle, ServiceStatus)) then
        begin
          while (SERVICE_STOPPED <> ServiceStatus.dwCurrentState) do
          begin
            dwCheckPoint := ServiceStatus.dwCheckPoint;
            Sleep(ServiceStatus.dwWaitHint);
            if (not QueryServiceStatus(ServiceHandle, ServiceStatus)) then
              break;
            if (ServiceStatus.dwCheckPoint < dwCheckPoint) then
              break;
          end;
        end;
      end;
      CloseServiceHandle(ServiceHandle);
    end;
    CloseServiceHandle(ServiceControlManager);
  end;

  Result := (SERVICE_STOPPED = ServiceStatus.dwCurrentState);
end;

procedure TForm2.Button1Click(Sender: TObject);

begin
   If ServiceStop('','mysql') then Showmessage('Service Stopped')
   else Showmessage('Nope');
end;

Administrator res can be created by

• saving the above show XML-Code as administrator.manifest
• creating as file administrator.rc with the content

1 24 "administrator.manifest"

• running

brcc32 administrator.rc

using the created administrator.res will require:

1. disabling runtime themes on newer delphi versions, the are contained in the manifest
2. removing XPMan from an existing project (component and code, contained in the manifest)
3. If you need to debug the application, delphi has to be started as Administraor too.

Source and anything needed for the manifest can be downloaded here

Answer 2

What I ended up doing is this:

uses WinApi, ShellApi;

function StartStopDatabase(start: boolean): integer;
var
  Info: TShellExecuteInfo;
  verb: string;
  ExitCode: DWORD;
begin
  Result := -1;
  if start
    then verb := 'start'
    else verb := 'stop';
  FillChar(Info, SizeOf(Info), 0);
  Info.cbSize := SizeOf(TShellExecuteInfo);
  Info.fMask := SEE_MASK_NOCLOSEPROCESS;
  Info.Wnd := Application.Handle;
  Info.lpVerb := 'RunAs';
  Info.lpFile := 'net';
  Info.lpParameters := PWideChar(verb + ' mysql');
  Info.nShow := SW_SHOW;
  if ShellExecuteEx(@Info) then begin
    repeat
      Sleep(100);
      Application.ProcessMessages;
      GetExitCodeProcess(Info.hProcess, ExitCode);
    until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
    Result := ExitCode;
  end;
end;