[fpc-pascal] fcl-extra ServiceManager doesn't seem to working with unelevated Windows account?

Reinier Olislagers reinierolislagers at gmail.com
Tue Oct 4 12:22:50 CEST 2011


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.



More information about the fpc-pascal mailing list