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

2011-10-04 Thread 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.
___
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


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

2011-10-04 Thread Sven Barth

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
___
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


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

2011-10-04 Thread Reinier Olislagers
On 4-10-2011 12:31, Sven Barth wrote:
 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
___
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal