Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-pascal / 2011-10

fcl-extra ServiceManager doesn't seem to working with unelevated Windows account?

3 messages · 2 people ·

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

Reinier Olislagers

Hi list,

First wanted to check with you if I'm doing something wrong. Using the ServiceManager unit (Windows only), I'm trying to find out if a service is running (Vista x64).
I can do:
sc query samss
on the command line without problem.
When I run
fpc ServiceTest.pas
rem Free Pascal Compiler version 2.7.1 [2011/10/04] for i386 ServiceTest
I get:
Starting test for SamSs service.
An unhandled exception occurred at $0041FAD5 :
EOSError : System error, (OS Code 5):
Access is denied.

$0041FAD5
$00421333
$0040162B
$004017C1
When I run the same program using an elevated (administrator) command prompt, I get:
Starting test for SamSs service.
The SamSs service is running

Am I doing something wrong?

Program below can also be found on wiki:
http://wiki.lazarus.freepascal.org/ServiceManager

program ServiceTest;
// Check if a certain process is running.
{$mode objfpc}{$H+}
uses
  Classes,
  SysUtils,
  ServiceManager,
  JwaWinSvc {for services declarations};
function IsServiceRunning(ServiceName: string): boolean;
  {description Checks if a Windows service is running}
var
  Services: TServiceManager;
  ServiceStatus: TServiceStatus;
begin
  //Check for existing services
  //equivalent to sc query <servicename>
  Services := TServiceManager.Create(nil);
  try
    try
      Services.Connect;
      Services.Acces := SC_MANAGER_CONNECT; //Note typo in property.
      //We don't need more access permissions than this; by default
      //the servicemanager is trying to get all access
      Services.GetServiceStatus(ServiceName, ServiceStatus);
      if ServiceStatus.dwCurrentState = SERVICE_RUNNING then
      begin
        Result := True;
      end
      else
      begin
        Result := False;
      end;
      Services.Disconnect;
    except
      on E: EServiceManager do
      begin
        // A missing service might throw a missing handle exception? No?
      {LogOutput('Error getting service information for ' + ServiceName +
        '. Technical details: ' + E.ClassName + '/' + E.Message);}
        Result := False;
        raise; //rethrow original exception
      end;
      on E: Exception do
      begin
      {LogOutput('Error getting service information for ' + ServiceName +
        '. Technical details: ' + E.ClassName + '/' + E.Message);
        }
        Result := False;
        raise; //rethrow original exception
      end;
    end;
  finally
    Services.Free;
  end;
end;
const
  ServiceToTest = 'SamSs';
//Security Accounts Manager, should be running, at least on Vista
begin
  WriteLn('Starting test for ' + ServiceToTest + ' service.');
  if IsServiceRunning(ServiceToTest) then
  begin
    WriteLn('The ' + ServiceToTest + ' service is running');
  end
  else
  begin
    WriteLn('The ' + ServiceToTest + ' service is not running');
  end;
end.

Reply by email

Sven Barth
to Reinier Olislagers
Reinier Olislagers wrote
Services.Connect; Services.Acces := SC_MANAGER_CONNECT; //Note typo in property.

You need to set "Acces(s)", before calling "Connect", because the connection API "OpenSCManager" is called inside "Connect" using the access flags that were set.

At least that's the only problem I see without testing it myself.

Regards,
Sven

Reply by email

Reinier Olislagers
to Sven Barth
Sven Barth wrote 12 lines
Am 04.10.2011 12:22, schrieb Reinier Olislagers: > Services.Connect; > Services.Acces := SC_MANAGER_CONNECT; //Note typo in property. You need to set "Acces(s)", before calling "Connect", because the connection API "OpenSCManager" is called inside "Connect" using the access flags that were set. At least that's the only problem I see without testing it myself. Regards, Sven

Thanks, Sven,

Another "duh" moment. I had even already commented that Connect is trying to request all possible access by default.

It works now.

Regards,
Reinier

Reply by email