Amaladoss R
Amaladoss R

Reputation: 89

How to start a windows service in Delphi for Windows 8

I need to Start a service using Delphi Windows application.It is working fine in Windows 7 but not working in Windows 8.1 .I have used the following code

function ServiceStart(sMachine,sService : string ) : boolean;
var
  schm,schs   : SC_Handle;
  ss     : TServiceStatus;
  psTemp : PChar;
  dwChkP : DWord;
begin
  ss.dwCurrentState := 0;
  schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
  if(schm > 0)then
  begin
    schs := OpenService(schm,PChar(sService),SERVICE_START or SERVICE_QUERY_STATUS);
    if(schs > 0)then
    begin
      psTemp := Nil;
      if(StartService(schs,0,psTemp))then
      begin
        if(QueryServiceStatus(schs,ss))then
        begin
          while(SERVICE_RUNNING <> ss.dwCurrentState)do
          begin
            dwChkP := ss.dwCheckPoint;
            Sleep(ss.dwWaitHint);
            if(not QueryServiceStatus(schs,ss))then
            begin
              break;
            end;
            if(ss.dwCheckPoint < dwChkP)then
            begin
              break;
            end;
          end;
        end;
      end;
      CloseServiceHandle(schs);
    end;
    CloseServiceHandle(schm);
  end;


  Result := SERVICE_RUNNING = ss.dwCurrentState;
end;


procedure TForm1.BBSerStatusClick(Sender: TObject);
begin
  ServiceStart('','SERVTEST');
end;

Note: SERVTEST it is service application. Can anyone help me?

Upvotes: 3

Views: 8960

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 598448

I see that you are using code copied from here.

if(schm > 0)then and if(schs > 0)then should be changed to if(schm <> 0)then and if(schs <> 0) then instead. The only failure value in this situation is 0 (some APIs use INVALID_HANDLE_VALUE instead, but the SCM API does not). Any other value is a valid handle. Handles are not really integers (although Delphi declares them as such), so you should not treat them as integers. They are arbitrary values that are not meant to be interpreted, they are meant to be used as-is. If you do not get back an actual failure value (in this case, 0), then the call was successful regardless of the value actully returned.

The handling of ss.dwCurrentState is a little off, too. Instead of looping while ss.dwCurrentState is not SERVICE_RUNNING, loop while ss.dwCurrentState is SERVICE_START_PENDING instead. If something goes wrong and the service never enters the SERVICE_RUNNING state, the loop will run forever, unless QueryServiceStatus() itself fails. And I would not suggest relying on ss.dwCheckPoint because not all services implement it correctly (in fact, Delphi's own TService does not - see QC #1006 TService.ReportStatus reports incorrect CheckPoint).

Try something more like the following. It differentiates between SCM API failures and Service start failures, but also does extra error checking to handle certain errors that are not actually fatal errors:

function ServiceStart(sMachine, sService : string) : Boolean;
var
  schm, schs : SC_HANDLE;
  ss : TServiceStatus;
begin
  schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
  if (schm = 0) then RaiseLastOSError;
  try
    schs := OpenService(schm, PChar(sService), SERVICE_START or SERVICE_QUERY_STATUS);
    if (schs = 0) then RaiseLastOSError;
    try
      // NOTE: if you use a version of Delphi that incorrectly declares
      // StartService() with a 'var' lpServiceArgVectors parameter, you
      // can't pass a nil value directly in the 3rd parameter, you would
      // have to pass it indirectly as either PPChar(nil)^ or PChar(nil^)
      if not StartService(schs, 0, nil) then
      begin
        Result := ERROR_SERVICE_ALREADY_RUNNING = GetLastError();
        if not Result then RaiseLastOSError;
        Exit;
      end;
      repeat
        if not QueryServiceStatus(schs, ss) then
        begin
          if (ERROR_SERVICE_NOT_ACTIVE <> GetLastError()) then RaiseLastOSError;
          Result := False;
          Exit;
        end;
        if (SERVICE_START_PENDING <> ss.dwCurrentState) then Break;
        Sleep(ss.dwWaitHint);
      until False;
      Result := SERVICE_RUNNING = ss.dwCurrentState;
    finally
      CloseServiceHandle(schs);
    end;
  finally
    CloseServiceHandle(schm);
  end;
end;

Or, here is a (modified) version of Microsoft's example, which also includes handling if the service is in SERVICE_STOP_PENDING state before starting it (I removed timeout logic since it is based on dwCheckPoint handling):

Starting a Service:

function ServiceStart(sMachine, sService : string) : Boolean;
var
  schSCManager,
  schService : SC_HANDLE;
  ssStatus : TServiceStatus;
begin
  // Get a handle to the SCM database.

  schSCManager := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
  if (schSCManager = 0) then RaiseLastOSError; 
  try
    // Get a handle to the service.

    schService := OpenService(schSCManager, PChar(sService), SERVICE_START or SERVICE_QUERY_STATUS);
    if (schService = 0) then RaiseLastOSError;
    try
      // Check the status in case the service is not stopped.

      if not QueryServiceStatus(schService, ssStatus) then
      begin
        if (ERROR_SERVICE_NOT_ACTIVE <> GetLastError()) then RaiseLastOSError;
        ssStatus.dwCurrentState := SERVICE_STOPPED;
      end;

      // Check if the service is already running

      if (ssStatus.dwCurrentState <> SERVICE_STOPPED) and ssStatus.dwCurrentState <> SERVICE_STOP_PENDING) then
      begin
        Result := True;
        Exit;
      end;

      // Wait for the service to stop before attempting to start it.

      while (ssStatus.dwCurrentState = SERVICE_STOP_PENDING) do
      begin
        // Do not wait longer than the wait hint. A good interval is
        // one-tenth of the wait hint but not less than 1 second
        // and not more than 10 seconds.

        dwWaitTime := ssStatus.dwWaitHint div 10;

        if (dwWaitTime < 1000) then
          dwWaitTime := 1000
        else if (dwWaitTime > 10000) then
          dwWaitTime := 10000;

        Sleep(dwWaitTime);

        // Check the status until the service is no longer stop pending.

        if not QueryServiceStatus(schService, ssStatus) then
        begin
          if (ERROR_SERVICE_NOT_ACTIVE <> GetLastError()) then RaiseLastOSError;
          Break;
        end;
      end;

      // Attempt to start the service.

      // NOTE: if you use a version of Delphi that incorrectly declares
      // StartService() with a 'var' lpServiceArgVectors parameter, you
      // can't pass a nil value directly in the 3rd parameter, you would
      // have to pass it indirectly as either PPChar(nil)^ or PChar(nil^)
      if not StartService(schService, 0, nil) then RaiseLastOSError;

      // Check the status until the service is no longer start pending.

      if not QueryServiceStatus(schService, ssStatus) then
      begin
        if (ERROR_SERVICE_NOT_ACTIVE <> GetLastError()) then RaiseLastOSError;
        ssStatus.dwCurrentState := SERVICE_STOPPED;
      end;

      while (ssStatus.dwCurrentState = SERVICE_START_PENDING) do
      begin
        // Do not wait longer than the wait hint. A good interval is
        // one-tenth the wait hint, but no less than 1 second and no
        // more than 10 seconds.

        dwWaitTime := ssStatus.dwWaitHint div 10;

        if (dwWaitTime < 1000) then
          dwWaitTime := 1000
        else if (dwWaitTime > 10000) then
          dwWaitTime := 10000;

        Sleep(dwWaitTime);

        // Check the status again.

        if not QueryServiceStatus(schService, ssStatus) then
        begin
          if (ERROR_SERVICE_NOT_ACTIVE <> GetLastError()) then RaiseLastOSError;
          ssStatus.dwCurrentState := SERVICE_STOPPED;
          Break;
        end;
      end;

      // Determine whether the service is running.

      Result := (ssStatus.dwCurrentState = SERVICE_RUNNING);
    finally
      CloseServiceHandle(schService); 
    end;
  finally
    CloseServiceHandle(schSCManager);
  end;
end;

Upvotes: 13

Related Questions