Subscriber: MainForm.frm
This code sample is for the GUI and the control buttons on the GUI. This code should be built along with the BizTalk.cls, after registering the COMConnector.dll and MyEventSink.dll.
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form MainForm
Caption = "Subscriber Client"
ClientHeight = 7470
ClientLeft = 3555
ClientTop = 2820
ClientWidth = 11655
LinkTopic = "Form1"
ScaleHeight = 7470
ScaleWidth = 11655
Begin VB.Frame grpSubscribedEvents
Caption = "Subscribed Events"
Height = 2895
Index = 1
Left = 120
TabIndex = 17
Top = 2160
Width = 2775
Begin VB.CommandButton Command1
Caption = "Clear"
Height = 375
Left = 4560
TabIndex = 18
Top = 2280
Width = 975
End
Begin MSComctlLib.ListView lvwSubscribedEvents
Height = 1695
Left = 120
TabIndex = 19
Top = 360
Width = 2535
_ExtentX = 4471
_ExtentY = 2990
View = 2
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-
00C0F0283628}
Key = "colEventName"
Text = "Event Name"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-
00C0F0283628}
SubItemIndex = 1
Key = "colData"
Text = "Data"
Object.Width = 6174
EndProperty
End
End
Begin VB.CommandButton btnGetEventTemplate
Caption = "Get Template"
Height = 375
Left = 3720
TabIndex = 14
Top = 120
Width = 1455
End
Begin VB.CommandButton btnGetEventList
Caption = "Get Event List"
Height = 375
Left = 600
TabIndex = 13
Top = 120
Width = 1455
End
Begin SHDocVwCtl.WebBrowser wbEventData
Height = 6375
Left = 6240
TabIndex = 12
Top = 360
Width = 5175
ExtentX = 9128
ExtentY = 11245
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = ""
End
Begin VB.CheckBox chkEnableBizTalkIntegration
Caption = "Enable BizTalk Integration"
Height = 255
Left = 240
TabIndex = 8
Top = 5280
Width = 2535
End
Begin VB.Frame grpEnableBizTalkIntegration
Height = 975
Left = 120
TabIndex = 7
Top = 5640
Width = 5775
Begin VB.TextBox txtScheduleFile
Height = 375
Left = 1440
TabIndex = 10
Text = "sked:///\vbeventsdemo\Products\
VBCOMConnector\BizTalk\Buyer1.skx"
Top = 360
Width = 4095
End
Begin VB.Label lblScheduleFile
Alignment = 1 'Right Justify
Caption = "Schedule File:"
Height = 255
Left = 240
TabIndex = 9
Top = 480
Width = 1095
End
End
Begin VB.CommandButton btnClose
Caption = "Close"
Height = 375
Left = 5760
TabIndex = 3
Top = 6960
Width = 975
End
Begin VB.Frame grpReceivedEvents
Caption = "Received Events"
Height = 2895
Index = 0
Left = 3000
TabIndex = 6
Top = 2160
Width = 2895
Begin VB.CommandButton btnClear
Caption = "Clear"
Height = 375
Index = 0
Left = 1680
TabIndex = 2
Top = 2280
Width = 975
End
Begin MSComctlLib.ListView lvwReceivedEvents
Height = 1695
Left = 120
TabIndex = 1
Top = 360
Width = 2655
_ExtentX = 4683
_ExtentY = 2990
View = 2
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-
00C0F0283628}
Key = "colEventName"
Text = "Event Name"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-
00C0F0283628}
SubItemIndex = 1
Key = "colData"
Text = "Data"
Object.Width = 6174
EndProperty
End
End
Begin VB.Frame grpSubscriptions
Caption = "Subscriptions"
Height = 1215
Left = 120
TabIndex = 4
Top = 720
Width = 5775
Begin VB.CheckBox chkPersist
Caption = "Persist"
Height = 255
Left = 1560
TabIndex = 16
Top = 840
Width = 975
End
Begin VB.ComboBox cEventList
Height = 315
Left = 1560
Sorted = -1 'True
TabIndex = 15
Top = 360
Width = 2295
End
Begin VB.CommandButton btnUnsubscribe
Caption = "UnSubscribe"
Height = 375
Left = 4200
TabIndex = 11
Top = 720
Width = 1095
End
Begin VB.CommandButton btnSubscribe
Caption = "Subscribe"
Height = 375
Left = 4200
TabIndex = 0
Top = 240
Width = 1095
End
Begin VB.Label lblEventName
Alignment = 1 'Right Justify
Caption = "Event Name:"
Height = 255
Left = 360
TabIndex = 5
Top = 360
Width = 1095
End
End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' ------------------------------- ** ---------------------------------
' Member Variables
' ------------------------------- ** ---------------------------------
Private m_SubscriptionManager As SubscriptionManager
Private WithEvents m_OneWorldTransientEventSink As
OneWorldTransientEventSink
Attribute m_OneWorldTransientEventSink.VB_VarHelpID = -1
Private Sub Combo1_Change()
End Sub
Private Sub Check1_Click()
End Sub
Private Sub btnClear_Click(Index As Integer)
lvwReceivedEvents.ListItems.Clear
End Sub
'----------------------------- ** -----------------------------------
' GetEventTemplate
'----------------------------- ** -----------------------------------
Private Sub btnGetEventTemplate_Click()
Dim EventName As String
Dim EventTemplate As String
EventName = cEventList.List(cEventList.ListIndex)
'm_SubscriptionManager.GetEventTemplate EventName, EventTemplate
Dim flsObject As New Scripting.FileSystemObject
Dim varTemplateFile As TextStream
Dim strTemplateFile As String
strTemplateFile = "C:\temp\event_template.xml"
If Dir(strTemplateFile) = "" Then
Set varTemplateFile = flsObject.CreateTextFile
(strTemplateFile, False, False)
Else
Set varTemplateFile = flsObject.OpenTextFile
(strTemplateFile,ForWriting, False)
End If
varTemplateFile.WriteLine EventTemplate
varTemplateFile.Close
wbEventData.Navigate "c:\temp\event_template.xml"
End Sub
' ------------------------------- ** --------------------------------
' Event Handlers
' ------------------------------- ** --------------------------------
Private Sub Form_Load()
Set m_SubscriptionManager = New SubscriptionManager
Set m_OneWorldTransientEventSink = New OneWorldTransientEventSink
'EnableBizTalkIntegrationGroup
End Sub
Private Sub m_OneWorldTransientEventSink_OneWorldEvent(ByVal EventName
As String, ByVal Data As String)
' add the event name and payload to the list
Dim mTempItem As ListItem
Set mTempItem = lvwReceivedEvents.ListItems.Add()
mTempItem.Text = EventName
'mTempItem.SubItems(1) = Data
Dim flsObject As New Scripting.FileSystemObject
Dim varEventFile As TextStream
Dim strEventFile As String
strEventFile = "C:\temp\eventData.xml"
If Dir(strEventFile) = "" Then
Set varEventFile = flsObject.CreateTextFile(strEventFile,
False, False)
Else
Set varEventFile = flsObject.OpenTextFile(strEventFile,
ForWriting, False)
End If
varEventFile.WriteLine Data
varEventFile.Close
wbEventData.Navigate "c:\temp\eventdata.xml"
' send the event to BizTalk (if it is enabled)
'If (chkEnableBizTalkIntegration.Value = Checked) Then
'Dim oBizTalk As BizTalk
'Set oBizTalk = New BizTalk
'oBizTalk.RunSchedule txtScheduleFile.Text, Data
' End If
End Sub
'----------------------------- ** -----------------------------------
' GetEventList
'----------------------------- ** -----------------------------------
Private Sub btnGetEventList_Click()
Dim events As String
Dim myValue As String
Dim myString As String
Set m_SubscriptionManager = New SubscriptionManager
m_SubscriptionManager.GetEventList events
cEventList.Clear
events = "RTSOOUT"
myString = events
'Do Until events = ""
'If InStr(1, myString, ":") > 0 Then
' myValue = Left(myString, InStr(1, myString, ":") - 1)
' myString = Mid(myString, InStr(1, myString, ":") + 1)
'Else
' myValue = myString
' events = ""
'End If
'cEventList.AddItem myValue
' Loop
cEventList.AddItem myString
cEventList.ListIndex = 0
End Sub
'----------------------------- ** -----------------------------------
' Subscribe Event
'----------------------------- ** -----------------------------------
Private Sub btnSubscribe_Click()
' subscribe to the named event.
Dim EventName As String
EventName = cEventList.List(cEventList.ListIndex)
If (chkPersist.Value = Checked) Then
m_SubscriptionManager.CreatePersistentSubscription EventName,
m_OneWorldTransientEventSink
Else
m_SubscriptionManager.CreateTransientSubscription EventName,
m_OneWorldTransientEventSink
End If
Dim mTempItem As ListItem
Set mTempItem = lvwSubscribedEvents.ListItems.Add()
mTempItem.Text = EventName
End Sub
'---------------------------- ** ----------------------------------
' UnSubscribe Event
'---------------------------- ** ----------------------------------
Private Sub btnUnsubscribe_Click()
Dim EventName As String
EventName = cEventList.List(cEventList.ListIndex)
Dim lstItem As ListItem
Dim count As Integer
Dim found As Boolean
count = 0
found = False
For Each lstItem In lvwSubscribedEvents.ListItems
count = count + 1
If lstItem = EventName Then
lvwSubscribedEvents.ListItems.remove (count)
GoTo remove
found = True
End If
Next
If found = False Then
MsgBox "Event Not Subscribed"
End If
remove: If (chkPersist.Value = Checked) Then
m_SubscriptionManager.RemovePersistentSubscription EventName,
m_OneWorldTransientEventSink
Else
m_SubscriptionManager.RemoveTransientSubscription EventName,
m_OneWorldTransientEventSink
End If
End Sub
Private Sub chkEnableBizTalkIntegration_Click()
'EnableBizTalkIntegrationGroup
End Sub
'---------------------------- ** ------------------------------------
' Clear the Received Events List
'---------------------------- ** ------------------------------------
Private Sub btnClear0_Click()
' clear the events from the list
lvwReceivedEvents.ListItems.Clear
End Sub
Private Sub btnClose_Click()
m_SubscriptionManager.Logoff
Unload Me
End
End Sub
' ------------------------------ ** ---------------------------------
' Private Functions
' ------------------------------ ** ---------------------------------
Private Sub Initialize()
' Create the event sink
Set m_OneWorldTransientEventSink = New OneWorldTransientEventSink
End Sub
Private Sub EnableBizTalkIntegrationGroup()
'Dim blnEnable As Boolean
'blnEnable = (chkEnableBizTalkIntegration.Value = Checked)
'lblScheduleFile.Enabled = blnEnable
'txtScheduleFile.Enabled = blnEnable
End Sub