diff options
Diffstat (limited to 'projects/mongrel_service/lib/ServiceFB/ServiceFB_Utils.bas')
| -rw-r--r-- | projects/mongrel_service/lib/ServiceFB/ServiceFB_Utils.bas | 493 |
1 files changed, 0 insertions, 493 deletions
diff --git a/projects/mongrel_service/lib/ServiceFB/ServiceFB_Utils.bas b/projects/mongrel_service/lib/ServiceFB/ServiceFB_Utils.bas deleted file mode 100644 index c8a77a3..0000000 --- a/projects/mongrel_service/lib/ServiceFB/ServiceFB_Utils.bas +++ /dev/null @@ -1,493 +0,0 @@ -'#--
-'# Copyright (c) 2006-2007 Luis Lavena, Multimedia systems
-'#
-'# This source code is released under the MIT License.
-'# See MIT-LICENSE file for details
-'#++
-
-#include once "ServiceFB.bi"
-#include once "_internals.bi"
-#include once "ServiceFB_Utils.bi"
-#include once "_utils_internals.bi"
-
-namespace fb
-namespace svc
-namespace utils '# fb.svc.utils
- '# private (internals) for ServiceProcess.Console()
- dim shared _svc_stop_signal as any ptr
- dim shared _svc_stop_mutex as any ptr
- dim shared _svc_stopped as BOOL
- dim shared _svc_in_console as ServiceProcess ptr
- dim shared _svc_in_console_stop_flag as BOOL
-
- '#####################
- '# ServiceController
- '# ctor()
- constructor ServiceController()
- with this
- .product = "My Product"
- .version = "v0.1"
- .copyright = "my copyright goes here."
- end with
- end constructor
-
-
- '# ctor(product)
- constructor ServiceController(byref new_product as string)
- this.product = new_product
- end constructor
-
-
- '# ctor(product, version)
- constructor ServiceController(byref new_product as string, byref new_version as string)
- constructor(new_product)
- this.version = new_version
- end constructor
-
-
- '# ctor(product, version, copyright)
- constructor ServiceController(byref new_product as string, byref new_version as string, byref new_copyright as string)
- constructor(new_product, new_version)
- this.copyright = new_copyright
- end constructor
-
-
- '# dtor()
- destructor ServiceController()
- end destructor
-
-
- '# Banner() will display in the console, information regarding your program
- '# using this formatting:
- '# 'Product', 'Version'
- '# 'Copyright'
- sub ServiceController.Banner()
- '# display Product and Version
- print this.product; ", "; this.version
- print this.copyright
- print ""
- '# leave a empty line between banner (header) and other info
- end sub
-
-
- '# RunMode() provide a simple way to get (*you*) from where this process was started
- '# and do the corresponding action.
- function ServiceController.RunMode() as ServiceRunMode
- dim result as ServiceRunMode
- dim currPID as DWORD
- dim parent_pid as uinteger
- dim parent_name as string
- dim start_mode as string
-
- _dprint("ServiceController.RunMode()")
-
- '# get this process PID
- currPID = GetCurrentProcessId()
- _dprint("CurrentPID: " + str(currPID))
-
- '# get the parent PID
- parent_pid = _parent_pid(currPID)
- _dprint("ParentPID: " + str(parent_pid))
-
- '# now the the name
- parent_name = _process_name(parent_pid)
- if (parent_name = "<unknown>") then
- parent_name = _process_name_dyn_psapi(parent_pid)
- end if
- _dprint("Parent Name: " + parent_name)
-
- '# this process started as service?
- '# that means his parent is services.exe
- if (parent_name = "services.exe") then
- result = RunAsService
- else
- '# ok, it didn't start as service, analyze command line then
- start_mode = lcase(trim(command(1)))
- if (start_mode = "manage") then
- '# start ServiceController.Manage()
- result = RunAsManager
- elseif (start_mode = "console") then
- '# start ServiceController.Console()
- result = RunAsConsole
- else
- '# ok, the first paramenter in the commandline didn't work,
- '# report back so we could send the banner!
- result = RunAsUnknown
- end if
- end if
-
- _dprint("ServiceController.RunMode() done")
- return result
- end function
-
-
- '# Manage will offer the user (end-user) option in the commandline to
- '# install, remove, start, stop and query the status of the installed service
- '# use Manage() when you code a multi-services (ServiceHost) based programs
- '# for single services, use Manage(service)
- sub ServiceController.Manage()
- end sub
-
-
- '# this is used when you want management capabilities for your service
- '# use this for single services, or call Manage() for multi services
- sub ServiceController.Manage(byref service as ServiceProcess)
- end sub
-
-
- '# this offer the user a way to test/debug your service or run it like a normal
- '# program, from the command line
- '# will let you SHUTDOWN the service using CTRL+C
- '# use this for multi-services (ServiceHost) based programs
- sub ServiceController.Console()
- dim working_thread as any ptr
- dim run_mode as string
- dim service_name as string
- dim service as ServiceProcess ptr
- dim commandline as string
- dim success as integer
-
- _dprint("ServiceController.Console()")
-
- '# show the controller banner
- this.Banner()
-
- '# determine how many service exist in references
- if (_svc_references_count > 0) then
- _build_commandline(run_mode, service_name, commandline)
- service = _find_in_references(service_name)
-
- if (service = 0) then
- '# no valid service reference, list available services
- _list_references()
- else
- '# build the command line, excluding 'console' and service_name
- service->commandline = commandline
-
- '# got a service reference
- '# also, set the global handler that will be used by _control_handler
- _svc_in_console = service
-
- '# create the signal used to stop the service thread.
- _svc_stop_signal = condcreate()
- _svc_stop_mutex = mutexcreate()
-
- '# register the Console Handler
- SetConsoleCtrlHandler(@_console_handler, TRUE)
-
- print "Starting service '"; service_name; "' in console mode, please wait..."
-
- '# onInit should be started inline,
- '# and its result validated!
- if not (service->onInit = 0) then
- success = service->onInit(*service)
- end if
-
- '# only continue if success
- if not (success = 0) then
- '# now set service.state to running
- service->state = Running
-
- '# now, fire the main loop (onStart)
- if not (service->onStart = 0) then
- '# create the thread
- working_thread = threadcreate(@ServiceProcess.call_onStart, service)
- if (working_thread = 0) then
- print "Failed to create working thread."
- end if
- end if
-
- print "Service is in running state."
- print "Press Ctrl-C to stop it."
-
- '# now that onStart is running, must monitor the stop_signal
- '# in case it arrives, the service state must change to exit the
- '# working thread.
- mutexlock(_svc_stop_mutex)
- do while (_svc_stopped = FALSE)
- condwait(_svc_stop_signal, _svc_stop_mutex)
- loop
- mutexunlock(_svc_stop_mutex)
-
- print "Stop signal received, stopping..."
-
- '# received the signal, so set state = Stopped
- service->state = Stopped
-
- print "Waiting for onStart() to exit..."
-
- '# now wait for the thread to terminate
- if not (working_thread = 0) then
- threadwait(working_thread)
- end if
-
- else
- print "Error starting the service, onInit() failed."
- end if
-
- print "Service stopped, doing cleanup."
-
- '# remove the console handler
- SetConsoleCtrlHandler(@_console_handler, FALSE)
-
- '# now that service was stopped, destroy the references.
- conddestroy(_svc_stop_signal)
- mutexdestroy(_svc_stop_mutex)
- print "Done."
- end if
- else
- print "ERROR: No services could be served by this program. Exiting."
- end if
-
- _dprint("ServiceController.Console() done")
- end sub
-
-
- '# this offer the user a way to test/debug your service or run it like a normal
- '# program, from the command line
- '# will let you SHUTDOWN the service using CTRL+C
- '# use this for single-services
- sub ServiceController.Console(byref service as ServiceProcess)
-
- _dprint("ServiceController.RunMode(service)")
-
- '# register the service in the references table
- _add_to_references(service)
-
- _dprint("delegate to Console()")
- '# now delegate control to Console()
- this.Console()
-
- _dprint("ServiceController.Console(service) done")
- end sub
-
-
- '# console_handler is used to get feedback form keyboard and allow
- '# shutdown of service using Ctrl+C / Ctrl+Break from keyboard
- function _console_handler(byval dwCtrlType as DWORD) as BOOL
- dim result as BOOL
- dim service as ServiceProcess ptr
-
- _dprint("_console_handler()")
-
- '# get the reference from svc_in_console
- service = _svc_in_console
-
- '# we default processing of the message to false
- result = FALSE
-
- '# avoid recursion problems
- if (_svc_in_console_stop_flag = FALSE) then
- _dprint("no previous signaled, process event")
- '# all the CtrlType events listed will raise the onStop
- '# of the service
- '# here also will be raised the _svc_stop_signal
- select case dwCtrlType
- case CTRL_C_EVENT, CTRL_CLOSE_EVENT, CTRL_BREAK_EVENT, CTRL_LOGOFF_EVENT, CTRL_SHUTDOWN_EVENT:
- _dprint("got supported CTRL_*_EVENT")
- '# avoid recursion problems
- _svc_in_console_stop_flag = TRUE
- _dprint("set signaled to TRUE")
-
- '# the service defined onStop?
- if not (service->onStop = 0) then
- _dprint("pass control to onStop()")
- service->onStop(*service)
- end if
-
- '# now fire the signal
- _dprint("fire stop signal")
- mutexlock(_svc_stop_mutex)
- condsignal(_svc_stop_signal)
- result = TRUE
- _svc_in_console_stop_flag = FALSE
- _svc_stopped = TRUE
- mutexunlock(_svc_stop_mutex)
-
- case else:
- _dprint("unsupported CTRL EVENT")
- result = FALSE
- end select
- else
- _dprint("already running onStop(), do not pass the message to other message handlers!")
- result = TRUE
- end if
-
- _dprint("_console_handler() done")
- return result
- end function
-
-
- '# helper private subs used to list the services and their descriptions
- '# in _svc_references
- private sub _list_references()
- dim item as ServiceProcess ptr
- dim idx as integer
-
- print "Available services in this program:"
-
- for idx = 0 to (_svc_references_count - 1)
- item = _svc_references[idx]
-
- print space(2);
- print trim(item->name), , trim(item->description)
- next idx
-
- end sub
-
-
- '# TODO: SimpleLogger
- '# TODO: EventLogger
-
-
- '#####################
- '# private (internals)
- '# _parent_pid is used to retrieve, based on the PID you passed by, the one of the parent
- '# that launched that process.
- '# on fail, it will return 0
- '# Thanks to MichaelW (FreeBASIC forums) for his help about this.
- private function _parent_pid(byval PID as uinteger) as uinteger
- dim as uinteger result
- dim as HANDLE hProcessSnap
- dim as PROCESSENTRY32 pe32
-
- '# initialize result, 0 = fail, other number, ParentPID
- result = 0
-
- hProcessSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
- if not (hProcessSnap = INVALID_HANDLE_VALUE) then
- pe32.dwSize = sizeof(PROCESSENTRY32)
- if (Process32First(hProcessSnap, @pe32) = TRUE) then
- do
- if (pe32.th32ProcessID = PID) then
- result = pe32.th32ParentProcessID
- exit do
- end if
- loop while not (Process32Next(hProcessSnap, @pe32) = 0)
- end if
- end if
-
- CloseHandle(hProcessSnap)
- return result
- end function
-
-
- '# _process_name is used to retrieve the name (ImageName, BaseModule, whatever) of the PID you
- '# pass to it. if no module name was found, it should return <unknown>
- private function _process_name(byval PID as uinteger) as string
- dim result as string
- dim hProcess as HANDLE
- dim hMod as HMODULE
- dim cbNeeded as DWORD
-
- '# assign "<unknown>" to process name, allocate MAX_PATH (260 bytes)
- result = "<unknown>"
- result += space(MAX_PATH - len(result))
-
- '# get a handle to the Process
- hProcess = OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PID)
-
- '# if valid, get the process name
- if not (hProcess = NULL) then
- '# success getting Process modules
- if not (EnumProcessModules(hProcess, @hMod, sizeof(hMod), @cbNeeded) = 0) then
- result = space(cbNeeded)
- GetModuleBaseName(hProcess, hMod, strptr(result), len(result))
- end if
- end if
-
- CloseHandle(hProcess)
-
- '# return a trimmed result
- result = trim(result)
- return result
- end function
-
- '# _process_name_dyn_psapi is a workaround for some issues with x64 versions of Windows.
- '# by default, 32bits process can't query information from 64bits modules.
- private function _process_name_dyn_psapi(byval PID as uinteger) as string
- dim result as string
- dim chop as uinteger
- dim zresult as zstring * MAX_PATH
- dim hLib as any ptr
- dim hProcess as HANDLE
- dim cbNeeded as DWORD
- dim GetProcessImageFileName as function (byval as HANDLE, byval as LPTSTR, byval as DWORD) as DWORD
-
- '# assign "<unknown>" to process name, allocate MAX_PATH (260 bytes)
- zresult = "<unknown>" + chr(0)
-
- '# get dynlib
- hLib = dylibload("psapi.dll")
- if not (hlib = 0) then
- GetProcessImageFileName = dylibsymbol(hlib, "GetProcessImageFileNameA")
- if not (GetProcessImageFileName = 0) then
- '# get a handle to the Process
- hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, PID)
-
- '# if valid, get the process name
- if not (hProcess = NULL) then
- cbNeeded = sizeof(zresult)
- if (GetProcessImageFileName(hProcess, @zresult, cbNeeded) = 0) then
- _dprint("Error with GetProcessImageFileName")
- _dprint("GetLastError: " + str(GetLastError()) + _show_error())
- else
- result = zresult
- chop = InStrRev(0, result, "\")
- if (chop > 0) then
- result = mid(result, chop + 1, (len(result) - chop))
- end if
- end if
- else
- _dprint("Error with OpenProcess")
- _dprint("GetLastError: " + str(GetLastError()) + _show_error())
- end if
-
- CloseHandle(hProcess)
- else
- _dprint("Unable to get a reference to dynamic symbol GetProcessImageFileNameA.")
- end if
- else
- _dprint("Unable to dynamic load psapi.dll")
- end if
-
- '# return a trimmed result
- 'result = trim(result)
- return result
- end function
-
- private function _show_error() as string
- dim buffer as string * 1024
- dim p as integer
-
- FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM,_
- 0,_
- GetLastError(),_
- 0,_
- strptr(buffer),_
- 1024,_
- 0 )
- buffer = rtrim(buffer)
- p = instr(buffer, chr(13))
- if p then buffer = left(buffer, p - 1)
-
- return buffer
- end function
-
- private function InStrRev(byval start as uinteger = 0, byref src as string, byref search as string) as uinteger
- dim lensearch as uinteger = len(search)
- dim as uinteger b, a = 0, exit_loop = 0
-
- do
- b = a
- a += 1
- a = instr(a, src, search)
- if start >= lensearch then if a + lensearch > start then exit_loop = 1
- loop while (a > 0) and (exit_loop = 0)
-
- return b
- end function
-
-end namespace '# fb.svc.utils
-end namespace '# fb.svc
-end namespace '# fb
|