[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