• Home
 · 
• Miscellaneous
 · 
• Full source of Service Program

Full source of Service Program

Full source of Service Program

API Declarations


' VB-friendly NT Service API Functions




Rate Full source of Service Program

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'Module		:	
'Service Name	:    frmService
'Database		:
'Created By	:    C. Raghuraja, India
'Created Date        :    05-Jan-2005
'Description	:    Service Source Program

Option Explicit


    '------------------------------------------------------------------------
    ' Win API 関数
    '------------------------------------------------------------------------
    Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
    Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long

    Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion(1 To 128) As Byte                                      'Maintenance string for PSS usage
    End Type
    
    Private Const VER_PLATFORM_WIN32_NT = 2&
    Private Const INFINITE = -1&                                            'Infinite timeout
    Private Const WAIT_TIMEOUT = 258&
    Private ServiceStatus       As SERVICE_STATUS
    Private hServiceStatus      As Long
   
    Dim hStopEvent              As Long
    Dim hStartEvent             As Long
    Dim hStopPendingEvent
    Dim IsNT                    As Boolean
    Dim IsNTService             As Boolean
    Dim ServiceName()           As Byte
    Dim ServiceNamePtr          As Long

    'Service Name
    Private Const Service_Name  As String = "My Testing Service"

Public Sub fnSERVICE()
    On Error GoTo LOCALERRORHANDLER
    
    ' ===== SERVICE WILL START FROM HERE =====
    
    Dim hnd        As Long
    Dim h(0 To 1)  As Long
    
    ' Only one instance
    If App.PrevInstance Then Exit Sub
    
    ' Check OS type
    IsNT = CheckIsNT()
    
    ' Creating events
    hStopEvent = CreateEvent(0, 1, 0, vbNullString)
    hStopPendingEvent = CreateEvent(0, 1, 0, vbNullString)
    hStartEvent = CreateEvent(0, 1, 0, vbNullString)
    ServiceName = StrConv(Service_Name, vbFromUnicode)
    ServiceNamePtr = VarPtr(ServiceName(LBound(ServiceName)))
    
    If IsNT Then
        
        'Trying to start service
        hnd = StartAsService
        h(0) = hnd
        h(1) = hStartEvent
        
        'Waiting for one of two events: sucsessful service start (1) or Terminaton of service thread (0)
        
        IsNTService = WaitForMultipleObjects(2&, h(0), 0&, INFINITE) = 1&
        
        If Not IsNTService Then
            CloseHandle hnd
            MessageBox "Service program must be started as a service.","Service"
        End If
    
    Else
        
       MessageBox "Service program is only for Windows NT/2000/XP.","Service"
    
    End If
    
**********************************
    
    If IsNTService Then
        
        SetServiceState SERVICE_RUNNING

        '  ---------  From Here Service Will Run  ----------
        
        Do
        
            '---------------------------------------------------------
            'From Here What ever code writes will File in the Service Program
            '---------------------------------------------------------
	
	'Please write your Code to Fire as Service	
	MessageBox "Service is Running","Service"            

            '---------------------------------------------------------
            'Sleep for given amount of minutes (60000 = 1 Minute) 
            'You can Increase / Decrease
            '---------------------------------------------------------
          
        Loop While WaitForSingleObject(hStopPendingEvent, 60000) = WAIT_TIMEOUT
        
        ' Here you may stop and destroy service's objects
        SetServiceState SERVICE_STOPPED
        
        SetEvent hStopEvent
        
        ' Waiting for service thread termination
        WaitForSingleObject hnd, INFINITE
        CloseHandle hnd
    
    End If
    
    CloseHandle hStopEvent
    CloseHandle hStartEvent
    CloseHandle hStopPendingEvent
    
    'To Write message to Log File
   MessageBox "Service has Stopped","Service"
    
    Exit Sub
LOCALERRORHANDLER:
    Call fnERRLOG("Error Occured:" & Err.Number & ":" & Err.Description)
End Sub

' CheckIsNT() returns True, if the program runs
' under Windows NT or Windows 2000, and False
' otherwise.
Private Function CheckIsNT() As Boolean
    Dim OSVer As OSVERSIONINFO
    OSVer.dwOSVersionInfoSize = LenB(OSVer)
    GetVersionEx OSVer
    CheckIsNT = OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT
End Function

' The FncPtr function returns function pointer.
Private Function FncPtr(ByVal fnp As Long) As Long
    FncPtr = fnp
End Function

' The StartAsService function creates Service Dispatcher thread.
Private Function StartAsService() As Long
    Dim ThreadId As Long
    StartAsService = CreateThread(0&, 0&, AddressOf ServiceThread, 0&, 0&, ThreadId)
End Function

' The ServiceThread sub starts the service.
' This sub returns control only after service termination.
Private Sub ServiceThread(ByVal dummy As Long)
    Dim ServiceTableEntry As SERVICE_TABLE
    ServiceTableEntry.lpServiceName = ServiceNamePtr
    ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
    StartServiceCtrlDispatcher ServiceTableEntry
End Sub

' The ServiceMain sub - main service sub.
' It initializes service,
' sets event hStartEvent, and waits hStopEvent event.
' When hStopEvent fires, this sub exits and service stops.
Private Sub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long)
    ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
    ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP _
                                    Or SERVICE_ACCEPT_SHUTDOWN
    ServiceStatus.dwWin32ExitCode = 0&
    ServiceStatus.dwServiceSpecificExitCode = 0&
    ServiceStatus.dwCheckPoint = 0&
    ServiceStatus.dwWaitHint = 0&
    hServiceStatus = RegisterServiceCtrlHandler(Service_Name, _
                           AddressOf Handler)
    SetServiceState SERVICE_START_PENDING
    ' Set hStartEvent. It unlocks main application thread
    ' which allows to do some work in it
    SetEvent hStartEvent
    ' Wait until hStopEvent fires
    WaitForSingleObject hStopEvent, INFINITE
End Sub

' The Handler sub processes commands from Service Dispatcher.
' It sets event hStopEvent when processes command
' SERVICE_CONTROL_STOP or SERVICE_CONTROL_SHUTDOWN.
Private Sub Handler(ByVal fdwControl As Long)
    Select Case fdwControl
        Case SERVICE_CONTROL_SHUTDOWN, SERVICE_CONTROL_STOP
            SetServiceState SERVICE_STOP_PENDING
            SetEvent hStopPendingEvent
        Case Else
            SetServiceState
    End Select
End Sub

' The SetServiceState sub changes service state.
' If parameter omitted, it confirms previous state.
Private Sub SetServiceState(Optional ByVal NewState As SERVICE_STATE = 0&)
    If NewState <> 0& Then ServiceStatus.dwCurrentState = NewState
    SetServiceStatus hServiceStatus, ServiceStatus
End Sub