Tweet
I used this serveral times.
Works greate
------------------
Works greate
Code:
'------------------------------------------------------------------------------ ' ' NT SERVICE Template for 32-bit PB/DLL ' Copyright (c) 2001 by ClarkSoft.Com Inc ' ' Let me know if you find any errors or have any suggestions ' [email protected] ' ' DISCLAIMER: ' This code may be distributed on the condition that no fee is charged for ' such distribution with the exception of reasonable shipping and media ' charged. In addition, the code in this program may be incorporated ' into your own programs and the resulting programs may be distributed ' without payment of royalties. The author of this code is not ' responsible for the success or failure of any resultant usage ' of the code giving within this file. You are free to modify any code ' found within this file, but the author is not responsible for any changes ' to the base code file. ' '------------------------------------------------------------------------------- $COMPILE EXE "EXENAME.EXE" $RESOURCE "RESOURCE.PBR" ' Embed the resources into the exe #DIM ALL ' Force ALL vars to have to be declared GLOBAL hWindow AS LONG ' You should set this in your WINMAINX to the handle ' of your main window. $INCLUDE "WIN32API.INC" ' My includes actually have the WinAPI includes in them. '$INCLUDE "MYINC.INC" ' This was the main Bas file for my executable ' --------------------- ' CONSTANT DECLARATIONS ' --------------------- %EVENTLOG_AUDIT_FAILURE = 16 %EVENTLOG_AUDIT_SUCCESS = 8 %EVENTLOG_ERROR_TYPE = 1 %EVENTLOG_INFORMATION_TYPE = 4 %EVENTLOG_SUCCESS = 0 %EVENTLOG_WARNING_TYPE = 2 ' This constant is used to set logging status. %EVENTLOG_LEVEL = %EVENTLOG_AUDIT_FAILURE + %EVENTLOG_AUDIT_SUCCESS + %EVENTLOG_ERROR_TYPE + _ %EVENTLOG_INFORMATION_TYPE + %EVENTLOG_SUCCESS + %EVENTLOG_WARNING_TYPE %SERVICE_WIN32_OWN_PROCESS = &H10& %SERVICE_WIN32_SHARE_PROCESS = &H20& %SERVICE_WIN32 = %SERVICE_WIN32_OWN_PROCESS + %SERVICE_WIN32_SHARE_PROCESS %SERVICE_DEMAND_START = &H3& %SERVICE_ERROR_NORMAL = &H1& %WAIT_OBJECT_0 = 0& ' ------------------------- ' FUNCTION/SUB DECLARATIONS ' ------------------------- DECLARE FUNCTION Install() AS LONG DECLARE FUNCTION InitService() AS LONG DECLARE FUNCTION Uninstall() AS LONG DECLARE FUNCTION WinErrorMessage(BYVAL ErrNumber AS LONG) AS STRING DECLARE FUNCTION SendStatus(BYVAL CurrentStatus AS DWORD, BYVAL ExitCode AS DWORD, ServiceSpecificExitCode AS LONG, BYVAL Checkpoint AS DWORD, BYVAL WaitHint AS DWORD) AS LONG DECLARE FUNCTION ServiceThread(ID AS LONG) AS LONG DECLARE SUB Handler(BYVAL ControlValue AS DWORD) DECLARE SUB LogNTEvent(Message AS STRING, LogCode AS LONG) DECLARE SUB ServiceMain(BYVAL dwArgs AS DWORD, BYVAL lpszArgv AS DWORD) DECLARE SUB Terminate(ErrCode AS DWORD) DECLARE SUB StopService() DECLARE SUB PauseService() DECLARE SUB ResumeService() ' ---------------- ' GLOBAL VARIABLES ' ---------------- GLOBAL gascServiceName AS ASCIIZ * 8 GLOBAL gascServiceDisplayName AS ASCIIZ * 256 GLOBAL gdwdhStatus AS DWORD GLOBAL gdwdServiceState AS DWORD GLOBAL gdwdServiceStatus AS DWORD GLOBAL glnghInstance AS LONG GLOBAL glnghPrvInst AS LONG GLOBAL glnghTerminateEvent AS LONG GLOBAL glnghServiceThread AS LONG GLOBAL glngThreadResult AS LONG GLOBAL glngRunningService AS LONG GLOBAL glngPauseService AS LONG GLOBAL glngCmdShow AS LONG GLOBAL ptrCmdLine AS ASCIIZ PTR ' FUNCTION: WinMain FUNCTION WINMAIN(BYVAL hCurInst AS LONG, BYVAL hPrvInst AS LONG, CmdLine AS ASCIIZ PTR, BYVAL CmdShow AS LONG) EXPORT AS LONG DIM Result AS LONG DIM CmdParm AS STRING DIM udtSTE AS SERVICE_TABLE_ENTRY ' Set the service name and display name here. gascServiceName = "SERVICE NAME HERE" gascServiceDisplayName = "DISPLAY NAME HERE" glngHInstance = hCurInst glnghPrvInst = hPrvInst glngCmdShow = CmdShow ptrCmdLine = CmdLine ' Get the Command Line parms CmdParm = UCASE$(EXTRACT$(@CmdLine, ANY " ,." + CHR$(9))) ' Get rid of any seperators CmdParm = REMOVE$(CmdParm, ANY "-\/") ' If the exe was executed with the Install parm then we just install and quit IF CmdParm = "INSTALL" THEN ' Install the service. Result = Install() IF ISFALSE Result THEN MSGBOX "An error occured while trying to install this service END IF ' If the exe was executed with the UnInstall parm then we just uninstall and quit ELSEIF CmdParm = "UNINSTALL" THEN ' Uninstall the service. Result = Uninstall() IF ISFALSE Result THEN MSGBOX "An error occured while trying to uninstall this service END IF ' No parms were given that we want so start up as service ' This should only happen when the service control manager starts us ELSE udtSTE.lpServiceName = VARPTR(gascServiceName) udtSTE.lpServiceProc = CODEPTR(ServiceMain) Result = StartServiceCtrlDispatcher(udtSTE) IF Result = 0 THEN ExitProcess GetLastError() END IF END IF FUNCTION = 0 END FUNCTION ' Install the service into windows FUNCTION Install() AS LONG DIM dwdRet AS DWORD DIM lngDQEnd AS LONG DIM lngDQStart AS LONG DIM lngHSCManager AS LONG DIM lngHService AS LONG DIM ascEXE AS ASCIIZ * %MAX_PATH ON ERROR GOTO Error_Install ' Assume a failure for now. FUNCTION = %FALSE lngHSCManager = OpenSCManager(BYVAL %NULL, BYVAL %NULL, %SC_MANAGER_CREATE_SERVICE) IF lngHSCManager <> %NULL THEN ' OK, we have a handle to the SCM. ' Get the full EXE file path. dwdRet = GetModuleFileName(glngHInstance, ascEXE, %MAX_PATH) IF dwdRet <> 0 THEN ' Install the service. lngHService = CreateService(lngHSCManager, gascServiceName, gascServiceDisplayName, _ %SERVICE_ALL_ACCESS, %SERVICE_WIN32_OWN_PROCESS, _ %SERVICE_AUTO_START, %SERVICE_ERROR_NORMAL, _ ascEXE, BYVAL %NULL, BYVAL %NULL, _ BYVAL %NULL, BYVAL %NULL, BYVAL %NULL) ' Close any service handles. IF lngHService <> %NULL THEN ' Success! FUNCTION = %TRUE CloseServiceHandle lngHService END IF CloseServiceHandle lngHSCManager END IF END IF FUNCTION = %TRUE EXIT FUNCTION Error_Install: FUNCTION = -1& * ERR ON ERROR RESUME NEXT ' Close any service handles. IF lngHService <> %NULL THEN CALL CloseServiceHandle(lngHService) END IF IF lngHSCManager <> %NULL THEN CALL CloseServiceHandle(lngHSCManager) END IF END FUNCTION ' Unistall the service FUNCTION Uninstall() AS LONG DIM lngHSCManager AS LONG DIM lngHService AS LONG ON ERROR GOTO Error_Uninstall ' Assume a failure for now. FUNCTION = %FALSE lngHSCManager = OpenSCManager(BYVAL %NULL, BYVAL %NULL, %SC_MANAGER_CREATE_SERVICE) IF lngHSCManager <> %NULL THEN ' OK, we have a handle to the SCM. ' Now open our service. lngHService = OpenService(lngHSCManager, gascServiceName, %SERVICE_ALL_ACCESS) IF lngHService <> %NULL THEN ' Delete the service. IF DeleteService(lngHService) <> %NULL THEN ' Success! FUNCTION = %TRUE END IF CloseServiceHandle lngHService END IF CloseServiceHandle lngHSCManager END IF EXIT FUNCTION Error_Uninstall: FUNCTION = -1& * ERR ON ERROR RESUME NEXT ' Close any service handles. IF lngHService <> %NULL THEN CloseServiceHandle lngHService END IF IF lngHSCManager <> %NULL THEN CloseServiceHandle lngHSCManager END IF END FUNCTION ' Start up the service FUNCTION InitService() AS LONG DIM lngRet AS LONG DIM ID AS LONG DIM udtSTE AS SERVICE_TABLE_ENTRY DIM lpThreadAttributes AS SECURITY_ATTRIBUTES ' Start the main thread for this service glnghServiceThread = CreateThread(lpThreadAttributes, 0, CODEPTR(ServiceThread), 0, 0, ID) ' Did the thread start OK IF glnghServiceThread = 0 THEN FUNCTION = %FALSE EXIT FUNCTION ELSE ' Set the global to running glngRunningService = %TRUE FUNCTION = %TRUE EXIT FUNCTION END IF END FUNCTION SUB PauseService() ' Set the global indicating that we are not paused glngPauseService = %TRUE ' Let er rip SuspendThread glnghServiceThread END SUB SUB ResumeService() ' Set the global indicating that we are not paused glngPauseService = %FALSE ' Let er rip ResumeThread glnghServiceThread END SUB SUB StopService() ' Set the global flag indicating that the service is not running glngRunningService = %FALSE ' Set the event so the service will stop SetEvent glnghTerminateEvent END SUB FUNCTION SendStatus(BYVAL CurrentStatus AS DWORD, BYVAL ExitCode AS DWORD, ServiceSpecificExitCode AS LONG, BYVAL Checkpoint AS DWORD, BYVAL WaitHint AS DWORD) AS LONG DIM udtSS AS SERVICE_STATUS ' Reset the global service status value. gdwdServiceStatus = CurrentStatus ' Setup the UDT. udtSS.dwServiceType = %SERVICE_WIN32_OWN_PROCESS udtSS.dwCurrentState = CurrentStatus ' If we are the process of starting, then don't accept control events IF CurrentStatus = %SERVICE_START_PENDING THEN udtSS.dwControlsAccepted = 0 ELSE ' Take what was given udtSS.dwControlsAccepted = %SERVICE_ACCEPT_STOP + %SERVICE_ACCEPT_PAUSE_CONTINUE + %SERVICE_ACCEPT_SHUTDOWN END IF ' If a specific ServiceSpecificExitCode is defined, setup the Win32 exit code properly IF ServiceSpecificExitCode = 0 THEN udtSS.dwWin32ExitCode = ExitCode ELSE udtSS.dwWin32ExitCode = %ERROR_SERVICE_SPECIFIC_ERROR END IF ' Specific Exit Code udtSS.dwServiceSpecificExitCode = ServiceSpecificExitCode udtSS.dwCheckPoint = Checkpoint udtSS.dwWaitHint = WaitHint IF SetServiceStatus(gdwdHStatus, udtSS) = 0 THEN ' Something went wrong so stop the service StopService FUNCTION = %FALSE ELSE FUNCTION = %TRUE END IF END FUNCTION SUB ServiceMain(BYVAL dwArgs AS DWORD, BYVAL lpszArgv AS DWORD) LOCAL Result AS LONG LOCAL lpEventAttributes AS SECURITY_ATTRIBUTES ' Register with the SCM gdwdHStatus = RegisterServiceCtrlHandler(gascServiceName, CODEPTR(Handler)) ' Did it work IF gdwdHStatus = 0 THEN ' No, so terminate Terminate GetLastError() EXIT SUB END IF ' Service has been registered and startup is pending IF ISFALSE SendStatus(%SERVICE_START_PENDING, %NO_ERROR, 0, 1, 5000) THEN Terminate GetLastError() EXIT SUB END IF ' Create the termination event glnghTerminateEvent = CreateEvent(lpEventAttributes, %TRUE, %FALSE, "") IF glnghTerminateEvent = 0 THEN Terminate GetLastError() EXIT SUB END IF ' Service startup is still pending IF ISFALSE SendStatus(%SERVICE_START_PENDING, %NO_ERROR, 0, 2, 1000) THEN Terminate GetLastError() EXIT SUB END IF ' Start the service Result = InitService() IF ISFALSE Result THEN ' Oops Terminate GetLastError() EXIT SUB END IF ' Service is now running IF ISFALSE SendStatus(%SERVICE_RUNNING, %NO_ERROR, 0, 0, 0) THEN Terminate GetLastError() EXIT SUB END IF ' Wait for the signal to end WaitForSingleObject glnghTerminateEvent, %INFINITE Terminate 0 EXIT SUB END SUB SUB Terminate(ErrCode AS DWORD) ' If the Terminate Event has already been created then destroy it IF glnghTerminateEvent <> 0 THEN CloseHandle glnghTerminateEvent END IF IF gdwdHStatus <> 0 THEN ' Send a message to the SCM and tell them that we are stopping SendStatus %SERVICE_STOPPED, ErrCode, 0&, 0&, 0& END IF ' If the thread has started, then kill it IF glnghServiceThread <> 0 THEN ' Not normally here in a service ' However, this program was written as an executable first and converted into a service ' There is a global hWindow that is set in the WINMAINX when we start ' We need to destroy the window so the WINMAINX will come back to us ' Is it a valid window IF IsWindow(hWindow) THEN ' Yes so destroy it DestroyWindow hWindow ' This will cause the Message Loop in your WINMAINX to exit and return END IF ' Close the thread CloseHandle glnghServiceThread END IF END SUB SUB Handler(BYVAL ControlValue AS DWORD) ' This procedure (by its' name) handles all service requests. LOCAL Result AS LONG ON ERROR RESUME NEXT ' There is no Start option because the ServiceMain takes care of starting the service SELECT CASE ControlValue CASE %SERVICE_CONTROL_STOP ' Set the global Status gdwdServiceState = %SERVICE_STOP_PENDING ' Tell the SCM that we are stopping SendStatus %SERVICE_STOP_PENDING, %NO_ERROR, 0&, 1, 5000 ' Stop the service StopService CASE %SERVICE_CONTROL_PAUSE ' Are we running and not paused IF (ISTRUE glngRunningService) AND (ISFALSE glngPauseService) THEN ' Tell the SCM that we are pausing SendStatus %SERVICE_PAUSE_PENDING, %NO_ERROR, 0, 1, 1000 ' Pause it PauseService ' Set the current state gdwdServiceState = %SERVICE_PAUSED END IF CASE %SERVICE_CONTROL_CONTINUE ' Are we running and paused IF (ISTRUE glngRunningService) AND (ISTRUE glngPauseService) THEN ' Tell the SCM that we are un pausing SendStatus %SERVICE_CONTINUE_PENDING, %NO_ERROR, 0, 1, 1000 ' Resume the service ResumeService ' Set the current state gdwdServiceState = %SERVICE_RUNNING END IF CASE %SERVICE_CONTROL_INTERROGATE ' Don't need to do anything ' We will send the current status below CASE %SERVICE_CONTROL_SHUTDOWN ' We don't do anything with a shutdown EXIT SUB END SELECT ' Tell the SCM the new status SendStatus gdwdServiceState, %NO_ERROR, 0, 0, 0 END SUB FUNCTION ServiceThread(ID AS LONG) EXPORT AS LONG LOCAL Result AS LONG LOCAL Msg AS tagMsg ' Run until we are killed 'Result = WINMAINX(BYVAL glngHInstance, BYVAL glnghPrvInst, BYVAL ptrCmdLine, BYVAL glngCmdShow) ' I had written a program and compiled it as an exe ' To make it a service, I just renamed the WINMAIN to WINMAINX and then ' call it like you see above END FUNCTION
------------------
Comment