windows service

432 views
Skip to first unread message

Antonino Perricone

unread,
Sep 1, 2015, 12:01:40 PM9/1/15
to Harbour Users
Hello,
I am looking for windows service support in harbour, 
I see the example testsvc.prg, but it looks does not works.
I modified "U" and "I" case in this way:
 CASE "I"

      IF win_serviceInstall( _SERVICE_NAME, "Harbour Windows Test Service" )
         ? "Service has been successfully installed"
      ELSE
         nError := wapi_GetLastError()
         if( nError == 5 ) // Access denied
            WApi_ShellExecute( Nil, "runas",  HB_ARGV(0), "I")
         else
            cMsg := Space( 128 )
            wapi_FormatMessage( ,,,, @cMsg )
            ? "Error installing service: " + hb_ntos( nError ) + " " + cMsg
         endif
      ENDIf
      EXIT

   CASE "U"

      IF win_serviceDelete( _SERVICE_NAME )
         ? "Service has been deleted"
      ELSE
         nError := wapi_GetLastError()
         if( nError == 5 ) // Access denied
            WApi_ShellExecute( Nil, "runas",  HB_ARGV(0), "U")
         else
            cMsg := Space( 128 )
            wapi_FormatMessage( ,,,, @cMsg )
            ? "Error deleting service: " + hb_ntos( nError ) + " " + cMsg
         endif
      ENDIf
      EXIT
So if the user is not administrator the program restart requiring administrator rights, it looks it work
I tried to modify the srvMain  using a "c\harbour\testsvc.out" instead of hb_dirBase() + "testsvc.out", or "c\\harbour\\testsvc.out" but the file is not created, 

Someone have tested service recently?

Thank you, 
Regards,
Antonino Perricone


Antonino Perricone

unread,
Sep 2, 2015, 6:13:12 AM9/2/15
to Harbour Users
The service support in harbour works, I changed the example in this way:
#define EVENTLOG_SUCCESS            0x0000 //Information event
#define EVENTLOG_AUDIT_FAILURE      0x0010 //Failure Audit event
#define EVENTLOG_AUDIT_SUCCESS      0x0008 //Success Audit event
#define EVENTLOG_ERROR_TYPE         0x0001 //Error event
#define EVENTLOG_INFORMATION_TYPE   0x0004 //Information event
#define EVENTLOG_WARNING_TYPE       0x0002 //Warning event

PROCEDURE SrvMain()
   ADDTOMESSAGELOG("Harbour service","Running")
   DO WHILE win_serviceGetStatus() == WIN_SERVICE_RUNNING
      hb_idleSleep( 2.0 )
   ENDDO
   ADDTOMESSAGELOG("Harbour service","Exiting")
   win_serviceSetExitCode( 0 )
   win_serviceStop()
RETURN

#pragma BEGINDUMP
#include <windows.h>
#include <hbapi.h>


HB_FUNC_STATIC( ADDTOMESSAGELOG )
{
   LPCSTR wName = hb_parc(1);
   LPCSTR pszMessage = hb_parc(2);
   WORD wType = hb_extIsNil(3)? EVENTLOG_SUCCESS : (WORD)hb_parni(3);
   
    HANDLE hEventSource = NULL;
    LPCSTR lpszStrings[2] = { NULL, NULL };

    hEventSource = RegisterEventSource(NULL, wName);
    if (hEventSource)
    {
        lpszStrings[0] = wName;
        lpszStrings[1] = pszMessage;

        ReportEvent(hEventSource,  // Event log handle
            wType,                 // Event type
            0,                     // Event category
            0,                     // Event identifier
            NULL,                  // No security identifier
            2,                     // Size of lpszStrings array
            0,                     // No binary data
            lpszStrings,           // Array of strings
            NULL                   // No binary data
            );

        DeregisterEventSource(hEventSource);
    }
   
}

And when I start, and stop the service Event Logs are added.

Maybe for services is not possible make tone and the file function are not correct?

Regards,
Antonino Perricone

Antonino Perricone

unread,
Sep 2, 2015, 10:48:44 AM9/2/15
to Harbour Users
Hello,
I did other test with services, now I have a code that works like I want.
So, I share it, some note before 
  • Here I use a fix path for a Log, in this way I write it in the service. I use it for debugging.
  • I add win_serviceRun and win_serviceControl to control the service, maybe there is win_QueryServiceStatus that should be useful, but I don't implement it.
  • I modified win_serviceDelete, adding the code that stop the service and putting a hbwapi_SetLastError after DeleteService. Original code, some time returns false without the lastError setted.
Here my code, I hope It is useful for someone else, and the modification will be ported in hbwin:
#include <fileio.ch>
#include <hbwin.ch>

// this should be moved in hbwin.ch
#define SERVICE_CONTROL_CONTINUE 0x00000003 //Notifies a paused service that it should resume. The hService handle must have the SERVICE_PAUSE_CONTINUE access right.
#define SERVICE_CONTROL_INTERROGATE 0x00000004 //Notifies a service that it should report its current status information to the service control manager. The hService handle must have the SERVICE_INTERROGATE access right.
                                                //Note that this control is not generally useful as the SCM is aware of the current state of the service.
#define SERVICE_CONTROL_NETBINDADD 0x00000007 //Notifies a network service that there is a new component for binding. The hService handle must have the SERVICE_PAUSE_CONTINUE access right. However, this control code has been deprecated; use Plug and Play functionality instead.
#define SERVICE_CONTROL_NETBINDDISABLE 0x0000000A //Notifies a network service that one of its bindings has been disabled. The hService handle must have the SERVICE_PAUSE_CONTINUE access right. However, this control code has been deprecated; use Plug and Play functionality instead.
#define SERVICE_CONTROL_NETBINDENABLE 0x00000009 //Notifies a network service that a disabled binding has been enabled. The hService handle must have the SERVICE_PAUSE_CONTINUE access right. However, this control code has been deprecated; use Plug and Play functionality instead.
#define SERVICE_CONTROL_NETBINDREMOVE 0x00000008 //Notifies a network service that a component for binding has been removed. The hService handle must have the SERVICE_PAUSE_CONTINUE access right. However, this control code has been deprecated; use Plug and Play functionality instead.
#define SERVICE_CONTROL_PARAMCHANGE 0x00000006 //Notifies a service that its startup parameters have changed. The hService handle must have the SERVICE_PAUSE_CONTINUE access right.
#define SERVICE_CONTROL_PAUSE 0x00000002 //Notifies a service that it should pause. The hService handle must have the SERVICE_PAUSE_CONTINUE access right.
#define SERVICE_CONTROL_STOP 0x00000001 //Notifies a service that it should stop. The hService handle must have the SERVICE_STOP access right.
                                         //After sending the stop request to a service, you should not send other controls to the service.
// end of part to move

#define _LOG_FILE "c:\harbour\perry\myService.log"
#define _SERVICE_FULLNAME "TecnoLogica test service"
#define _SERVICE_NAME "TLTestSrv"

procedure WriteLog(what, print)
   LOCAL nFile := fOpen(_LOG_FILE, FO_WRITE)
   if(print==Nil, print:=.F.,)
   if (nFile == -1)
      nFile := fOpen(_LOG_FILE, FO_CREAT + FO_WRITE )
   else
      fSeek(  nFile, 0, 2 )
   endif
   if( nFile > 0 )
      fwrite(nFile, what )
      fwrite(nFile, Chr(13)+Chr(10))
      fclose(nFile)
   endif
   if(print)
      ? cosa
   endif
return 


proc main( cMode )
   LOCAL cPrima, nError, cMsg
   if(cMode==Nil) 
      cMode := "Start"
   endif
   cPrima = SUBSTR(cMode, 1,1)
   if(cPrima == '-' .OR. cPrima == '/')
      cMode := SUBSTR(cMode, 2)
   endif

   switch(upper(cMode))
   
      case "INSTALL"
         IF win_serviceInstall( _SERVICE_NAME, _SERVICE_FULLNAME )
            WRITELOG("Service has been successfully installed")
         ELSE
            nError := wapi_GetLastError()
            if( nError == 5 ) // Access denied
               WApi_ShellExecute( Nil, "runas",  HB_ARGV(0), cMode)
            else
               cMsg := Space( 128 )
               wapi_FormatMessage( ,,,, @cMsg )
               WRITELOG("Error installing service: " + hb_ntos( nError ) + " " + cMsg, .T.)
            endif
         ENDIf
         return
         EXIT
         
      case "REMOVE"
         IF win_serviceDelete_tl( _SERVICE_NAME )
            WRITELOG("Service has been removed",.T.)
         ELSE
            nError := wapi_GetLastError()
            if( nError == 5 ) // Access denied
               WApi_ShellExecute( Nil, "runas",  HB_ARGV(0), cMode)
            else
               cMsg := Space( 128 )
               wapi_FormatMessage( ,,,, @cMsg )
               WRITELOG("Error removing service: " + hb_ntos( nError ) + " " + cMsg, .T.)
            endif
         ENDIf
         return
      EXIT
      case "RUN"
         IF win_serviceRun( _SERVICE_NAME )
            WRITELOG("Service is running",.T.)
         ELSE
            nError := wapi_GetLastError()
            if( nError == 5 ) // Access denied
               WApi_ShellExecute( Nil, "runas",  HB_ARGV(0), cMode)
            else
               cMsg := Space( 128 )
               wapi_FormatMessage( ,,,, @cMsg )
               WRITELOG("Error running service: " + hb_ntos( nError ) + " " + cMsg, .T.)
            endif
         ENDIf
         return
      EXIT
      case "STOP"
         IF win_serviceControl( _SERVICE_NAME, SERVICE_CONTROL_STOP)
            WRITELOG("Service stopped",.T.)
         ELSE
            nError := wapi_GetLastError()
            if( nError == 5 ) // Access denied
               WApi_ShellExecute( Nil, "runas",  HB_ARGV(0), cMode)
            else
               cMsg := Space( 128 )
               wapi_FormatMessage( ,,,, @cMsg )
               WRITELOG("Error stopping service: " + hb_ntos( nError ) + " " + cMsg, .T.)
            endif
         ENDIf
         return
      EXIT
   end
   
   ? "Parameters:"
   ? "-INSTALL to install the service."
   ? "-REMOVE  to remove the service."
   ? "-RUN     to run the service."
   ? "-STOP    to stop the service."
   ? "" 
   IF win_serviceStart( _SERVICE_NAME, @SrvMain() )
      WRITELOG("Service done.")
   ELSE
      nError := wapi_GetLastError()
      cMsg := Space( 128 )
      wapi_FormatMessage( ,,,, @cMsg )
      WRITELOG("Service has had some problems: " + hb_ntos( nError ) + " " + cMsg)
   ENDIF
return

PROCEDURE SrvMain()
   WRITELOG("TLservice Start")
   DO WHILE win_serviceGetStatus() == WIN_SERVICE_RUNNING
      WRITELOG("TLservice Running")
      hb_idleSleep( 2.0 )
   ENDDO
   WRITELOG("TLservice Exit")
   win_serviceSetExitCode( 0 )
   win_serviceStop()
RETURN

#pragma BEGINDUMP
#include <windows.h>
#include <hbapi.h>
#include <hbwapi.h>

HB_FUNC( WIN_SERVICEDELETE_TL )
{
   HB_BOOL bRetVal = HB_FALSE;
   SERVICE_STATUS ssStatus;
#if ! defined( HB_OS_WIN_CE )
   SC_HANDLE schSCM = OpenSCManager( NULL, NULL, SC_MANAGER_ALL_ACCESS );

   if( schSCM )
   {
      void * hServiceName;

      SC_HANDLE schSrv = OpenService( schSCM,
                                      HB_PARSTRDEF( 1, &hServiceName, NULL ),
                                      SERVICE_ALL_ACCESS );

      if( schSrv )
      {
         // try to stop the service
         if ( ControlService( schSrv, SERVICE_CONTROL_STOP, &ssStatus ) )
         {
            while( ssStatus.dwCurrentState != SERVICE_STOPPED )
            {
               if(! QueryServiceStatus( schSrv, &ssStatus ) )
                  break;
                  
               Sleep( 1000 );
            }

            if ( ssStatus.dwCurrentState != SERVICE_STOPPED )
            {
               bRetVal = HB_FALSE;
               hbwapi_SetLastError( GetLastError() );
            }
         }
         // stopped
         if ( ssStatus.dwCurrentState == SERVICE_STOPPED )
         {
            bRetVal = ( HB_BOOL ) DeleteService( schSrv );
            //In the original code this line is missing, so the error is not setted even if return false.
            hbwapi_SetLastError( GetLastError() ); 
            CloseServiceHandle( schSrv );
         } else
         {
            hbwapi_SetLastError( GetLastError() );
         }
      }
      else
         hbwapi_SetLastError( GetLastError() );

      hb_strfree( hServiceName );

      CloseServiceHandle( schSCM );
   }
   else
      hbwapi_SetLastError( GetLastError() );
#endif
   hb_retl( bRetVal );
}

HB_FUNC( WIN_SERVICERUN )
{
   HB_BOOL bRetVal = HB_FALSE;
   SC_HANDLE schSCM = OpenSCManager( NULL, NULL, SC_MANAGER_ALL_ACCESS );

   if( schSCM )
   {
      SC_HANDLE schSrv = OpenService( schSCM,
                                      hb_parc( 1 ),
                                      SERVICE_ALL_ACCESS );

      if( schSrv )
      {
         bRetVal = ( HB_BOOL ) StartService(schSrv,0,NULL);
         hbwapi_SetLastError( GetLastError() );
         CloseServiceHandle( schSrv );
      }
      else
         hbwapi_SetLastError( GetLastError() );

      CloseServiceHandle( schSCM );
   }
   else
      hbwapi_SetLastError( GetLastError() );

   hb_retl( bRetVal );
}

HB_FUNC( WIN_SERVICECONTROL )
{
   HB_BOOL bRetVal = HB_FALSE;
   SC_HANDLE schSCM = OpenSCManager( NULL, NULL, SC_MANAGER_ALL_ACCESS );

   if( schSCM )
   {
      SC_HANDLE schSrv = OpenService( schSCM,
                                      hb_parc( 1 ),
                                      SERVICE_ALL_ACCESS );

      if( schSrv )
      {
         bRetVal = ( HB_BOOL ) ControlService(schSrv,hb_parni(2),NULL);
         hbwapi_SetLastError( GetLastError() );
         CloseServiceHandle( schSrv );
      }
      else
         hbwapi_SetLastError( GetLastError() );

      CloseServiceHandle( schSCM );
   }
   else
      hbwapi_SetLastError( GetLastError() );

   hb_retl( bRetVal );
}

#pragma ENDDUMP

Regards,
Antonino Perricone

Reply all
Reply to author
Forward
0 new messages