Hi all,
I'm working on a wrapper around UltraVNC and stunnel for SSL/TLS enabled remote support using a reverse connection.
See
https://bitbucket.org/reiniero/checkrideI'm trying to find out whether a service (the UltraVNC) service is running, and I've used the ServiceManager unit for that, which doesn't work for me. I found another implementation on the net that does seem to work.
Please tell me if my code below is correct. If so, there's probably a bug somewhere in the FPC library code...
program ServiceTest;
// Tests ServiceManager code in FreePascal,
// which doesn't seem to work.
// Code checks if a certain process is running.
// For comparison, another implementation is used.
{$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.GetServiceStatus(ServiceName, ServiceStatus);
if ServiceStatus.dwCurrentState = SERVICE_RUNNING then
begin
Result := True;
end
else
begin
Result := False;
end;
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;
// Replacement code for faulty fpc services code from
//http://www.chami.com/tips/delphi/031498D.html
//-------------------------------------
// get service status
// return status code if successful
// -1 if not
// return codes:
// SERVICE_STOPPED
// SERVICE_RUNNING
// SERVICE_PAUSED
// following return codes
// are used to indicate that
// the service is in the
// middle of getting to one
// of the above states:
// SERVICE_START_PENDING
// SERVICE_STOP_PENDING
// SERVICE_CONTINUE_PENDING
// SERVICE_PAUSE_PENDING
// sMachine:
// machine name, ie: \SERVER
// empty = local machine
// sService
// service name, ie: Alerter
function ServiceGetStatus(sMachine, sService: string): DWord;
var
// service control
// manager handle
schm,
// service handle
schs: SC_Handle;
// service status
ss: TServiceStatus;
// current service status
dwStat: DWord;
begin
dwStat := -1;
// connect to the service
// control manager
schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
// if successful...
if (schm > 0) then
begin
// open a handle to
// the specified service
schs := OpenService(schm, PChar(sService),
// we want to
// query service status
SERVICE_QUERY_STATUS);
// if successful...
if (schs > 0) then
begin
// retrieve the current status
// of the specified service
if (QueryServiceStatus(schs, ss)) then
begin
dwStat := ss.dwCurrentState;
end;
// close service handle
CloseServiceHandle(schs);
end;
// close service control
// manager handle
CloseServiceHandle(schm);
end;
Result := dwStat;
end;
//-------------------------------------
// return TRUE if the specified
// service is running, defined by
// the status code SERVICE_RUNNING.
// return FALSE if the service
// is in any other state, including
// any pending states
function IsServiceRunningAlternative(ServiceName: string): boolean;
begin
Result := SERVICE_RUNNING = ServiceGetStatus('', ServiceName);
end;
const
ServiceToTest = 'SamSs';
//Security Accounts Manager, should be running, at least on Vista
begin
WriteLn('Starting tests for ' + ServiceToTest + ' service.');
if IsServiceRunningAlternative(ServiceToTest) then
begin
WriteLn('Non-FPC code: ' + ServiceToTest + ' is running');
end
else
begin
WriteLn('Non-FPC code: ' + ServiceToTest + ' is not running');
end;
if IsServiceRunning(ServiceToTest) then
begin
WriteLn('ServiceManager code: ' + ServiceToTest + ' is running');
end
else
begin
WriteLn('ServiceManager code: ' + ServiceToTest + ' is not running');
end;
end.
The output it generates on my Vista x64 machine is:
Starting tests for SamSs service.
Non-FPC code: SamSs is running
An unhandled exception occurred at $0041EA25 :
EOSError : System error, (OS Code 6):
The handle is invalid.
$0041EA25
$004207C6
$00420851
$00401621
$00401945
Recent
