Option Explicit
Private Const NO_ERROR = 0
Private Const SERVICE_WIN32_OWN_PROCESS = &H10&
Private Const SERVICE_WIN32_SHARE_PROCESS = &H20&
Private Const SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS + _
SERVICE_WIN32_SHARE_PROCESS
Private Const SERVICE_ACCEPT_STOP = &H1
Private Const SERVICE_ACCEPT_PAUSE_CONTINUE = &H2
Private Const SERVICE_ACCEPT_SHUTDOWN = &H4
Private Const SC_MANAGER_CONNECT = &H1
Private Const SC_MANAGER_CREATE_SERVICE = &H2
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Private Const SC_MANAGER_LOCK = &H8
Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10
Private Const SC_MANAGER_MODIFY_BOOT_CONFIG = &H20
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SERVICE_QUERY_CONFIG = &H1
Private Const SERVICE_CHANGE_CONFIG = &H2
Private Const SERVICE_QUERY_STATUS = &H4
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8
Private Const SERVICE_START = &H10
Private Const SERVICE_STOP = &H20
Private Const SERVICE_PAUSE_CONTINUE = &H40
Private Const SERVICE_INTERROGATE = &H80
Private Const SERVICE_USER_DEFINED_CONTROL = &H100
Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
SERVICE_QUERY_CONFIG Or _
SERVICE_CHANGE_CONFIG Or _
SERVICE_QUERY_STATUS Or _
SERVICE_ENUMERATE_DEPENDENTS Or _
SERVICE_START Or _
SERVICE_STOP Or _
SERVICE_PAUSE_CONTINUE Or _
SERVICE_INTERROGATE Or _
SERVICE_USER_DEFINED_CONTROL)
Private Const SERVICE_DEMAND_START As Long = &H3
Private Const SERVICE_ERROR_NORMAL As Long = &H1
' Private Enum SERVICE_CONTROL
Private Const SERVICE_CONTROL_STOP = &H1
Private Const SERVICE_CONTROL_PAUSE = &H2
Private Const SERVICE_CONTROL_CONTINUE = &H3
Private Const SERVICE_CONTROL_INTERROGATE = &H4
Private Const SERVICE_CONTROL_SHUTDOWN = &H5
' End Enum
' Private Enum SERVICE_STATE
Private Const SERVICE_STOPPED = &H1
Private Const SERVICE_START_PENDING = &H2
Private Const SERVICE_STOP_PENDING = &H3
Private Const SERVICE_RUNNING = &H4
Private Const SERVICE_CONTINUE_PENDING = &H5
Private Const SERVICE_PAUSE_PENDING = &H6
Private Const SERVICE_PAUSED = &H7
' End Enum
'typedef struct _SERVICE_TABLE_ENTRY {
' LPTSTR lpServiceName;
' LPSERVICE_MAIN_FUNCTION lpServiceProc;
'} SERVICE_TABLE_ENTRY, *LPSERVICE_TABLE_ENTRY;
'http://msdn.microsoft.com/en-us/library/ms686001%28v=vs.85%29.aspx
Type SERVICE_TABLE_ENTRY
lpServiceName As String
lpServiceProc As Long
End Type
'BOOL WINAPI StartServiceCtrlDispatcher(
' __in const SERVICE_TABLE_ENTRY *lpServiceTable
');
'http://msdn.microsoft.com/en-us/library/ms686324%28v=vs.85%29.aspx
Private Declare Function StartServiceCtrlDispatcher Lib "advapi32.dll" Alias "StartServiceCtrlDispatcherA" (lpServiceStartTable As SERVICE_TABLE_ENTRY) As Long
'typedef struct _SERVICE_STATUS {
' DWORD dwServiceType;
' DWORD dwCurrentState;
' DWORD dwControlsAccepted;
' DWORD dwWin32ExitCode;
' DWORD dwServiceSpecificExitCode;
' DWORD dwCheckPoint;
' DWORD dwWaitHint;
'} SERVICE_STATUS, *LPSERVICE_STATUS;
'http://msdn.microsoft.com/en-us/library/ms685996%28VS.85%29.aspx
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
'SERVICE_STATUS_HANDLE WINAPI RegisterServiceCtrlHandler(
' __in LPCTSTR lpServiceName,
' __in LPHANDLER_FUNCTION lpHandlerProc
');
'http://msdn.microsoft.com/en-us/library/ms685054%28VS.85%29.aspx
Public Declare Function RegisterServiceCtrlHandler Lib "advapi32.dll" Alias "RegisterServiceCtrlHandlerA" (ByVal lpServiceName As String, ByVal lpHandlerProc As Long) As Long
'void WINAPI OutputDebugString(
' __in_opt LPCTSTR lpOutputString
');
'http://msdn.microsoft.com/en-us/library/aa363362%28VS.85%29.aspx
Public Declare Sub OutputDebugString Lib "kernel32.dll" Alias "OutputDebugStringA" (ByVal lpServiceTable As String)
'BOOL WINAPI SetServiceStatus(
' __in SERVICE_STATUS_HANDLE hServiceStatus,
' __in LPSERVICE_STATUS lpServiceStatus
');
'http://msdn.microsoft.com/en-us/library/ms686241%28VS.85%29.aspx
Public Declare Function SetServiceStatus Lib "advapi32.dll" (ByVal hServiceStatus As Long, ByVal lpServiceStatus As Long) As Long
'DWORD WINAPI GetLastError(void);
'http://msdn.microsoft.com/en-us/library/ms679360%28v=VS.85%29.aspx
Public Declare Function GetLastError Lib "kernel32.dll" () As Long
Dim MyServiceStatus As SERVICE_STATUS
Dim MyServiceStatusHandle As Long
Public Function getLPFunc(ByVal lpFunc As Long) As Long
getLPFunc = lpFunc
End Function
Sub main()
Dim DispatchTable(1) As SERVICE_TABLE_ENTRY
DispatchTable(0).lpServiceName = "MyService"
DispatchTable(0).lpServiceProc = getLPFunc(AddressOf MyServiceStart)
DispatchTable(1).lpServiceName = vbNullString
DispatchTable(1).lpServiceProc = &H0
If (Not StartServiceCtrlDispatcher(DispatchTable(0))) Then
OutputDebugString " [MY_SERVICE] StartServiceCtrlDispatcher " & GetLastError
End If
End Sub
Public Function MyServiceStart(ByVal lCantArg As Long, ByVal lpArgv As Long)
Dim status As Long
Dim SpecificError As Long
MyServiceStatus.dwServiceType = SERVICE_WIN32
MyServiceStatus.dwCurrentState = SERVICE_START_PENDING
MyServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP Or SERVICE_ACCEPT_PAUSE_CONTINUE
MyServiceStatus.dwWin32ExitCode = 0
MyServiceStatus.dwServiceSpecificExitCode = 0
MyServiceStatus.dwCheckPoint = 0
MyServiceStatus.dwWaitHint = 0
MyServiceStatusHandle = RegisterServiceCtrlHandler("MyService", getLPFunc(AddressOf MyServiceCtrlHandler))
If (MyServiceStatusHandle = &H0) Then
status = GetLastError()
OutputDebugString (" [MY_SERVICE] RegisterServiceCtrlHandler failed " & status)
Exit Function
End If
status = MyServiceInitialization(lCantArg, lpArgv, SpecificError)
If (Not (status = NO_ERROR)) Then
MyServiceStatus.dwCurrentState = SERVICE_STOPPED
MyServiceStatus.dwCheckPoint = 0
MyServiceStatus.dwWaitHint = 0
MyServiceStatus.dwWin32ExitCode = status
MyServiceStatus.dwServiceSpecificExitCode = SpecificError
SetServiceStatus MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus)
Exit Function
End If
MyServiceStatus.dwCurrentState = SERVICE_RUNNING
MyServiceStatus.dwCheckPoint = 0
MyServiceStatus.dwWaitHint = 0
If (Not SetServiceStatus(MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus))) Then
status = GetLastError()
OutputDebugString (" [MY_SERVICE] RegisterServiceCtrlHandler error " & status)
End If
OutputDebugString (" [MY_SERVICE] Returning the Main Thread ")
End Function
Public Function MyServiceInitialization(ByVal lCantArg As Long, ByVal lpArgv As Long, ByRef SpecificError As Long)
Dim ff As Long
ff = FreeFile
Open "c:\Servicio en VB6.txt" For Binary As ff
Put ff, , "Hola mundo desde un servicio creado en vb6"
Close ff
MyServiceInitialization = 0
End Function
Public Sub MyServiceCtrlHandler(ByVal Opcode As Long)
Dim status As Long
Select Case (Opcode)
Case SERVICE_CONTROL_PAUSE:
MyServiceStatus.dwCurrentState = SERVICE_PAUSED
Case SERVICE_CONTROL_CONTINUE:
MyServiceStatus.dwCurrentState = SERVICE_RUNNING
Case SERVICE_CONTROL_STOP:
MyServiceStatus.dwWin32ExitCode = 0
MyServiceStatus.dwCurrentState = SERVICE_STOPPED
MyServiceStatus.dwCheckPoint = 0
MyServiceStatus.dwWaitHint = 0
If (Not SetServiceStatus(MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus))) Then
status = GetLastError()
OutputDebugString " [MY_SERVICE] SetServiceStatus error " & status
End If
OutputDebugString " [MY_SERVICE] Leaving MyService"
Exit Sub
Case SERVICE_CONTROL_INTERROGATE:
Case Else
OutputDebugString " [MY_SERVICE] Unrecognized opcode " & Opcode
End Select
If (Not SetServiceStatus(MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus))) Then
status = GetLastError()
OutputDebugString " [MY_SERVICE] SetServiceStatus error " & status
End If
End Sub
Autor
En línea
pero ya le probado 
