Nur noch SERVICE_NAME und SERVICE_DESCRIPTION anpassen, sowie Code in thMain(...) erweitern und Fertig.
Das LogFile werden abgelegt in:
XP: "C:\Documents and Settings\All Users\Application Data\[SERVICE_NAME]"
W7: "C:\ProgramData\[SERVICE_NAME]
Für Verbesserungsvorschläge bin ich offen
Update v1.02
- kleine fehler
Update v1.03
- Anpassung an X64
- Writelog in Mutex gepackt. Sollte man noch auf Umlaufarchive überarbeiten
- PB Funktion für Verzeichnis erstellen genommen
Update v1.04
- Hinzugefügt: Bei bedarf den Dienst unter andere Anmeldung laufen lassen
Update v1.05
- Bugfix: Programm beendete nicht wenn svInit() fehl schlug
Empfehlung:
- Threadsicheres Executable erstellen
- Administrator-Modus anfordern
Update v2.01
- Code auf neusten Stand gebracht.
Update v2.03
- Fix Open Logfile
Code: Alles auswählen
;- TOP
; Comment : MySerive Base Program
; Author1 : ?
; Author2 : mk-soft
; Version : v2.03
; Update : 13.08.2019
; Install Service 'Servicename.exe install or /i'
; Uninstall Service 'Servicename.exe uninstall or /u'
; *****************************************************************************
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compiler-Option ThreadSafe!"
CompilerEndIf
EnableExplicit
#EnableLogging = #True
; *****************************************************************************
;- Konstanten
#SERVICE_USERDATA_128 = 128
#SERVICE_USERDATA_129 = 129
#SERVICE_USERDATA_130 = 130
#SERVICE_USERDATA_131 = 131
;- Structuren
Structure udtThreadControl
; Service Control Data
ThreadID.i
Command.i
EndStructure
;- Global Services Variables
Global ServiceStatus.SERVICE_STATUS
Global hServiceStatus.i
Global AppPath.s
Global AppPathName.s
Global AppPathLog.s
Global AppFileLog.s
Global ExitService.i
Global SERVICE_NAME.s
Global SERVICE_DESCRIPTION.s
Global SERVICE_STARTNAME.s
Global SERVICE_PASSWORD.s
;- Global Variables
Global MutexLog
Global MainThread.udtThreadControl
;- Declare Function´s
Declare svHandler(fdwControl.i)
Declare svServiceMain(dwArgc.i, lpszArgv.i)
Declare svInit()
Declare svPause()
Declare svContinue()
Declare svInterrogate()
Declare svStop()
Declare svShutdown()
Declare svUserdata128()
Declare svUserdata129()
Declare svUserdata130()
Declare svUserdata131()
Declare WriteLog(Text.s)
Declare thMain(id)
; ----
Procedure.s FormatMessage(Errorcode)
Protected *Buffer, len, r1.s
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,Errorcode,0,@*Buffer,0,0)
If len
r1 = PeekS(*Buffer, len)
LocalFree_(*Buffer)
ProcedureReturn r1
Else
ProcedureReturn "Errorcode: " + Hex(Errorcode)
EndIf
EndProcedure
; ----
Procedure.s GetSpecialFolder(iCSIDL)
Protected sPath.s = Space(#MAX_PATH)
If SHGetSpecialFolderPath_(#Null, @sPath, iCSIDL, 0) = #True
If Right(sPath, 1) <> "\"
sPath + "\"
EndIf
ProcedureReturn sPath
Else
ProcedureReturn ""
EndIf
EndProcedure
; ----
Procedure.s CreateLogFolder(name.s)
Protected path.s
path = GetSpecialFolder(#CSIDL_COMMON_APPDATA)
path + name + "\"
CreateDirectory(path)
;MakeSureDirectoryPathExists_(path)
ProcedureReturn path
EndProcedure
; ----
Procedure MyWriteLog(Text.s)
Protected file
file = OpenFile(#PB_Any, AppFileLog)
If file
FileSeek(file, Lof(file))
WriteStringN(file, FormatDate("%YYYY-%MM-%DD %HH:%II:%SS : ", Date()) + Text)
CloseFile(file)
EndIf
EndProcedure
Macro WriteLog(text)
CompilerIf #EnableLogging
LockMutex(MutexLog) : MyWriteLog(text) : UnlockMutex(MutexLog)
CompilerEndIf
EndMacro
; ----
Procedure svMain()
Protected hSCManager.i
Protected hService.i
Protected ServiceTableEntry.SERVICE_TABLE_ENTRY
Protected lpServiceStatus.SERVICE_STATUS
Protected lpInfo
Protected r1.i
Protected cmd.s
;-! Begin Service Configuration
#SERVICE_DESIRED_ACCESS = #SERVICE_ALL_ACCESS
;-* Service Name
SERVICE_NAME = "MyService"
;-* Service Description
SERVICE_DESCRIPTION = "MyService Base Program"
;-* Service Startname
;--- LocalSystem account (Default)
SERVICE_STARTNAME = "" ; NULL
SERVICE_PASSWORD = "" ; Null
;--- LocalService account
; SERVICE_STARTNAME = "NT AUTHORITY\LocalService"
; SERVICE_PASSWORD = ""
;--- NetworkService account
; SERVICE_STARTNAME = "NT AUTHORITY\NetworkService"
; SERVICE_PASSWORD = ""
;--- DomainName\UserName or .\Username account
; SERVICE_STARTNAME = ".\username"
; SERVICE_PASSWORD = "password"
;-! End Service Configuration
AppPathName.s = Space(1023)
GetModuleFileName_(0, AppPathName, 1023)
cmd = Trim(LCase(ProgramParameter()))
Select cmd
Case "install", "/i" ;Install service on machine
Repeat
r1 = 0
hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
If hSCManager = #Null
r1 = GetLastError_()
Break
EndIf
If SERVICE_STARTNAME
hService = CreateService_(hSCManager, SERVICE_NAME, SERVICE_NAME, #SERVICE_DESIRED_ACCESS, #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, AppPathName, 0, 0, 0, SERVICE_STARTNAME, SERVICE_PASSWORD)
Else ; Local service
hService = CreateService_(hSCManager, SERVICE_NAME, SERVICE_NAME, #SERVICE_DESIRED_ACCESS, #SERVICE_INTERACTIVE_PROCESS | #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, AppPathName, 0, 0, 0, 0, 0)
EndIf
If hService = #Null
r1 = GetLastError_()
Break
EndIf
lpInfo = @SERVICE_DESCRIPTION
ChangeServiceConfig2_(hService, #SERVICE_CONFIG_DESCRIPTION, @lpInfo)
Until #True
If hService
CloseServiceHandle_(hService)
EndIf
If hSCManager
CloseServiceHandle_(hSCManager)
EndIf
If r1
MessageRequester("Error", "Service not installed! " + FormatMessage(r1), #MB_ICONSTOP)
EndIf
ExitService = 1
Case "uninstall", "/u" ;Remove service from machine
Repeat
r1 = 0
hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
If hSCManager = #Null
r1 = GetLastError_()
Break
EndIf
hService = OpenService_(hSCManager, SERVICE_NAME, #SERVICE_ALL_ACCESS)
If hService = #Null
r1 = GetLastError_()
Break
EndIf
If QueryServiceStatus_(hService, lpServiceStatus) = #Null
r1 = GetLastError_()
Break
EndIf
If lpServiceStatus\dwCurrentState <> #SERVICE_STOPPED
r1 = #ERROR_SERVICE_ALREADY_RUNNING
Break
EndIf
If DeleteService_(hService) = #Null
r1 = GetLastError_()
Break
EndIf
Until #True
If hService
CloseServiceHandle_(hService)
EndIf
If hSCManager
CloseServiceHandle_(hSCManager)
EndIf
If r1
MessageRequester("Error", "Service not uninstalled! " + FormatMessage(r1), #MB_ICONSTOP)
EndIf
ExitService = 1
Default
;Start the service
ServiceTableEntry\lpServiceName = @SERVICE_NAME
ServiceTableEntry\lpServiceProc = @svServiceMain()
r1 = StartServiceCtrlDispatcher_(@ServiceTableEntry)
If r1 = 0
ExitService = 1
EndIf
EndSelect
Repeat
Delay(100)
Until ExitService = 1
End
EndProcedure
; ----
Procedure svHandler(fdwControl.i)
Protected r1.i
Select fdwControl
Case #SERVICE_CONTROL_PAUSE
;** Do whatever it takes To pause here.
If svPause()
ServiceStatus\dwCurrentState = #SERVICE_PAUSED
EndIf
Case #SERVICE_CONTROL_CONTINUE
;** Do whatever it takes To continue here.
If svContinue()
ServiceStatus\dwCurrentState = #SERVICE_RUNNING
EndIf
Case #SERVICE_CONTROL_STOP
ServiceStatus\dwWin32ExitCode = 0
ServiceStatus\dwCurrentState = #SERVICE_STOP_PENDING
ServiceStatus\dwCheckPoint = 0
ServiceStatus\dwWaitHint = 0 ;Might want a time estimate
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Do whatever it takes to stop here.
If svStop()
ExitService = 1
ServiceStatus\dwCurrentState = #SERVICE_STOPPED
EndIf
Case #SERVICE_CONTROL_INTERROGATE
;Fall through To send current status.
svInterrogate()
Case #SERVICE_CONTROL_SHUTDOWN
ServiceStatus\dwWin32ExitCode = 0
ServiceStatus\dwCurrentState = #SERVICE_STOP_PENDING
ServiceStatus\dwCheckPoint = 0
ServiceStatus\dwWaitHint = 0 ;Might want a time estimate
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Do whatever it takes to stop here.
If svShutdown()
ExitService = 1
ServiceStatus\dwCurrentState = #SERVICE_STOPPED
EndIf
Case #SERVICE_USERDATA_128
svUserdata128()
Case #SERVICE_USERDATA_129
svUserdata129()
Case #SERVICE_USERDATA_130
svUserdata130()
Case #SERVICE_USERDATA_131
svUserdata131()
EndSelect
;Send current status.
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
EndProcedure
; ----
Procedure svServiceMain(dwArgc.i, lpszArgv.i)
Protected r1.i
;Set initial state
ServiceStatus\dwServiceType = #SERVICE_WIN32_OWN_PROCESS
ServiceStatus\dwCurrentState = #SERVICE_START_PENDING
ServiceStatus\dwControlsAccepted = #SERVICE_ACCEPT_STOP | #SERVICE_ACCEPT_PAUSE_CONTINUE | #SERVICE_ACCEPT_SHUTDOWN
ServiceStatus\dwWin32ExitCode = 0
ServiceStatus\dwServiceSpecificExitCode = 0
ServiceStatus\dwCheckPoint = 0
ServiceStatus\dwWaitHint = 0
hServiceStatus = RegisterServiceCtrlHandler_(SERVICE_NAME, @svHandler())
ServiceStatus\dwCurrentState = #SERVICE_START_PENDING
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Do Initialization Here
If svInit()
ServiceStatus\dwCurrentState = #SERVICE_RUNNING
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
Else
ServiceStatus\dwCurrentState = #SERVICE_STOP_PENDING
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
ServiceStatus\dwCurrentState = #SERVICE_STOPPED
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
ExitService = 1
EndIf
;** 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
EndProcedure
; ----
Procedure svInit()
Protected path.s
CompilerIf #EnableLogging
;-* Create folder and name for service logfiles
AppPathLog = CreateLogFolder(SERVICE_NAME)
AppFileLog = AppPathLog + "Service.log"
; Create mutex for logs
MutexLog = CreateMutex()
CompilerEndIf
WriteLog("Service Start")
;-* Start MainThread
MainThread\Command = #SERVICE_START
MainThread\ThreadID = CreateThread(@thMain(), 0)
If MainThread\ThreadID
ProcedureReturn 1
Else
WriteLog("Service Start - Error: Start MainThread")
MainThread\Command = 0
ProcedureReturn 0
EndIf
EndProcedure
; ----
Procedure svPause()
Protected ctime
WriteLog("Service Pause")
MainThread\Command = #SERVICE_CONTROL_PAUSE
If IsThread(MainThread\ThreadID)
If WaitThread(MainThread\ThreadID, 30000) = 0
WriteLog("Service Pause - Error Timeout : Kill MainThread")
KillThread(MainThread\ThreadID)
EndIf
EndIf
MainThread\Command = 0
MainThread\ThreadID = 0
ProcedureReturn 1
EndProcedure
; ----
Procedure svContinue()
WriteLog("Service Continue")
MainThread\Command = #SERVICE_CONTROL_CONTINUE
MainThread\ThreadID = CreateThread(@thMain(), 0)
If MainThread\ThreadID
ProcedureReturn 1
Else
WriteLog("Service Continue - Error: Start MainThread")
MainThread\Command = 0
ProcedureReturn 0
EndIf
EndProcedure
; ----
Procedure svStop()
Protected ctime
WriteLog("Service Stop")
MainThread\Command = #SERVICE_CONTROL_STOP
If IsThread(MainThread\ThreadID)
If WaitThread(MainThread\ThreadID, 30000) = 0
WriteLog("Service Stop - Error Timeout : Kill MainThread")
KillThread(MainThread\ThreadID)
EndIf
EndIf
MainThread\Command = 0
MainThread\ThreadID = 0
ProcedureReturn 1
EndProcedure
; ----
Procedure svInterrogate()
; WriteLog("Service Interrogate")
ProcedureReturn 1
EndProcedure
; ----
Procedure svShutdown()
Protected ctime
WriteLog("Service Shutdown")
MainThread\Command = #SERVICE_CONTROL_SHUTDOWN
If IsThread(MainThread\ThreadID)
If WaitThread(MainThread\ThreadID, 30000) = 0
WriteLog("Service Shutdown - Error Timeout : Kill MainThread")
KillThread(MainThread\ThreadID)
EndIf
EndIf
MainThread\Command = 0
MainThread\ThreadID = 0
ProcedureReturn 1
EndProcedure
; ----
Procedure svUserdata128()
EndProcedure
; ----
Procedure svUserdata129()
EndProcedure
; ----
Procedure svUserdata130()
EndProcedure
; ----
Procedure svUserdata131()
EndProcedure
; ----
;- Service Main
svMain()
End
; *****************************************************************************
;- Thread Main
Procedure thMain(Id)
; Global code for init
WriteLog("MainThread - Init")
Repeat
Select MainThread\Command
Case #SERVICE_START
MainThread\Command = 0
; Code for start
WriteLog("MainThread - Start")
Case #SERVICE_CONTROL_CONTINUE
MainThread\Command = 0
; Code for contine
WriteLog("MainThread - Continue")
Case #SERVICE_CONTROL_PAUSE
MainThread\Command = 0
; Code for pause before exit
WriteLog("MainThread - Pause")
Break
Case #SERVICE_CONTROL_STOP
MainThread\Command = 0
; Code for stop before exit
WriteLog("MainThread - Stop")
Break
Case #SERVICE_CONTROL_SHUTDOWN
MainThread\Command = 0
; Code for shutdown before exit
WriteLog("MainThread - Shutdown")
Break
Default
; Any cycle code
Delay(100)
EndSelect
ForEver
; Global code for exit
WriteLog("MainThread - Exit")
EndProcedure
; ----