Problem with COM and a service

[Thomas Tierney]

pb has nothing to do with this

Michael,

PB has everything and nothing to do with this. VB and C++ take care of the threading model for you. Once you select the threading model, regardless of whether you program for it or not, the registry "IS" updated with the proper model when registering the component.

if a PB compiled dll can be used in any threading model the documentation should clearly state that we as programmers should update the registry with the proper model at least. It would be even better if we could do something like

Interface myInterface Guid() as both
or
Interface myInterface ThreadingModel Apartment Guid()
or
Interface myInterface Guid()
Inherit IDISPATCH
ThreadingMode Both

fact is, the PB Com implementation is limited because most of what can be done in c++ doesnt exist and PB makes assumptions on how we use it without explaining what the manual options are.

[Michael Mayerhoffer]

I do have a solution to this. By adding the ThreadingModel = Apartment or ThreadingModel = Both to the CLSID registry entry under InProcServer32 I am now able to get this to execute.

I am so glad pb thought this through

PB has nothing to do with this issue. NO reason to dis them for this issue. Would not matter what compiler you use, you would still have to modify the registry.

The quick and esay you can not thread an in-process objects , without modifing the registry.

FROM MS http://msdn.microsoft.com/en-us/libr...05(vs.85).aspx


An in-process server does not call CoInitialize, CoInitializeEx, or OleInitialize to mark its threading model. For thread-aware DLL-based or in-process objects, you need to set the threading model in the registry. The default model when you do not specify a threading model is single-thread-per-process. To specify a model, you add the ThreadingModel named-value to the InprocServer32 key in the registry




.

[Thomas Tierney]

I do have a solution to this. By adding the ThreadingModel = Apartment or ThreadingModel = Both to the CLSID registry entry under InProcServer32 I am now able to get this to execute.

I am so glad pb thought this through

[Thomas Tierney]

Michael,

each thread should contain its own newly created object, I cannot even get that far. Since I am not communicating with a single object across multiple threads the Apartment Model should be fine.


And yes, I am using a pbexe as the calling application.

BTW global com doesnt = global PB
Two different animals

[Michael Mattias]

>CoInitializeEX is called for every thread including the main thread
If your calling EXE is PB-created, then the primary thread has been "CoInitializedEx'd" and you don't have to do anything.

>This should eliminate conflicts in global data

That is not automatic. Assuming your function is servicing multiple threads, only stack-based variables (params and LOCALs) and THREADED variables may be assumed to not conflict. GLOBAL in PB means "global" and STATIC may as well mean "global" for inter-thread data integrity purposes.

MCM

[Thomas Tierney]

Note - BTW Thanks for the responses

Michael Mayerhoffer
The item of discussion you have presented is in regards to threading and notification to the SCM that the Service is indeed in a state that it is safe to stop. This is different in that the service is running and state is being properly disseminated. On shut down this could be a problem but I am not shutting down, therefore is more than likely irrelevent to the discussion.

Michael Mattias
As I understand it, CoInitializeEX is called for every thread including the main thread with the COINIT_APARTMENTTHREADED model. The Apartment threading model is used to provide thread safety. I treats each thread as an apartment and all objects on the thread live in this apartment and are unaware of each others existence. This should eliminate conflicts in global data. I am okay with this model. And as far as I know I only need to call the CoUnInit, CoInit, CoUninit if I plan on changing the model which I do not intend to do.

Unless, of course, PB has changed the meaning of the Apartment threading model.

[Michael Mattias]

>CoInitialize and CoUnitialize has nothing to do with it..

I would not be so sure. I recently had an exchange with PB support re this.. and it turns out that while CoInitializeEx is automatically called on the primary thread of PB-created EXEs as well as on any thread created by THREAD CREATE, it is NOT called for DLL functions.

I had the same problem.... function would not return from NEWCOM (this function is in a DLL called by a third-party program).

I have not had a chance to try what I'm going to try, which is running the whole function in a separate thread of execution which I launch with THREAD CREATE... that way I will know that all the COM calls made by PB are using a PB-initialized TOE so everything should be just what PB wants.

MCM

[Michael Mayerhoffer]

After looking back through Platform SDKs and MSDN Libraries 93-99. In a nut shell only one thread maybe created inside ServiceMain.

MS has a work around code sample -How to spawn 3 threads out of ServiceMain and keep everyone happy.
http://support.microsoft.com/kb/189996 - this is also in the XP SP2 Platform SDK as part of the NT Service explanation.


Q175948 states using VB in services results in unsafe and undesired side effects. MS poo poo's the ideal of using VB to write services. I think you are sliding under the radar using a VB DLL or better put.. it is working by miss behavior not by design.

[Edwin Knoppert]

I have an oddity when i send a message to listbox when i just created the com interface.
I really don't know what is going on but it appears frozen.
To stress, i really have no clue if it's com related or just a matter in my app.
This happens only when the external app sends me a WM_COPYDATA and has to wait until this com stuff is done.
When i execute the app by itself and the same functionality it goes well.

I believe it does not eat cpu time, just frozen.
I have to confirm that.

[Thomas Tierney]

CoInitialize and CoUnitialize has nothing to do with it..

1. I am okay with apartment threading..
2. VB (which is apartment threaded) works fine
3. It works okay when in a thread and not in a service..
4. CoInitialize and CoInitializeEx using CoUnitialize first DID NOT change the outcome.

the problem is that the code never returns from a call to NEWCOM..

[Michael Mayerhoffer]

Its been a while and rusty..

I think CoInitializeEx() CoInitialize() marshalling might be the area of interest

PB uses CoInitialize so you would have to use CoUninitialize().

Then use CoInitializeEx instead and you have to clean up too

with CoUninitialize .... it has been to long ago I might just be barking up the wrong tree.

Good Luck

[Thomas Tierney]

Thats probably true Steven, however, a vb dll worked in the thread. Also, when this wasnt a services and threaded it still worked. It does not work only when it is a service and in a thread.

[Steven Pringels 3]

I have no answer for this but wasn't there something you need to do with COM when using threads. Like Marshalling stuff I think..

Sorry if this doesn't give you the answer you were looking for.

[Thomas Tierney]

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

#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

And the service

#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