tampoco :
estos diaz e buscado, y buscado pero no hay mucha informacion
al menos no como inciar un servicio propio y que funcione bien e encontrado esto pero al paracer no esta terminado creo
y segun el autor funciona perfectamente y el preciso para eso
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)
e analizado los codigos expuestos pero no entiendo mucho
mas o menos creo que la secuencia es que se finaliza y luego se abre de nuevo como servicio propio y en ese casi si funciona
bueno la verdad si e puesto empeño en resolver este problema pero no e podido
Autor
En línea
