Windows Service

Windows specific questions.
Post Reply
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Windows Service

Post by Pierre Bellisle »

A simple service to play with...

Pierre

Image

Code: Select all

'***************************************************************************************
'*                      Windows service (32 bit or 64 bit)                             *
'*                                                                                     *
'*  Asuming you named this compiled code "MyService.exe"                               *
'*                                                                                     *
'*  To install, from a command prompt with admin right,                                *
'*  type "MyService.exe install". The service will install and auto start.             *
'*                                                                                     *
'*  To uninstall the service, you have to stop it in service manager first, so...      *
'*  Do "Start"/"Run": "services.msc", this will start the service manager.             *
'*  or get to it via the Control Panel if you prefer.                                  *
'*  Select your service, press "F5" to refresh if your service is non visible.         *
'*  Double click on your service listview item, A property box will appear.            *
'*  Click "Stop", and close the dialog box.                                            *
'*  Then at the Admin command prompt type "MyService.exe uninstall"                    *
'*                                                                                     *
'*  In order to keep the Windows booting process as light as possible                  *
'*  you may delay the start of the service by selecting the                            *
'*  ServiceDelayed.fDelayedAutostart option in code.                                   *
'*                                                                                     *
'*  Now, in the service dialog box, other than "Stop",                                 *
'*  you may also play with "Suspend", Start" and "Restart".                            *
'*                                                                                     *
'*  Since a service does not usually interact with the desktop,                        *
'*  if "Debug" constant is set to TRUE in code,                                        *
'*  a message will be sent via the OutputDebugString api.                              *
'*  You will get a message for start, stop, pause, and resume.                         *
'*  Plus a "thread is running" message every two seconds.                              *
'*                                                                                     *
'*  To capture such message, use a debug viewer with the "global mode" option enabled. *
'*                                                                                     *
'*    OutputDebugString DebugView++ is a Windows Debug Message Viewer...               *
'*    https://debugviewpp.wordpress.com/2014/01/04/7/                                  *
'*                                                                                     *
'*    Windows Sysinternals DebugView is another one...                                 *
'*    https://technet.microsoft.com/en-us/sysinternals/debugview                       *
'*                                                                                     *
'*    Microsoft info: Service Control Manager                                          *
'*    https://msdn.microsoft.com/en-us/library/ms685150(VS.85).aspx                    *
'*                                                                                     *
'*   Have fun,                                                                         *
'*   Pierre                                                                            *
'*                                                                                     *
'***************************************************************************************

#Define JumpCompiler "<D:\Free\64\fbc.exe>"
#Define JumpCompilerCmd "<-s console "D:\Free\bas\~~Default.rc">"

#Lang "fb"
#Define Unicode
#Define _WIN32_WINNT &h0602
#Include Once "Windows.bi"
#Include Once "win\winsvc.bi"
#include once "crt\string.bi" '

Const Debug                        = TRUE
Const AppName                      = "MyService"

Const MAX_SERVICE_NAME_LEN    = 256

TYPE GlobalType
  wsComputerName       AS wSTRING * MAX_COMPUTERNAME_LENGTH + 1 '15
  wsServiceName        AS wSTRING * MAX_SERVICE_NAME_LEN '256
  wsServiceDisplayName AS wSTRING * MAX_SERVICE_NAME_LEN '256
  wsExeName            AS wSTRING * MAX_PATH '260
  hServiceStatus       AS HANDLE
  hInstance            AS HINSTANCE
  hEvent               AS HANDLE
  hThread              AS HANDLE
  CurrentServiceStatus AS DWORD
  ServiceIsRunning     AS LONG
  ServiceIsPaused      AS LONG
END TYPE
Dim Shared pg AS GlobalType POINTER

'_____________________________________________________________________________

SUB ServiceStop()

 IF Debug THEN OutputDebugString("Service thread stopping at " & TIME$) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
 pg->ServiceIsRunning = FALSE 'Set the global flag indicating that the service is not running
 SetEvent(pg->hEvent) 'Set the event so the service will stop

END SUB
'_____________________________________________________________________________

FUNCTION ServiceStatusSet(BYVAL CurrentStatus AS DWORD, BYVAL ExitCode AS DWORD, ServiceSpecificExitCode AS LONG, _
                          BYVAL Checkpoint AS DWORD, BYVAL WaitHint AS DWORD) AS LONG
 Dim ServiceStatus AS SERVICE_STATUS

 ServiceStatus.dwServiceType  = SERVICE_WIN32_OWN_PROCESS 'Setup the UDT.
 ServiceStatus.dwCurrentState = CurrentStatus

 IF CurrentStatus = SERVICE_START_PENDING THEN
   ServiceStatus.dwControlsAccepted = 0
 ELSE
   ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP OR SERVICE_ACCEPT_PAUSE_CONTINUE OR SERVICE_ACCEPT_SHUTDOWN
 END IF

 IF ServiceSpecificExitCode = 0 THEN
   ServiceStatus.dwWin32ExitCode = ExitCode
 ELSE
   ServiceStatus.dwWin32ExitCode = ERROR_SERVICE_SPECIFIC_ERROR
 END IF

 ServiceStatus.dwServiceSpecificExitCode = ServiceSpecificExitCode 'Specific Exit Code
 ServiceStatus.dwCheckPoint              = Checkpoint
 ServiceStatus.dwWaitHint                = WaitHint

 IF SetServiceStatus(pg->hServiceStatus, @ServiceStatus) THEN
   FUNCTION = TRUE
 ELSE 'Something went wrong so stop the service
   ServiceStop
 END IF

END FUNCTION
'_____________________________________________________________________________

SUB ServiceTerminate(ErrorCode AS DWORD)

 IF pg->hEvent THEN
   CloseHandle(pg->hEvent)
 END IF

 IF pg->hServiceStatus THEN
   ServiceStatusSet(SERVICE_STOPPED, ErrorCode, 0, 0, 0)
 END IF

 IF pg->hThread THEN
   CloseHandle(pg->hThread)
 END IF

END SUB
'_____________________________________________________________________________

SUB ServicePause()

 IF Debug THEN OutputDebugString("Service thread paused at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
 pg->ServiceIsPaused = TRUE 'Set the global indicating that we are paused
 SuspendThread(pg->hThread)

END SUB
'_____________________________________________________________________________

SUB ServiceResume()

 IF Debug THEN OutputDebugString("Service thread resuming at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
 pg->ServiceIsPaused = FALSE 'Set the global indicating that we are not paused
 ResumeThread(pg->hThread)

END SUB
'_____________________________________________________________________________

SUB ServiceStopRaw() 'Use when a service have to end by itself
 Dim ServiceStat            AS SERVICE_STATUS
 Dim hServiceControlManager AS HANDLE
 Dim hService               AS HANDLE

 hServiceControlManager = OpenSCManager(pg->wsComputerName, BYVAL NULL, SC_MANAGER_CREATE_SERVICE)
 IF hServiceControlManager THEN 'OK, we have a handle to the SCM. Now open our service.
   hService = OpenService(hServiceControlManager, pg->wsServiceName, SERVICE_ALL_ACCESS)
   IF hService THEN
     ControlService(hService, SERVICE_CONTROL_STOP, @ServiceStat) 'hService = OpenService(hSCManager, BYVAL STRPTR(sService), SERVICE_ALL_ACCESS)
   END IF
   CloseServiceHandle(hServiceControlManager)
 END IF

END SUB
'_____________________________________________________________________________

FUNCTION ServiceThread(idThread AS DWORD) AS LONG
 'Here goes the service's job...

 DO
   SLEEP 2000
   IF Debug THEN OutputDebugString("Service thread is running at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
 LOOP
 FUNCTION = TRUE

 '*** ServiceStopRaw 'Used when a service end by itself after a job

END FUNCTION
'_____________________________________________________________________________

SUB ServiceHandler(BYVAL ControlValue AS DWORD) 'Handles service requests

 SELECT CASE ControlValue

   CASE SERVICE_CONTROL_PAUSE
     IF (pg->ServiceIsRunning <> FALSE) AND (pg->ServiceIsPaused = FALSE) THEN 'Running and not paused
       ServiceStatusSet(SERVICE_PAUSE_PENDING, NO_ERROR, 0, 1, 1000) 'Tell the SCM that we are pausing
       ServicePause 'Pause it
       pg->CurrentServiceStatus = SERVICE_PAUSED 'Set the current state
     END IF

   CASE SERVICE_CONTROL_CONTINUE
     IF (pg->ServiceIsRunning <> FALSE) AND (pg->ServiceIsPaused <> FALSE) THEN 'Running and paused
       ServiceStatusSet(SERVICE_CONTINUE_PENDING, NO_ERROR, 0, 1, 1000) 'Tell the SCM that we are un pausing
       ServiceResume 'Resume the service
       pg->CurrentServiceStatus = SERVICE_RUNNING 'Set the current state
     END IF

   CASE SERVICE_CONTROL_STOP
     IF pg->ServiceIsPaused Then
       'Is the service paused?
     End If
     pg->CurrentServiceStatus = SERVICE_STOP_PENDING 'Set global status
     ServiceStatusSet(SERVICE_STOP_PENDING, NO_ERROR, 0, 1, 5000)
     ServiceStop

   CASE SERVICE_CONTROL_INTERROGATE

   CASE CTRL_SHUTDOWN_EVENT

   CASE SERVICE_CONTROL_SHUTDOWN
     'To do on shutdown

 END SELECT

 ServiceStatusSet(pg->CurrentServiceStatus, NO_ERROR, 0, 0, 0)

END SUB
'_____________________________________________________________________________

FUNCTION ServiceInit() AS LONG
 Dim SecurityAttribute AS SECURITY_ATTRIBUTES
 Dim idThread          AS DWORD

 pg->hThread = CreateThread(@SecurityAttribute, 0, _
 Cast(LPTHREAD_START_ROUTINE, _
 ProcPtr(ServiceThread)), ByVal 0, ByVal 0, @idThread)
 IF pg->hThread THEN 'The thread start OK
   pg->ServiceIsRunning = TRUE 'Set the global to running
   FUNCTION             = TRUE
 END IF

END FUNCTION
'_____________________________________________________________________________

SUB ServiceMain(BYVAL dwArgs AS DWORD, BYVAL lpszArgv AS DWORD)
 'dwArgc   The number of arguments in the lpszArgv array.
 'lpszArgv The null-terminated argument strings passed to the service by the call to the StartService function
 '          that started the service. If there are no arguments, this parameter can be NULL.
 '          Otherwise, the first argument (lpszArgv[0]) is the name of the service, followed
 '          by any additional arguments (lpszArgv[1] through lpszArgv[dwArgc-1]).
 '          If the user starts a manual service using the Services snap-in from the Control Panel,
 '          the strings for the lpszArgv parameter come from the properties dialog box
 '          for the service (from the Services snap-in, right-click the service entry, click Properties,
 '          and enter the parameters in Start parameters.)
 Dim SecurityAttribute AS SECURITY_ATTRIBUTES
 Dim RetVal            AS LONG

 pg->hServiceStatus = RegisterServiceCtrlHandler(pg->wsServiceName, @ServiceHandler)
 IF pg->hServiceStatus THEN 'Did not work
   IF ServiceStatusSet(SERVICE_START_PENDING, NO_ERROR, 0, 1, 5000) THEN 'Startup is pending
     pg->hEvent = CreateEvent(@SecurityAttribute, TRUE, FALSE, "") 'Create the termination event
     IF pg->hEvent THEN
       IF ServiceStatusSet(SERVICE_START_PENDING, NO_ERROR, 0, 2, 1000) THEN 'Service startup is still pending
         RetVal = ServiceInit() 'Start the service
         IF RetVal THEN 'Service did start
           IF ServiceStatusSet(SERVICE_RUNNING, NO_ERROR, 0, 0, 0) THEN  'Service is now running
             'Wait for the signal to end
             IF Debug THEN OutputDebugString("Service thread started at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
             WaitForSingleObject(pg->hEvent, INFINITE)
           END IF
         END IF
       END IF
     END IF
   END IF
 END IF

 ServiceTerminate(GetLastError())

END SUB
'_____________________________________________________________________________

FUNCTION ServiceUninstall() AS LONG
 Dim hServiceControlManager AS HANDLE
 Dim hService               AS HANDLE

 hServiceControlManager = OpenSCManager(pg->wsComputerName, BYVAL NULL, SC_MANAGER_CREATE_SERVICE)
 IF hServiceControlManager THEN
   hService = OpenService(hServiceControlManager, pg->wsServiceName, SERVICE_ALL_ACCESS)
   IF hService THEN
     IF DeleteService(hService) THEN
       Print "Uninstall successfull"
       FUNCTION = TRUE
     ELSE
       Print "Uninstall - DeleteService : Error"
     END IF
     CloseServiceHandle(hService)
   ELSE
     Print "Uninstall - OpenService : Error"
   END IF
   CloseServiceHandle(hServiceControlManager)
 ELSE
   Print "Uninstall - OpenSCManager : Error"
 END IF

END FUNCTION
'_____________________________________________________________________________

FUNCTION ServiceInstall() AS LONG
 Dim ServiceDelayed         AS SERVICE_DELAYED_AUTO_START_INFO
 Dim ServiceDesc            AS SERVICE_DESCRIPTION
 Dim wsServiceDescription   AS WSTRING * MAX_PATH
 Dim hServiceControlManager AS HANDLE
 Dim hService               AS HANDLE

 hServiceControlManager = OpenSCManager(pg->wsComputerName, BYVAL NULL, SC_MANAGER_CREATE_SERVICE)

 IF hServiceControlManager THEN
   hService = CreateService(hServiceControlManager, pg->wsServiceName, pg->wsServiceDisplayName, _
                            SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS OR _
                            SERVICE_INTERACTIVE_PROCESS, _
                            SERVICE_AUTO_START, SERVICE_ERROR_NORMAL, _
                            pg->wsExeName, BYVAL NULL, BYVAL NULL, _
                            BYVAL NULL, BYVAL NULL, BYVAL NULL) 'SERVICE_DEMAND_START SERVICE_ERROR_IGNORE
   IF hService THEN
     ChangeServiceConfig(hService, SERVICE_NO_CHANGE, SERVICE_AUTO_START, _
                         SERVICE_ERROR_NORMAL, NULL, NULL, 0, NULL, NULL, NULL, NULL)

     wsServiceDescription      = AppName & " is a BASIC template to write a service." '1024 bytes
     ServiceDesc.lpDescription = @wsServiceDescription
     ChangeServiceConfig2(hService, SERVICE_CONFIG_DESCRIPTION, BYVAL VARPTR(ServiceDesc))
     'SERVICE_CONFIG_DELAYED_AUTO_START_INFO SERVICE_CONFIG_PRESHUTDOWN_INFO
     'SERVICE_CONFIG_REQUIRED_PRIVILEGES_INFO SERVICE_CONFIG_DESCRIPTION

     '*** Unrem next 2 lines to have a delayed service start
     '*** ServiceDelayed.fDelayedAutostart = TRUE
     '*** ChangeServiceConfig2(hService, SERVICE_CONFIG_DELAYED_AUTO_START_INFO, VARPTR(ServiceDelayed))

     IF StartService(hService, 0, 0) THEN
       Print " Install successfull"
     ELSE
       Print "Install - StartService : Error"
     END IF

     FUNCTION = TRUE
     CloseServiceHandle(hService)
   ELSE
     Print "Install - CreateService : Error"
   END IF
   CloseServiceHandle(hServiceControlManager)
 ELSE
   Print "Install - OpenSCManager : Error"
   Print "Need to be run as admin."
 END IF

END FUNCTION
'_____________________________________________________________________________

 DIM ServiceTable(0 TO 1) AS SERVICE_TABLE_ENTRY 'Last entry must be blank
 Dim sCommand             AS STRING
 Dim RetVal               AS LONG
 Dim ComputerNameLen      AS LONG
 Dim g                    AS GlobalType

 pg = VARPTR(g)
 ComputerNameLen = SizeOf(pg->wsComputerName)
 GetComputerName(pg->wsComputerName, Cast(LPDWORD, @ComputerNameLen)) 'Use "" for default local service

 pg->wsServiceName        = AppName 'Set the service name and display name
 pg->wsServiceDisplayName = AppName & " BASIC template"  'Viewed in service manager, 256 char

 pg->hInstance = GetModuleHandle(NULL)

 GetModuleFileName(0, pg->wsExeName, MAX_PATH) 'Get exe full name

 sCommand = LCASE$(Command$)

 If INSTR(sCommand, "uninstall") THEN
   RetVal = ServiceUninstall()
 ELSEIF INSTR(sCommand, "install") THEN
   RetVal = ServiceInstall()
 ELSE
   ServiceTable(0).lpServiceName = Cast(LPTSTR, VARPTR(pg->wsServiceName))
   ServiceTable(0).lpServiceProc = Cast(LPSERVICE_MAIN_FUNCTION, ProcPtr(ServiceMain))
   IF Debug THEN OutputDebugString("Service thread is starting at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
   IF StartServiceCtrlDispatcher(@ServiceTable(0)) = 0 THEN
     ExitProcess(GetLastError())
   END IF
 END IF
'_____________________________________________________________________________
'
jimdunn
Posts: 13
Joined: Jan 28, 2016 15:07

Re: Windows Service

Post by jimdunn »

Um, wow... 6 years and I stumble upon this now... THANKS!!!
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: Windows Service

Post by Pierre Bellisle »

:)
jimdunn
Posts: 13
Joined: Jan 28, 2016 15:07

Re: Windows Service

Post by jimdunn »

Pierre, I've written a smaller version based on your code and a small C snippet I found.

Please (anyone) give me your opinion! My goal is to have a SMALL, SOLID, STABLE service that will call the exe listed in the .cfg file every 5 seconds.

jService.bas

Code: Select all

' FB FreeBasic Application
' jService.bas
' fbc64.exe -s gui
' thread log visible from dbgview64.exe in CAPTURE GLOBAL DEBUG MESSAGES mode As Admin

' =============================================================================
#Lang "fb"

#Define Unicode
#Define _WIN32_WINNT &h0602

#Include Once "Windows.bi"
#Include Once "win\winsvc.bi"
#Include Once "crt\string.bi"
#Include Once "File.bi"

Const Debug = TRUE
Const SERVICE_NAME = "jService"
Const MAX_SERVICE_NAME_LEN = 256
Dim Shared wsServiceName        As WSTRING * MAX_SERVICE_NAME_LEN '256
Dim Shared scHandle             As SC_HANDLE
Dim Shared ServiceDesc          As SERVICE_DESCRIPTION
Dim Shared wsServiceDescription As WSTRING * MAX_PATH '260
Dim Shared wsExeName            As WSTRING * MAX_PATH '260
Dim Shared ServiceStatus        As SERVICE_STATUS
Dim Shared ServiceStatusHandle  As SERVICE_STATUS_HANDLE

' -----------------------------------------------------------------------------
Sub ServiceControlHandler(ByVal ControlValue As DWORD) 'Handles service requests
    SELECT Case ControlValue
        Case SERVICE_CONTROL_PAUSE
        '    ServiceStatus.dwCurrentState = SERVICE_PAUSED
        Case SERVICE_CONTROL_CONTINUE
            ServiceStatus.dwCurrentState = SERVICE_RUNNING
        Case SERVICE_CONTROL_STOP, SERVICE_CONTROL_SHUTDOWN
            ServiceStatus.dwCurrentState = SERVICE_STOPPED
        Case SERVICE_CONTROL_INTERROGATE
        Case CTRL_SHUTDOWN_EVENT
        Case Else
    END SELECT
    SetServiceStatus(ServiceStatusHandle, @ServiceStatus)
End Sub

' -----------------------------------------------------------------------------
Function ServiceThread(idThread As DWORD) As LONG ' the actual service job
    Dim As STRING sFQN = wsExeName, sCfg = "", sProgram = "", sArgs = ""
    Dim As STARTUPINFO siStartInfo
    Dim As PROCESS_INFORMATION piProcInfo
    Dim As LONG x, fp, rc
    Dim As DWORD dwPid, exitCode ' jjj

    ' Setup service
    ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
    ServiceStatus.dwCurrentState = SERVICE_RUNNING
    ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP Or SERVICE_ACCEPT_SHUTDOWN
    ServiceStatus.dwWin32ExitCode = NO_ERROR
    ServiceStatus.dwServiceSpecificExitCode = 0
    ServiceStatus.dwCheckPoint = 0
    ServiceStatus.dwWaitHint = 0

    ServiceStatusHandle = RegisterServiceCtrlHandler(wsServiceName, @ServiceControlHandler)
    If ServiceStatusHandle = 0 Or SetServiceStatus(ServiceStatusHandle, @ServiceStatus) = 0 Then
        Function = FALSE
        Exit Function
    EndIf
    
    ServiceDesc.lpDescription = @wsServiceDescription
    scHandle = Cast(SC_HANDLE, GetModuleHandle(NULL))
    ChangeServiceConfig2(scHandle, SERVICE_CONFIG_DESCRIPTION, ByVal VARPTR(ServiceDesc))

    DO
        If Debug Then OutputDebugString("jService thread LOOP is running at " & TIME$ ) 'CAPTURE GLOBAL DEBUG MESSAGES

        x = InStrRev(sFQN, ".")
        If x Then
            sCfg = Left(sFQN, x-1) & ".cfg"
            If Debug Then OutputDebugString("jService about to open '" & sCfg & "'") 'CAPTURE GLOBAL DEBUG MESSAGES
            fp = FreeFile
            If Open(sCfg For Input Access Read As #fp) = 0 Then ' success opening
                If Not EOF(fp) Then Line Input #fp, sProgram
                If Not EOF(fp) Then Line Input #fp, sArgs
                Close #fp
                If Len(sProgram) > 0 Then
                    siStartInfo.cb = SizeOf(STARTUPINFO)
                    siStartInfo.dwFlags = STARTF_USESHOWWINDOW ' needed for wShowWindow to work
                    siStartInfo.wShowWindow = SW_HIDE ' SW_NORMAL or SW_HIDE
                    rc = CreateProcess(sProgram,sArgs,NULL,NULL,FALSE,CREATE_NEW_PROCESS_GROUP,NULL,NULL,@siStartInfo,@piProcInfo)
                    If rc > 0 Then
                        dwPid = GetProcessId(piProcInfo.hProcess)
                        If Debug Then OutputDebugString(sProgram & " process ID = " & Str(dwPid)) 'CAPTURE GLOBAL DEBUG MESSAGES
                        'WaitForSingleObject(piProcInfo.hProcess, INFINITE)
                        'GetExitCodeProcess(piProcInfo.hProcess, @exitCode)
                    Else
                        If Debug Then OutputDebugString("jService unable to run '" & sProgram & "'") 'CAPTURE GLOBAL DEBUG MESSAGES
                    EndIf
                Else
                    If Debug Then OutputDebugString("jService .cfg file '" & sCfg & "' line 1 empty") 'CAPTURE GLOBAL DEBUG MESSAGES
                EndIf
            Else
                If Debug Then OutputDebugString("jService unable to open '" & sCfg & "'") 'CAPTURE GLOBAL DEBUG MESSAGES
            EndIf
        EndIf

        Sleep 4900
    LOOP

    Function = TRUE
END FUNCTION

' =============================================================================
DIM ServiceTable(0 TO 1) As SERVICE_TABLE_ENTRY 'Last entry must be blank
Dim sCommand             As STRING
Dim rc                   As LONG
Dim ComputerNameLen      As LONG
Dim wsComputerName       As WSTRING * MAX_COMPUTERNAME_LENGTH + 1 '15

ComputerNameLen = SizeOf(wsComputerName)
GetComputerName(wsComputerName, Cast(LPDWORD, @ComputerNameLen)) 'Use "" for default local service
wsServiceName = SERVICE_NAME 'Set the service name and display name
wsServiceDescription = SERVICE_NAME & " v0.1" '1024 bytes
GetModuleFileName(0, wsExeName, MAX_PATH) 'Get exe full name

ServiceTable(0).lpServiceName = Cast(LPTSTR, VARPTR(wsServiceName))
ServiceTable(0).lpServiceProc = Cast(LPSERVICE_MAIN_FUNCTION, ProcPtr(ServiceThread))
If Debug Then OutputDebugString("jService thread is starting at " & TIME$ ) 'CAPTURE GLOBAL DEBUG MESSAGES
If StartServiceCtrlDispatcher(@ServiceTable(0)) = 0 Then
    If Debug Then OutputDebugString("jService StartServiceCtrlDispatcher = 0 at " & TIME$ ) 'CAPTURE GLOBAL DEBUG MESSAGES
    ExitProcess(GetLastError())
Else
    If Debug Then OutputDebugString("jService StartServiceCtrlDispatcher <> 0 at " & TIME$ ) 'CAPTURE GLOBAL DEBUG MESSAGES
EndIf
jService.cfg

Code: Select all

C:\Temp\jTest1.exe
jTest1.bas

Code: Select all

#Include Once "Windows.bi"

Function WinMain( _
    ByVal hInstance     As HINSTANCE, _
    ByVal hPrevInstance As HINSTANCE, _
    ByVal szCmdLine     As ZString Ptr, _
    ByVal nCmdShow      As LONG _
    ) As LONG

    Dim As STRING sBuf = "jTest1.exe: " & Date$ & " " & Time$
    Dim As LONG fp = FreeFile


    If Open("C:\Temp\jTest1.log" For Append As #fp) = 0 Then
        Print #fp, sBuf
        Close #fp
    EndIf

    WinMain = 0
End Function

End WinMain(GetModuleHandle(Null), Null, Command(), SW_NORMAL)
_install-jService.cmd

Code: Select all

if not "%CD%"=="C:\Temp" goto _skip
sc create jService binpath= "C:\Temp\jService.exe" start= auto
:_skip
_uninstall-jService.cmd

Code: Select all

if not "%CD%"=="C:\Temp" goto _skip
net stop jService
sc delete jService
:_skip
jimdunn
Posts: 13
Joined: Jan 28, 2016 15:07

Re: Windows Service

Post by jimdunn »

I know this code is in error -- it will compile, but does NOT change the description:

Code: Select all

ServiceDesc.lpDescription = @wsServiceDescription
scHandle = Cast(SC_HANDLE, GetModuleHandle(NULL))
ChangeServiceConfig2(scHandle, SERVICE_CONFIG_DESCRIPTION, ByVal VARPTR(ServiceDesc))
jimdunn
Posts: 13
Joined: Jan 28, 2016 15:07

Re: Windows Service

Post by jimdunn »

Better jTest1.bas

Code: Select all

#Include Once "Windows.bi"
Const CRLF As STRING = Chr(13,10)

Private Function jDQ (ByVal sMessage As STRING) As STRING
    Return Chr(34) & sMessage & Chr(34)
End Function

Private Function jPipe (ByVal sArg As STRING) As STRING
    Dim As INTEGER fp
    Dim As STRING sTemp, sBuf = "", sCmd = jDQ( sArg & " 2>&1" )

    fp = FreeFile
    Open Pipe sCmd For Input As #fp
    Do Until EOF(fp)
        Line Input #fp, sTemp
        sBuf &= sTemp & CRLF
    Loop
    Close #fp
    If Right(sBuf,2) = CRLF Then
        sBuf = Left(sBuf,Len(sBuf)-2)
    EndIf
    Return "[output]" & sBuf & "[/output]"
End Function

Private Function jAppend (ByVal sFile As STRING, ByVal sLine As STRING) As LONG
    Dim As LONG fp = FreeFile

    If Open(sFile For Append As #fp) = 0 Then
        Print #fp, sLine
        Close #fp
        Return 1 ' success
    Else
        Return 0 ' fail
    EndIf
End Function

Function WinMain( _
    ByVal hInstance     As HINSTANCE, _
    ByVal hPrevInstance As HINSTANCE, _
    ByVal szCmdLine     As ZString Ptr, _
    ByVal nCmdShow      As LONG _
    ) As LONG

    Dim As LONG rc

    If jAppend( "C:\Temp\jTest1.log", CRLF & "jTest1.exe: " & Date$ & " " & Time$ ) = 1 Then
        If jAppend( "C:\Temp\jTest1.log", jPipe("dir \\server\share\folder\file*") ) = 0 Then
            ? "Error 2: Unable to append to C:\Temp\jTest1.log"
        EndIf
    Else
        ? "Error 1: Unable to append to C:\Temp\jTest1.log"
    EndIf
    WinMain = 0
End Function

End WinMain(GetModuleHandle(Null), Null, Command(), SW_NORMAL)
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: Windows Service

Post by Pierre Bellisle »

Jim,

After a month, I'm probably too late, still, here is an answer...

The handle scHandle you gave couldn't be the result of "Cast(SC_HANDLE, GetModuleHandle(NULL)"
in my code, it come from OpenService(), as in "hService = OpenService(hServiceControlManager, pg->wsServiceName, SERVICE_ALL_ACCESS)"

For the log file, try the following...

Code: Select all

#Include Once "Windows.bi"
Const CRLF As String = Chr(13,10)

Private Function jDQ(ByVal sMessage As String) As String
    Return Chr(34) & sMessage & Chr(34)
End Function

Private Function jPipe(ByVal sArg As String) As String
    Dim As INTEGER fp
    Dim As String sTemp, sBuf, sCmd = jDQ(sArg & " 2>&1")

    fp = FreeFile
    Open Pipe sCmd For Input As #fp
    Do Until EOF(fp)
        Line Input #fp, sTemp
        sBuf &= sTemp & CRLF
    Loop
    Close #fp
    If Right(sBuf, 2) = CRLF Then
        sBuf = Left(sBuf, Len(sBuf) - 2)
    EndIf
    Return "[output]" & sBuf & "[/output]"
End Function

Private Function jAppend(ByVal sFile As String, ByVal sLine As String) As Long
    Dim As Long fp = FreeFile

    If Open(sFile For Append As #fp) = 0 Then
        Print #fp, sLine
        Close #fp
        Return 1 'Success
    Else
        Return 0 'Failed
    EndIf
End Function

Function WinMain( _
    ByVal hInstance     As HINSTANCE, _
    ByVal hPrevInstance As HINSTANCE, _
    ByVal szCmdLine     As ZString Ptr, _
    ByVal nCmdShow      As Long _
    ) As Long

    Dim As Long rc

    'Jim, redo the folder names to match your need.
    '$ as prefix will tel the compiler not to interpret \ as an escapr character.
    If jAppend($"C:\Tmp\jTest1.log", CRLF & $"jTest1.exe: " & Date & " " & Time) = 1 Then
        If jAppend($"C:\Tmp\jTest1.log", jPipe($"dir D:\Dev\Free\bas\*.xml")) = 0 Then
            ? "Error 2: Unable to append to C:\Temp\jTest1.log"
        EndIf
    Else
        ? "Error 1: Unable to append to C:\Temp\jTest1.log"
    EndIf
    WinMain = 0
    ? "Done."
    Dim buttons As Long : Do : GetMouse(0, 0, 0, Buttons) : IF buttons Or Len(InKey) Then Exit Do : End If : Sleep 50 : Loop
End Function

End WinMain(GetModuleHandle(Null), Null, Command(), SW_NORMAL)
jimdunn
Posts: 13
Joined: Jan 28, 2016 15:07

Re: Windows Service

Post by jimdunn »

NP, always better LATE than NEVER! : )

And you're right, I was being very lazy trying to get "scHandle" from "Cast(SC_HANDLE, GetModuleHandle(NULL)"... I had looked at the OpenService() code... but just didn't have the time at the time...

Now, as for the "log file"... I haven't had any issues. In fact, I made 2 executables, with and without the "$" in front of the strings... and although the EXE files are slightly different, I got the proper LOG files, just the same.

Is there something special about using the "$" that I should know? It seems to work without it...

Thx!
Pierre Bellisle
Posts: 56
Joined: Dec 11, 2016 17:22

Re: Windows Service

Post by Pierre Bellisle »

All is fine then. Great!

About "$", it prevent the string following it to see "\" as an escape character.
The string between quotes will be literally used.
There is a topic in the help about $, you will also see the "Option Escape" there.
I often use it, specially with path names.

Some escape character you may fall on \a \b \f \l \n \r \t \v... View them under "Escape sequences" in the help.

For example, If I write Print "C:\a\Temp\jTest1.log"
The compiler with the -w pedantic option respond with
Possible escape sequence found in: "C:\a\Temp\jTest1.log"
No message with "$"

Regards
jimdunn
Posts: 13
Joined: Jan 28, 2016 15:07

Re: Windows Service

Post by jimdunn »

PERFECT!!

Oh, and thanks for this:

Code: Select all

Dim buttons As Long : Do : GetMouse(0, 0, 0, Buttons) : IF buttons Or Len(InKey) Then Exit Do : End If : Sleep 50 : Loop
Very cool !!! : )
Post Reply