title image


Smiley Re: Unter WinNT 4.0 (Server) Prog. als Hintergrund Prozess laufen lassen
Ich hab die ein Modul weiter unten angehängt, wo du einen Source siehst, wie es funktioniert. Es wird dabei auf die integrierten Funktionen des Service_Control_Managers von Windows NT zugegriffen. Weiters gibt es von MS auch eine eigene OCX, mit dieser kannst du ebenfalls eine App als Service laufen lassen. Diese kann ich dir aber nicht schicken, da sie eine MSDN-Subscription erfordert und sie ohnehin nicht supported wird.GrüßeMarcelDer Source:Attribute VB_Name = "basNTSrv"Option Explicit 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 SERVICE_CONTROL_STOP = &H1 SERVICE_CONTROL_PAUSE = &H2 SERVICE_CONTROL_CONTINUE = &H3 SERVICE_CONTROL_INTERROGATE = &H4 SERVICE_CONTROL_SHUTDOWN = &H5 End Enum Private 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 Type SERVICE_TABLE_ENTRY lpServiceName As String lpServiceProc As Long lpServiceNameNull As Long lpServiceProcNull As Long End Type 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 Declare Function StartServiceCtrlDispatcher _ Lib "advapi32.dll" Alias "StartServiceCtrlDispatcherA" _ (lpServiceStartTable As SERVICE_TABLE_ENTRY) As Long Private Declare Function RegisterServiceCtrlHandler _ Lib "advapi32.dll" Alias "RegisterServiceCtrlHandlerA" _ (ByVal lpServiceName As String, ByVal lpHandlerProc As Long) _ As Long Private Declare Function SetServiceStatus _ Lib "advapi32.dll" (ByVal hServiceStatus As Long, _ lpServiceStatus As SERVICE_STATUS) As Long Private Declare Function OpenSCManager _ Lib "advapi32.dll" Alias "OpenSCManagerA" _ (ByVal lpMachineName As String, ByVal lpDatabaseName As String, _ ByVal dwDesiredAccess As Long) As Long Private Declare Function CreateService _ Lib "advapi32.dll" 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 DeleteService _ Lib "advapi32.dll" (ByVal hService As Long) As Long Declare Function CloseServiceHandle _ Lib "advapi32.dll" (ByVal hSCObject As Long) As Long Declare Function OpenService _ Lib "advapi32.dll" Alias "OpenServiceA" _ (ByVal hSCManager As Long, ByVal lpServiceName As String, _ ByVal dwDesiredAccess As Long) As Long' SERVICE NAME Private Const SERVICE_NAME As String = "Test"' Hier den Namen des Service eintragen... Private hServiceStatus As Long Private ServiceStatus As SERVICE_STATUS Sub SrvHandle() Dim hSCManager As Long Dim hService As Long Dim ServiceTableEntry As SERVICE_TABLE_ENTRY Dim b As Boolean Dim cmd As String cmd = Trim(LCase(Command())) Select Case cmd Case "-install" 'Install service hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CREATE_SERVICE) hService = CreateService(hSCManager, SERVICE_NAME, _ SERVICE_NAME, SERVICE_ALL_ACCESS, _ SERVICE_WIN32_OWN_PROCESS, _ SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, _ App.Path & "\" & App.EXEName, vbNullString, _ vbNullString, vbNullString, vbNullString, _ vbNullString) CloseServiceHandle hService CloseServiceHandle hSCManager Case "-uninstall" 'Remove service hSCManager = OpenSCManager(vbNullString, vbNullString, _ SC_MANAGER_CREATE_SERVICE) hService = OpenService(hSCManager, SERVICE_NAME, _ SERVICE_ALL_ACCESS) DeleteService hService CloseServiceHandle hService CloseServiceHandle hSCManager 'Case Else Start service ' ServiceTableEntry.lpServiceName = SERVICE_NAME ' ServiceTableEntry.lpServiceProc = _ FncPtr(AddressOf ServiceMain) 'b = StartServiceCtrlDispatcher(ServiceTableEntry) End Select End Sub Sub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long) Dim b As Boolean 'Set initial state ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS ServiceStatus.dwCurrentState = SERVICE_START_PENDING ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP _ Or SERVICE_ACCEPT_PAUSE_CONTINUE _ Or SERVICE_ACCEPT_SHUTDOWN ServiceStatus.dwWin32ExitCode = 0 ServiceStatus.dwServiceSpecificExitCode = 0 ServiceStatus.dwCheckPoint = 0 ServiceStatus.dwWaitHint = 0 hServiceStatus = RegisterServiceCtrlHandler(SERVICE_NAME, _ AddressOf Handler) ServiceStatus.dwCurrentState = SERVICE_START_PENDING b = SetServiceStatus(hServiceStatus, ServiceStatus) '** Do Initialization Here '** Perform tasks -- if none exit ''** If an error occurs the following should be used for shutting ''** down: '' SetServerStatus SERVICE_STOP_PENDING '' Clean up '' SetServerStatus SERVICE_STOPPED End Sub Sub Handler(ByVal fdwControl As Long) Dim b As Boolean Select Case fdwControl Case SERVICE_CONTROL_PAUSE '** Do whatever it takes to pause here. ServiceStatus.dwCurrentState = SERVICE_PAUSED Case SERVICE_CONTROL_CONTINUE '** Do whatever it takes to continue here. ServiceStatus.dwCurrentState = SERVICE_RUNNING Case SERVICE_CONTROL_STOP ServiceStatus.dwWin32ExitCode = 0 ServiceStatus.dwCurrentState = SERVICE_STOP_PENDING ServiceStatus.dwCheckPoint = 0 ServiceStatus.dwWaitHint = 0 'Might want a time estimate b = SetServiceStatus(hServiceStatus, ServiceStatus) '** Do whatever it takes to stop here. ServiceStatus.dwCurrentState = SERVICE_STOPPED Case SERVICE_CONTROL_INTERROGATE 'Fall through to send current status. Case Else End Select 'Send current status. b = SetServiceStatus(hServiceStatus, ServiceStatus) End Sub Function FncPtr(ByVal fnp As Long) As Long FncPtr = fnp End Function

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: