Tweet
I have an issue with a COM component I wrote in PB and its driving me nuts.
I have a service template, it is very similiar the the services code I see floating around in the forums. In the service code I call a thread, nothing unusual there. If I create this com component within the ServiceMain function everything is okay.. Method gets called and everyone is happy. When I move it to a thread the line Let oThis = NEWCOM "CTHISCLASS" never returns. If I move it to the main thread it works without any problem. I then wrote another program thinking that threads may be the issue but it worked.
As far as I can tell PB COM does not work in any thread other than the main thread of a service.
Does anyone know of anything nuanced zen type rememdy?
TIA
Note: VB DLL works fine..the class is created and there are no problems...
I sent this into support
And the service
I have a service template, it is very similiar the the services code I see floating around in the forums. In the service code I call a thread, nothing unusual there. If I create this com component within the ServiceMain function everything is okay.. Method gets called and everyone is happy. When I move it to a thread the line Let oThis = NEWCOM "CTHISCLASS" never returns. If I move it to the main thread it works without any problem. I then wrote another program thinking that threads may be the issue but it worked.
As far as I can tell PB COM does not work in any thread other than the main thread of a service.
Does anyone know of anything nuanced zen type rememdy?
TIA
Note: VB DLL works fine..the class is created and there are no problems...
I sent this into support
Code:
#Compile Dll
#Dim All
#Com Name "ASERVER", 1.0
#Com TLib On
#Com Doc "a Server 1.0"
#Com Guid Guid$("{732FB782-0BEA-42AE-8955-7D2BB7A77F03}")
#Include "Win32API.inc"
#Resource "server.pbr"
Global ghInstance As Dword
Function LibMain (ByVal hInstance As Long, _
ByVal fwdReason As Long, _
ByVal lpvReserved As Long) As Long
Select Case fwdReason
Case %DLL_PROCESS_ATTACH
ghInstance = hInstance
Function = 1 'success!
Case %DLL_PROCESS_DETACH
Function = 1 'success!
Case %DLL_THREAD_ATTACH
Function = 1 'success!
Case %DLL_THREAD_DETACH
Function = 1 'success!
End Select
End Function
Class CSERVER Guid$("{265CE77A-D195-4239-9B7E-EA5303FF23CE}") As Com
Class Method Create()
MsgBox "CREATE new dll"
End Method
Class Method DESTROY()
MsgBox "DESTROY new dll"
End Method
Interface ISERVER Guid$("{113453E6-3342-4FFC-8676-A58FD0A834D8}")
Inherit IDispatch
Method Foo Alias "Foo" ()
End Method
End Interface
End Class
Code:
#Compile Exe "test.EXE"
#Register None
#Include "Win32Api.Inc"
#Include "bsp.inc"
'--------------------------------------------------------------------------------------------------
'Service Information
'--------------------------------------------------------------------------------------------------
Global STE As Service_Table_Entry
Global SS As Service_Status
Global ServName As Asciiz * 64
Global ServDispName As Asciiz * 256
'--------------------------------------------------------------------------------------------------
'String Constants
'--------------------------------------------------------------------------------------------------
$APP_EXE = "TEST.EXE"
$ZERO = ""
$PBCRLF = Chr$(13) & Chr$(10)
$SVC_NAME_COMPLETE = "TEST Server"
$SVC_NAME = "tEST"
$MSG_INSTALL = $SVC_NAME_COMPLETE & " was installed successfully."
$MSG_UNINSTALL = $SVC_NAME_COMPLETE & " was uninstalled successfully."
$MSG_HELP = "Usage:" & $PBCRLF & " -u : Uninstall the service." & $PBCRLF & " -i : Install the service." & $PBCRLF & " -? : Displays this help screen." & $PBCRLF & " : Starts the service."
$KEY_HELP = "-?"
$KEY_INSTALL = "-i"
$KEY_UNINSTALL = "-u"
Declare Function Uninstall() As Long
Declare Function Install() As Long
Declare Function HandleService (ByVal ConnectionId As Long) As Long
'--------------------------------------------------------------------------------------------------
'Event Information
'--------------------------------------------------------------------------------------------------
$EVE_START = "TEST_START"
$EVE_STOP = "TEST_STOP"
$EVE_PAUSE = "TEST_PAUSE"
$EVE_HANDLER = "TEST_HANDLER"
Global hHandlerEvent As Dword
Global hStopHandler As Dword
Global hStartHandler As Dword
Global hPauseHandler As Dword
Global hServiceStatus As Dword
Global gControl As Long
Global gShutDown As Long
Global hInstance As Long
Global g_lExit As Long
Function Start() As Long
'-----------------------------------------------------------------------
'Author : Thomas
'Purpose: Starts the service
'Date : September 30th 2005
'-----------------------------------------------------------------------
On Error GoTo Error_Start
Dim LRet As Long
'-----------------------------------------------------------------------
' Sets the name and the service entry point
'-----------------------------------------------------------------------
STE.lpServiceName = VarPtr(ServName)
STE.lpServiceProc = CodePtr(ServiceMain)
LRet = StartServiceCtrlDispatcher (STE)
Exit Function
Error_Start:
End Function
Sub StandardOut (ByVal psBuffer As String)
'-----------------------------------------------------------------------
'Author : Thomas
'Purpose: Sends Data to the standard output, must make sure
' that editbin this.exe /SUBSYSTEM:CONSOLE is called
' so that we can write to the Standard Output
'Date : September 30th 2005
'-----------------------------------------------------------------------
Local lOut As Asciiz * 256 '288 'Set to an acceptable number!
Local lBytes As Long
lOut = psBuffer
WriteConsole GetStdHandle(%STD_OUTPUT_HANDLE), lOut, Len(lOut), lBytes, ByVal %Null
End Sub
'==================================================================================================
' WinMain - Main system function
'--------------------------------------------------------------------------------------------------
Function WinMain Alias "WhyAreYouLookingHere" (ByVal hCurInst As Long, ByVal hPrvInst As Long, ByVal CmdLine As Asciiz Ptr, ByVal CmdShow As Long) Export As Long
'-----------------------------------------------------------------------
'Author : Thomas
'Purpose: Entry Point
'Date : September 30th 2005
'-----------------------------------------------------------------------
On Error GoTo WinMain_Error
Dim LRet As Long
Dim LCommand As String
'-----------------------------------------------------------------------
'get the service information
'-----------------------------------------------------------------------
LRet = GetCurrentProcess
LRet = SetPriorityClass (LRet,%Idle_Priority_Class)
ServName = $SVC_NAME 'Service name.
ServDispName = $SVC_NAME_COMPLETE 'Displayed servicename.
hInstance = hCurInst
LCommand = LCase$(Command$)
'-----------------------------------------------------------------------
' Process the command line
'-----------------------------------------------------------------------
If InStr(LCommand,$KEY_UNINSTALL) Then
LRet = Uninstall 'Uninstall the service.
If LRet = %True Then
StandardOut $MSG_UNINSTALL
End If
ElseIf InStr(LCommand,$KEY_INSTALL) Then
LRet = Install 'Install the service.
If LRet = %True Then
StandardOut $MSG_INSTALL
End If
ElseIf InStr(LCommand,$KEY_HELP) Then
StandardOut $MSG_HELP
Else
Start
End If
'-----------------------------------------------------------------------
' Exit Setting the exist process
'-----------------------------------------------------------------------
ExitProcess 0 'Exit with returncode.
Exit Function
WinMain_Error:
ExitProcess Err 'Error occurred, exit.
End Function
Function Uninstall() As Long
'-----------------------------------------------------------------------
'Author : Thomas
'Purpose: Uninstalls this EXE, removing this and all reference from
' from the service database
'Date : September 30th 2005
'-----------------------------------------------------------------------
On Error GoTo Error_Uninstall
Dim hSCManager As Long
Dim hService As Long
'-----------------------------------------------------------------------
' Open the Service Control and get a handle to it
'-----------------------------------------------------------------------
hSCManager = OpenSCManager(ByVal %NULL, ByVal %NULL, %SC_MANAGER_CREATE_SERVICE)
'-----------------------------------------------------------------------
' if we have a handle, open and get a handle to the service itself, once
' we have that handle then we can call delete service. to verify, close
' down the services mmc, and re-open
'-----------------------------------------------------------------------
If hSCManager Then
hService = OpenService(hSCManager, ServName, %SERVICE_ALL_ACCESS)
If DeleteService (hService) Then
Function = %True
CloseServiceHandle hService
CloseServiceHandle hSCManager
End If
End If
Exit Function
Error_Uninstall:
Function = -1& * Err
On Error Resume Next
If hService Then
CloseServiceHandle hService 'If any handles open,
End If
If hSCManager Then
CloseServiceHandle hSCManager 'close them now
End If
End Function
Function Install() As Long
'-----------------------------------------------------------------------
'Author : Thomas
'Purpose: Installs this EXE as a service in the service database
'Date : September 30th 2005
'-----------------------------------------------------------------------
On Error GoTo Error_Install
Dim LRet As Long
Dim hSCManager As Long
Dim hService As Long
Dim SvcExe As Asciiz * %MAX_PATH
'-----------------------------------------------------------------------
' Open the Service Control Manager, get the executable path to this
' Executable and Create the Service.
'-----------------------------------------------------------------------
hSCManager = OpenSCManager(ByVal 0, ByVal 0, %SC_MANAGER_CREATE_SERVICE) 'Open the SC Manager
If hSCManager Then 'Got a handle to SCM.
LRet = GetModuleFileName(hInstance, SvcExe, %MAX_PATH) 'Get full EXE filepath.
If LRet Then 'Install the service.
hService = CreateService(hSCManager, ServName, ServDispName, _
%SERVICE_ALL_ACCESS Or %SERVICE_USER_DEFINED_CONTROL, %SERVICE_WIN32_OWN_PROCESS, _
%SERVICE_AUTO_START, %SERVICE_ERROR_NORMAL, _
SvcExe, ByVal %NULL, ByVal %NULL, _
ByVal %NULL, ByVal %NULL, ByVal %NULL)
If hService Then
Function = %TRUE
CloseServiceHandle hService
End If
CloseServiceHandle hSCManager
End If
End If
Exit Function
Error_Install:
Function = Err
On Error Resume Next
If hService Then
CloseServiceHandle hService 'Close all open service
End If
If hSCManager Then
CloseServiceHandle hSCManager 'handles before exiting
End If
End Function
Sub SvcHandler(ByVal pControl As Dword)
'-----------------------------------------------------------------------
'Author : Thomas
'Purpose: This is the handler entry point, called by the scm to
' Trigger an event
'Date : September 30th 2005
'-----------------------------------------------------------------------
On Error GoTo Handler_Error
gControl = pControl
SetEvent hHandlerEvent
Exit Sub
Handler_Error:
End Sub
Sub ServiceMain(ByVal dwArgs As Dword, ByVal lpszArgv As Dword)
'-----------------------------------------------------------------------
'Author : Thomas
'Purpose: This is the service entry point much like dll main. When
' the SCM gets a request to start it will call this method
' and we will then set all our startup params and call the
' main service thread
'Date : September 30th 2005
'-----------------------------------------------------------------------
On Error Resume Next
Local lRet As Long
Local llong As Long
Local nHwnd As Long
Local lServiceCount As Long
Local szMachine As Asciiz * 256
Local lChannels As Long
Local sChannel As String
Local iCount As Long
SS.dwServiceType = %SERVICE_WIN32_OWN_PROCESS
SS.dwCurrentState = %SERVICE_START_PENDING
SS.dwControlsAccepted = %SERVICE_ACCEPT_STOP Or %SERVICE_ACCEPT_PAUSE_CONTINUE Or %SERVICE_ACCEPT_SHUTDOWN
SS.dwWin32ExitCode = 0
SS.dwServiceSpecificExitCode = 0
SS.dwCheckPoint = 0
SS.dwWaitHint = 0
hServiceStatus = RegisterServiceCtrlHandler (ServName, CodePtr(SvcHandler))
SS.dwCurrentState = %SERVICE_START_PENDING
SetServiceStatus hServiceStatus, SS
'-----------------------------------------------------------------------
' All of our events will start here, these events will be watched for in
' the services code so that we can bust out when needed to shutdown
'-----------------------------------------------------------------------
hHandlerEvent = CreateEvent (ByVal %Null, ByVal 0, ByVal 0, $EVE_HANDLER)
hStartHandler = CreateEvent (ByVal %Null, ByVal 0, ByVal 0, $EVE_START)
hStopHandler = CreateEvent (ByVal %Null, ByVal 0, ByVal 0, $EVE_STOP)
hPauseHandler = CreateEvent (ByVal %Null, ByVal 0, ByVal 0, $EVE_PAUSE)
'-----------------------------------------------------------------------
' Notify the SCM that we are ready and running
'-----------------------------------------------------------------------
SS.dwCurrentState = %SERVICE_RUNNING
SetServiceStatus hServiceStatus, SS
'-----------------------------------------------------------------------
' This is where the channels from the channels.dat will be opened.
' if the channel does not exist then we will create the channel and
' allow the user to carry on.
'-----------------------------------------------------------------------
'-----------------------------------------------------------------------
' Start any threads here
'-----------------------------------------------------------------------
Thread Create ServiceThread(hDummy&) To hDummy&
Thread Close hDummy& To hDummy&
'ServiceThread hDummy&
'-----------------------------------------------------------------------
' And Wait for the SCM to issue a command to us
'-----------------------------------------------------------------------
While IsFalse gShutDown
Sleep 0
lRet = WaitForSingleObject(ByVal hHandlerEvent, %INFINITE)
Select Case lRet
Case %WAIT_FAILED
'We couldnt wait for the event for somereason
'so lets just shutdown, the SCM is hosed
gShutDown = %True
Case %WAIT_OBJECT_0
'something happend that triggered an event
'in the SCM
Select Case gControl
Case %SERVICE_CONTROL_STOP, %SERVICE_CONTROL_SHUTDOWN
SetEvent hStopHandler
gShutDown = %True
Case %SERVICE_CONTROL_PAUSE
SetEvent hPauseHandler
SS.dwCurrentState = %SERVICE_PAUSED
SetServiceStatus hServiceStatus, SS
Case %SERVICE_CONTROL_CONTINUE
SetEvent hStartHandler
SS.dwCurrentState = %SERVICE_RUNNING
SetServiceStatus hServiceStatus, SS
Case %SERVICE_CONTROL_INTERROGATE
SetServiceStatus hServiceStatus, SS
Case Else
End Select
Case %WAIT_TIMEOUT
'We should never get here since
'the wait time is infinite
gShutdown = %TRUE
Case Else
'total error occurced here
gShutdown = %TRUE
End Select
Wend
'When we stop lets let the system know that we
'are still trying to stop, so it doesnt attempt
'to shut it down while we are still writing a file
SS.dwCurrentState = %SERVICE_STOP_PENDING
SetServiceStatus hServiceStatus, SS
CloseHandle hHandlerEvent
CloseHandle hStartHandler
CloseHandle hStopHandler
CloseHandle hPauseHandler
'-----------------------------------------------------------------------
' Critical Sections, this is where all the critical sections are deleted
' for the different areas
'-----------------------------------------------------------------------
'-----------------------------------------------------------------------
'now we can safely say that we are shutdown
'notify the SCM that it is safe to clean out
'all pointers
'-----------------------------------------------------------------------
SS.dwCurrentState = %SERVICE_STOPPED
SetServiceStatus hServiceStatus, SS
Exit Sub
Error_ServiceMain:
'there was en error.. what is the best thing to do here?
End Sub
Function ServiceThread (ByVal ServiceID As Long) As Long
'-----------------------------------------------------------------------
'Author : Thomas
'Date : September 30th 2005
'-----------------------------------------------------------------------
Local oServer As IDispatch
MsgBox Str$(ObjResult)
Let oServer = NewCom "CSERVER"
MsgBox Str$(ObjResult)
If IsObject(oServer) = %FALSE Then
MsgBox "Not an object"
End If
MsgBox "done"
End Function
Comment