WCF Call Back Implementation in COM

See more:

VB

WCF

Hi all,

I have developed a WCF service with Callbacks and its working in my .net windows client.Now i need to develop a client on vb6.0 one.

For this i developed a class library com visible one which communicates with WCF service in vb.net. even it also build perfectly then i created a vb 6.0 client and added that references of com library but the problem is here My callback method which is raising event in vb 6.0 is not working.

even my callback method execute the line Raise event but still its not working.

Following is the my code and my vb6.0 client.
Com compliance Class library from vb.net:

Imports System.Runtime.InteropServices
Imports System.ServiceModel
'Imports ContextService
<ComImport(), _
Guid("CB5BDC81-93C1-11CF-8F20-00805F2CD064"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IObjectSafety
    <PreserveSig()> Function GetInterfaceSafetyOptions(ByRef iid As Guid, ByRef pdwSupportedOptions As Integer, ByRef pdwEnabledOptions As Integer) As Integer
    <PreserveSig()> Function SetInterfaceSafetyOptions(ByRef iid As Guid, ByVal dwOptionSetMask As Integer, ByVal dwEnabledOptions As Integer) As Integer
    End Interface
Public Delegate Sub [ContextEventHandler](ByVal name As String)
<Guid("5447F863-5DCE-4099-B402-FF2C164C0787"), _
   InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
   Public Interface IHello
    <DispId(1)> Sub ContextChanged(ByVal name As String)
End Interface
<Guid("9FD96D25-6900-4b74-B5BE-8C6CD728AEE3"), _
    ClassInterface(ClassInterfaceType.AutoDual), _
    ComSourceInterfaces(GetType(IHello)), _
    ProgId("Test.CurrentDate")> _
    Public Class CurrentDate
    Implements IObjectSafety
    Private Const INTERFACESAFE_FOR_UNTRUSTED_CALLER As Integer = &H1
    Private Const INTERFACESAFE_FOR_UNTRUSTED_DATA As Integer = &H2
    Private Const S_OK As Integer = 0

    Public Event ContextChanged As ContextEventHandler
    Dim objcproxy As IService1
    'Public Delegate Sub ClientNotifiedEventHandler(ByVal sender As Object, ByVal e As ClientNotifiedEventArgs)
    Private clientId As Guid
    Sub New()
        Try
            ' MsgBox("Entered In")
            Dim myCallbacks As New Callbacks()
            Dim pipeFactory As New DuplexChannelFactory(Of IService1)(myCallbacks, New NetNamedPipeBinding(), New EndpointAddress("net.pipe://localhost/pipeservice"))
            objcproxy = pipeFactory.CreateChannel
            'Dim str As String = "shure"
            'MsgBox("Entered OUT")
        Catch ex As Exception
            MsgBox(ex.Message)
            'MessageBox.Show("An exception of type '" + ex.GetType().ToString() + " occurred " + ex.Message, "Exceptions")
        End Try
    End Sub
    Public Sub notify(ByVal var As String)
        'Dim myThread As New System.Threading.Thread(AddressOf ExecNot)
        'myVar = var
        'myThread.Start()
        MsgBox("In Notify")
        MsgBox(var)
        RaiseEvent ContextChanged(var)
    End Sub
    Private myVar As String
    Public Sub ExecNot()
        MsgBox("In Notify")
        MsgBox(myVar)
        RaiseEvent ContextChanged(myVar)
    End Sub
    Public Function SetEnv(ByVal var As String, ByVal varval As String) As Boolean
        Try
            objcproxy.SetContextString(var, varval)
            Return True
        Catch ex As TimeoutException
            Return False
        Finally
        End Try
    End Function
    Public Function GetEnvVal(ByVal var As String) As String
        Try
            Return objcproxy.GetContextString(var)
        Catch ex As Exception
            Return ex.Message
        End Try
    End Function
    Public Sub setNotify(ByVal var As String, ByVal state As Boolean)
        If state = True Then
            objcproxy.SetNotificationOn(var)
            clientId = objcproxy.Subscribe(var)
            MsgBox(clientId.ToString())
        Else
            objcproxy.SetNotificationOff(var)
            objcproxy.UnSubscribe(clientId, var)
        End If
    End Sub
    Public Function GetInterfaceSafetyOptions(ByRef iid As System.Guid, ByRef pdwSupportedOptions As Integer, ByRef pdwEnabledOptions As Integer) As Integer Implements IObjectSafety.GetInterfaceSafetyOptions
        pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or INTERFACESAFE_FOR_UNTRUSTED_DATA
        pdwEnabledOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or INTERFACESAFE_FOR_UNTRUSTED_DATA
        Return S_OK
    End Function
    Public Function SetInterfaceSafetyOptions(ByRef iid As System.Guid, ByVal dwOptionSetMask As Integer, ByVal dwEnabledOptions As Integer) As Integer Implements IObjectSafety.SetInterfaceSafetyOptions
        Return S_OK
    End Function
    Public Function GetDate() As String
        GetDate = DateTime.Now.ToString
    End Function
    Public Function GetString() As String
        GetString = "GuruDeva"
    End Function
    Public Function GETResult() As Integer
        Return 1990
    End Function
End Class
'=========================
'My call back class 
'=====================
Public Class Callbacks
    Implements IService1Callback
    Public Sub OnContextChanged(ByVal varname As String) Implements IService1Callback.OnContextChanged
        MsgBox("enterd in callback")
        'Dim obj As New CurrentDate
        Dim obj As TEST.CurrentDate
        obj = New TEST.CurrentDate
        obj.notify(varname)
        MsgBox("After raise")
    End Sub
'============================
'every alert is executing in above callback method.
'===============================

    Sub New()
        Try
            'MsgBox("Entered Callback")
        Catch ex As Exception
            MsgBox(ex.Message)
            'MessageBox.Show("An exception of type '" + ex.GetType().ToString() + " occurred " + ex.Message, "Exceptions")
        End Try
    End Sub
    Public Function calmsg() As String
        calmsg = "FromCalback"
        MsgBox(calmsg)
    End Function
End Class

'====================
'My vb 6.0 client
'=========================

Dim WithEvents obj As TEST.CurrentDate
Private Sub Command1_Click()
Dim bul As Boolean
bul = obj.SetEnv(Text1.Text, Text2.Text)
If Check1.Value = 1 Then
obj.setNotify Text1.Text, "TRUE"
End If
End Sub

Private Sub Command2_Click()
Text2.Text = obj.GetEnvVal(Text1.Text)
End Sub

Private Sub Command3_Click()
If Check1.Value = 1 Then
obj.notify (Text1.Text)
End If
End Sub

Private Sub Form_Load()
'Set obj = New TEST.Callbacks
Set obj = New TEST.CurrentDate

End Sub
Private Sub obj_ContextChanged(ByVal str As String)
Text2.Text = obj.GetEnvVal(Text1.Text)
End Sub

Please advice in this case or else guide me how to implement callbacks for a vb6 client