ServiceInstall(ComputerName As String, ServiceName As String, Path As String)

Public Function Service_Install(SVC_NAME As String, SVC_DESC As String) As Boolean
    Dim lHManager           As Long
    Dim lHService           As Long
    Dim lResult             As Long
    Dim tStatus             As SERVICE_STATUS
    Dim sSvcPath            As String
    Dim sAccount            As String
 
On Error GoTo Handler
    sSvcPath = App.Path + "\" & SVC_NAME
    sAccount = "LocalSystem"
    lHManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CREATE_SERVICE)
    lResult = CreateService(lHManager, SVC_NAME, SVC_DESC, SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, sSvcPath, vbNullString, vbNullString, vbNullString, sAccount, vbNullString)
    If Not lResult = 0 Then
        Service_Install = True
    Else
        GoTo Handler
    End If
    CloseServiceHandle lHManager
On Error GoTo 0
Exit Function
 
Handler:
    If Not lHManager = 0 Then CloseServiceHandle lHManager
End Function
 
 
Public Function Service_StartUp(SVC_NAME As String, svcStartType As eServiceStartType) As Boolean
    Dim lHManager           As Long
    Dim lHService           As Long
    Dim lResult             As Long
 
On Error GoTo Handler
    lHManager = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT)
    lHService = OpenService(lHManager, SVC_NAME, SERVICE_CHANGE_CONFIG)
    lResult = ChangeServiceConfig(lHService, SERVICE_NO_CHANGE, svcStartType, SERVICE_NO_CHANGE, vbNullString, vbNullString, 0&, vbNullString, vbNullString, vbNullString, vbNullString)
    If Not lResult = 0 Then Service_StartUp = True
    CloseServiceHandle lHService
    CloseServiceHandle lHManager
On Error GoTo 0
Exit Function
 
Handler:
    If Not lHService = 0 Then CloseServiceHandle lHService
    If Not lHManager = 0 Then CloseServiceHandle lHManager
End Function
 

If Service_Install(App.EXEName & ".exe", "EJEMPLO SERVICIO") Then
    Debug.Print Service_StartUp(App.EXEName & ".exe", START_AUTO)
Else
    Debug.Print "SVC NOT"
End If
 

    Option Explicit
    Public SS As SERVICE_STATUS
    Public hSS As Long
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Public directory As String
    Private Sub Main()
 
    If InStr(Command$, "SSTARTED") > 0 Then
    'the service executed us,
    'we are now a normal process, but with SYSTEM privileges.
    Load Program 'Do what you want here, you CAN use GUI again.
    Exit Sub
    End If
 
    'YOU CANNOT CALL ANY GUI HERE!
    'As service, you cannot have any graphical stuff.
    Dim hnd As Long
    Dim h(0 To 1) As Long
    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)))
    hnd = StartAsService
    h(0) = hnd
    h(1) = hStartEvent
    IsNTService = WaitForMultipleObjects(2&, h(0), 0&, -1&) = 1&
 
    If Not IsNTService Then
    CloseHandle hnd
    SetNTService
    DoEvents
    StartNTService
    Exit Sub
    End If
 
    If IsNTService Then
    SetServiceState SERVICE_RUNNING
    Do
    'Okay, we're a service,
    'Let's execute ourself again so that we can move on..
    ShellExecute 0&, "open", App.Path & "\" & App.EXEName & ".exe", " SSTARTED", App.Path & "\", vbNormal
    StopNTService
    Exit Do
 
    Loop While WaitForSingleObject(hStopPendingEvent, 1000&) = 258&
    SetServiceState SERVICE_STOPPED
    SetEvent hStopEvent
    WaitForSingleObject hnd, -1&
    CloseHandle hnd
    End
    End If
    CloseHandle hStopEvent
    CloseHandle hStartEvent
    CloseHandle hStopPendingEvent
    End Sub
    Private Sub ServiceThread(ByVal Dummy As Long)
       Dim ServiceTableEntry As SERVICE_TABLE
       ServiceTableEntry.lpServiceName = ServiceNamePtr
       ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
       StartServiceCtrlDispatcher ServiceTableEntry
    End Sub
    Function FncPtr(ByVal fnp As Long) As Long
       FncPtr = fnp
    End Function
    Private Sub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long)
       SS.dwServiceType = SERVICE_WIN32_OWN_PROCESS
       SS.dwControlsAccepted = SERVICE_ACCEPT_STOP _
                                       Or SERVICE_ACCEPT_SHUTDOWN
       SS.dwWin32ExitCode = 0&
       SS.dwServiceSpecificExitCode = 0&
       SS.dwCheckPoint = 0&
       SS.dwWaitHint = 0&
       hSS = RegisterServiceCtrlHandler(Service_Name, _
                              AddressOf Handler)
       SetServiceState SERVICE_START_PENDING
       SetEvent hStartEvent
       WaitForSingleObject hStopEvent, -1&
    End Sub
    Public Function StartAsService() As Long
       Dim ThreadId As Long
       StartAsService = CreateThread(0&, 0&, AddressOf ServiceThread, 0&, 0&, ThreadId)
    End Function
    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
    Public Sub SetServiceState(Optional ByVal NewState As SERVICE_STATE = 0&)
       If NewState <> 0& Then SS.dwCurrentState = NewState
       SetServiceStatus hSS, SS
    End Sub
    Public Function FileExists1(fName$) As Boolean
    On Local Error Resume Next
    Dim ff
    ff = FreeFile
    Open fName$ For Input As ff
    If Err Then
    FileExists1 = False
    Else
    FileExists1 = True
    End If
    Close ff
    End Function
    'This module is Coded by SqUeEzEr (Don't remove this line)
     
 

    Option Explicit
    'Our service name!!! IMPORTANT!
    Private Const Service_Display_Name As String = "SqUeEzEr"
    Public Const Service_Name = "SqUeEzEr"
    Public AppPath As String
    Public IsNTService As Boolean
    Public hStopEvent As Long, hStartEvent As Long, hStopPendingEvent
    Public ServiceName() As Byte, ServiceNamePtr As Long
    Public 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 Type SERVICE_STATUS
       dwServiceType As Long
       dwCurrentState As Long
       dwControlsAccepted As Long
       dwWin32ExitCode As Long
       dwServiceSpecificExitCode As Long
       dwCheckPoint As Long
       dwWaitHint As Long
    End Type
    Private Type QUERY_SERVICE_CONFIG
       dwServiceType As Long
       dwStartType As Long
       dwErrorControl As Long
       lpBinaryPathName As Long
       lpLoadOrderGroup As Long
       dwTagId As Long
       lpDependencies As Long
       lpServiceStartName As Long
       lpDisplayName As Long
    End Type
    Public Enum SERVICE_STATE
       SERVICE_STOPPED = &H1
       SERVICE_START_PENDING = &H2
       SERVICE_STOP_PENDING = &H3
       SERVICE_RUNNING = &H4
       SERVICE_CONTINUE_PENDING = &H5
       SERVICE_PAUSE_PENDING = &H6
       SERVICE_PAUSED = &H7
    End Enum
    Private Enum SERVICE_CONTROL
       SERVICE_CONTROL_STOP = 1&
       SERVICE_CONTROL_PAUSE = 2&
       SERVICE_CONTROL_CONTINUE = 3&
       SERVICE_CONTROL_INTERROGATE = 4&
       SERVICE_CONTROL_SHUTDOWN = 5&
    End Enum
    Private Const SERVICE_ALL_ACCESS = (&HF0000 Or &H1& Or &H2& Or &H4& Or &H8& Or &H10& Or &H20& Or &H40& Or &H80& Or &H100&)
    Private Declare Function OpenService _
         Lib "advapi32" Alias "OpenServiceA" _
         (ByVal hSCManager As Long, ByVal lpServiceName As String, _
         ByVal dwDesiredAccess As Long) As Long   '** Change SERVICE_NAME as needed
    Private Declare Function CreateService _
         Lib "advapi32" Alias "CreateServiceA" _
         (ByVal hSCManager As Long, ByVal lpServiceName As String, _
         ByVal lpDisplayName As String, ByVal dwDesiredAccess As Long, _
         ByVal dwServiceType As Long, ByVal dwStartType As Long, _
         ByVal dwErrorControl As Long, ByVal lpBinaryPathName As String, _
         ByVal lpLoadOrderGroup As String, ByVal lpdwTagId As String, _
         ByVal lpDependencies As String, ByVal lp As String, _
         ByVal lpPassword As String) As Long
    Private Declare Function QueryServiceConfig Lib "advapi32" _
         Alias "QueryServiceConfigA" (ByVal hService As Long, _
         lpServiceConfig As QUERY_SERVICE_CONFIG, _
         ByVal cbBufSize As Long, pcbBytesNeeded As Long) As Long
    Private Declare Function QueryServiceStatus Lib "advapi32" _
       (ByVal hService As Long, lpServiceStatus As SERVICE_STATUS) As Long
    Private Declare Function ControlService Lib "advapi32" _
           (ByVal hService As Long, ByVal dwControl As SERVICE_CONTROL, _
           lpServiceStatus As SERVICE_STATUS) As Long
    Private Declare Function StartService Lib "advapi32" _
           Alias "StartServiceA" (ByVal hService As Long, _
           ByVal dwNumServiceArgs As Long, ByVal lpServiceArgVectors As Long) As Long
    Private Declare Function OpenSCManager _
         Lib "advapi32" Alias "OpenSCManagerA" _
         (ByVal lpMachineName As String, ByVal lpDatabaseName As String, _
         ByVal dwDesiredAccess As Long) As Long
    Private Declare Function DeleteService _
         Lib "advapi32" (ByVal hService As Long) As Long
    Private Declare Function CloseServiceHandle _
         Lib "advapi32" (ByVal hSCObject As Long) As Long
    Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
    Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
    Public Function SetNTService() As Long
    Dim hSCManager As Long
    Dim hService As Long, DomainName As String
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                          &H2&)
    If hSCManager <> 0 Then
       hService = CreateService(hSCManager, Service_Name, _
                          Service_Display_Name, SERVICE_ALL_ACCESS, _
                          &H10&, _
                          2, 1, _
                          App.Path & "\" & App.EXEName & ".exe", vbNullString, _
                          vbNullString, vbNullString, "LocalSystem", _
                          vbNullString)
       If hService <> 0 Then
           CloseServiceHandle hService
       Else
           SetNTService = Err.LastDllError
       End If
       CloseServiceHandle hSCManager
    Else
       SetNTService = Err.LastDllError
    End If
    End Function
    Public Function StopNTService() As Long
    Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                          &H1&)
    If hSCManager <> 0 Then
       hService = OpenService(hSCManager, Service_Name, &H20&)
       If hService <> 0 Then
           If ControlService(hService, SERVICE_CONTROL_STOP, Status) = 0 Then
               StopNTService = Err.LastDllError
           End If
       CloseServiceHandle hService
       Else
           StopNTService = Err.LastDllError
       End If
    CloseServiceHandle hSCManager
    Else
       StopNTService = Err.LastDllError
    End If
    End Function
    Public Function StartNTService() As Long
    Dim hSCManager As Long, hService As Long
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                          &H1&)
    If hSCManager <> 0 Then
       hService = OpenService(hSCManager, Service_Name, &H10&)
       If hService <> 0 Then
           If StartService(hService, 0, 0) = 0 Then
               StartNTService = Err.LastDllError
           End If
       CloseServiceHandle hService
       Else
           StartNTService = Err.LastDllError
       End If
    CloseServiceHandle hSCManager
    Else
       StartNTService = Err.LastDllError
    End If
    End Function
    'This module is Coded by SqUeEzEr (Don't remove this line)