517 lines
16 KiB
Plaintext
517 lines
16 KiB
Plaintext
|
VERSION 5.00
|
||
|
|
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
|
||
|
|
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
|
||
|
|
Begin VB.Form Form1
|
||
|
|
BorderStyle = 1 'Fixed Single
|
||
|
|
Caption = "HTTP MSMQ"
|
||
|
|
ClientHeight = 9375
|
||
|
|
ClientLeft = 45
|
||
|
|
ClientTop = 435
|
||
|
|
ClientWidth = 10965
|
||
|
|
LinkTopic = "Form1"
|
||
|
|
MaxButton = 0 'False
|
||
|
|
MinButton = 0 'False
|
||
|
|
ScaleHeight = 9375
|
||
|
|
ScaleWidth = 10965
|
||
|
|
StartUpPosition = 3 'Windows Default
|
||
|
|
Begin VB.TextBox txtQueueName
|
||
|
|
Height = 375
|
||
|
|
Left = 5640
|
||
|
|
TabIndex = 12
|
||
|
|
Top = 1200
|
||
|
|
Width = 3255
|
||
|
|
End
|
||
|
|
Begin VB.TextBox txtMachineName
|
||
|
|
Height = 375
|
||
|
|
Left = 1320
|
||
|
|
TabIndex = 11
|
||
|
|
Top = 1200
|
||
|
|
Width = 2415
|
||
|
|
End
|
||
|
|
Begin TabDlg.SSTab SSTab1
|
||
|
|
Height = 7335
|
||
|
|
Left = 0
|
||
|
|
TabIndex = 0
|
||
|
|
Top = 2040
|
||
|
|
Width = 10965
|
||
|
|
_ExtentX = 19341
|
||
|
|
_ExtentY = 12938
|
||
|
|
_Version = 393216
|
||
|
|
TabOrientation = 1
|
||
|
|
Tabs = 2
|
||
|
|
TabHeight = 520
|
||
|
|
TabCaption(0) = "Send"
|
||
|
|
TabPicture(0) = "httpm.frx":0000
|
||
|
|
Tab(0).ControlEnabled= -1 'True
|
||
|
|
Tab(0).Control(0)= "Label1"
|
||
|
|
Tab(0).Control(0).Enabled= 0 'False
|
||
|
|
Tab(0).Control(1)= "Label3"
|
||
|
|
Tab(0).Control(1).Enabled= 0 'False
|
||
|
|
Tab(0).Control(2)= "Label4"
|
||
|
|
Tab(0).Control(2).Enabled= 0 'False
|
||
|
|
Tab(0).Control(3)= "Label11"
|
||
|
|
Tab(0).Control(3).Enabled= 0 'False
|
||
|
|
Tab(0).Control(4)= "cbSend"
|
||
|
|
Tab(0).Control(4).Enabled= 0 'False
|
||
|
|
Tab(0).Control(5)= "txtTitle"
|
||
|
|
Tab(0).Control(5).Enabled= 0 'False
|
||
|
|
Tab(0).Control(6)= "txtBody"
|
||
|
|
Tab(0).Control(6).Enabled= 0 'False
|
||
|
|
Tab(0).Control(7)= "txtTTRQ"
|
||
|
|
Tab(0).Control(7).Enabled= 0 'False
|
||
|
|
Tab(0).ControlCount= 8
|
||
|
|
TabCaption(1) = "Browse"
|
||
|
|
TabPicture(1) = "httpm.frx":001C
|
||
|
|
Tab(1).ControlEnabled= 0 'False
|
||
|
|
Tab(1).Control(0)= "Label7"
|
||
|
|
Tab(1).Control(0).Enabled= 0 'False
|
||
|
|
Tab(1).Control(1)= "Label8"
|
||
|
|
Tab(1).Control(1).Enabled= 0 'False
|
||
|
|
Tab(1).Control(2)= "Label9"
|
||
|
|
Tab(1).Control(2).Enabled= 0 'False
|
||
|
|
Tab(1).Control(3)= "Label10"
|
||
|
|
Tab(1).Control(3).Enabled= 0 'False
|
||
|
|
Tab(1).Control(4)= "lbLookupId"
|
||
|
|
Tab(1).Control(4).Enabled= 0 'False
|
||
|
|
Tab(1).Control(5)= "Label12"
|
||
|
|
Tab(1).Control(5).Enabled= 0 'False
|
||
|
|
Tab(1).Control(6)= "WebBrowser1"
|
||
|
|
Tab(1).Control(6).Enabled= 0 'False
|
||
|
|
Tab(1).Control(7)= "cbStartPeek"
|
||
|
|
Tab(1).Control(7).Enabled= 0 'False
|
||
|
|
Tab(1).Control(8)= "cbPrev"
|
||
|
|
Tab(1).Control(8).Enabled= 0 'False
|
||
|
|
Tab(1).Control(9)= "cbNext"
|
||
|
|
Tab(1).Control(9).Enabled= 0 'False
|
||
|
|
Tab(1).Control(10)= "tbRcvLabel"
|
||
|
|
Tab(1).Control(10).Enabled= 0 'False
|
||
|
|
Tab(1).Control(11)= "tbRcvBody"
|
||
|
|
Tab(1).Control(11).Enabled= 0 'False
|
||
|
|
Tab(1).ControlCount= 12
|
||
|
|
Begin VB.TextBox txtTTRQ
|
||
|
|
Height = 375
|
||
|
|
Left = 960
|
||
|
|
TabIndex = 25
|
||
|
|
Text = "30"
|
||
|
|
Top = 2760
|
||
|
|
Width = 495
|
||
|
|
End
|
||
|
|
Begin VB.TextBox tbRcvBody
|
||
|
|
Enabled = 0 'False
|
||
|
|
Height = 375
|
||
|
|
Left = -74880
|
||
|
|
TabIndex = 22
|
||
|
|
Top = 3960
|
||
|
|
Width = 3255
|
||
|
|
End
|
||
|
|
Begin VB.TextBox tbRcvLabel
|
||
|
|
Enabled = 0 'False
|
||
|
|
Height = 375
|
||
|
|
Left = -74880
|
||
|
|
TabIndex = 21
|
||
|
|
Top = 2520
|
||
|
|
Width = 3255
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cbNext
|
||
|
|
Caption = "Next"
|
||
|
|
Height = 375
|
||
|
|
Left = -72960
|
||
|
|
TabIndex = 17
|
||
|
|
Top = 6360
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cbPrev
|
||
|
|
Caption = "Previous"
|
||
|
|
Height = 375
|
||
|
|
Left = -74760
|
||
|
|
TabIndex = 16
|
||
|
|
Top = 6360
|
||
|
|
Width = 1095
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cbStartPeek
|
||
|
|
Caption = "Begin!"
|
||
|
|
Height = 495
|
||
|
|
Left = -74760
|
||
|
|
TabIndex = 15
|
||
|
|
Top = 1080
|
||
|
|
Width = 2655
|
||
|
|
End
|
||
|
|
Begin SHDocVwCtl.WebBrowser WebBrowser1
|
||
|
|
Height = 4815
|
||
|
|
Left = -71520
|
||
|
|
TabIndex = 13
|
||
|
|
Top = 1560
|
||
|
|
Width = 7335
|
||
|
|
ExtentX = 12938
|
||
|
|
ExtentY = 8493
|
||
|
|
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 = "http:///"
|
||
|
|
End
|
||
|
|
Begin VB.TextBox txtBody
|
||
|
|
Height = 375
|
||
|
|
Left = 4560
|
||
|
|
TabIndex = 4
|
||
|
|
Text = "Message Body"
|
||
|
|
Top = 1680
|
||
|
|
Width = 3495
|
||
|
|
End
|
||
|
|
Begin VB.TextBox txtTitle
|
||
|
|
Height = 375
|
||
|
|
Left = 240
|
||
|
|
TabIndex = 3
|
||
|
|
Text = "This is the message label"
|
||
|
|
Top = 1680
|
||
|
|
Width = 3255
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cbSend
|
||
|
|
Caption = "Send!"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial"
|
||
|
|
Size = 14.25
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 735
|
||
|
|
Left = 3000
|
||
|
|
TabIndex = 2
|
||
|
|
Top = 4920
|
||
|
|
Width = 2655
|
||
|
|
End
|
||
|
|
Begin VB.Label Label12
|
||
|
|
Caption = "Msg LookupID:"
|
||
|
|
Height = 255
|
||
|
|
Left = -74880
|
||
|
|
TabIndex = 26
|
||
|
|
Top = 5040
|
||
|
|
Width = 1095
|
||
|
|
End
|
||
|
|
Begin VB.Label Label11
|
||
|
|
Caption = "Time To Reach Queue (sec):"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial Narrow"
|
||
|
|
Size = 12
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = -1 'True
|
||
|
|
Italic = -1 'True
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 375
|
||
|
|
Left = 240
|
||
|
|
TabIndex = 24
|
||
|
|
Top = 2280
|
||
|
|
Width = 2775
|
||
|
|
End
|
||
|
|
Begin VB.Label lbLookupId
|
||
|
|
Caption = "Label11"
|
||
|
|
Height = 255
|
||
|
|
Left = -73680
|
||
|
|
TabIndex = 23
|
||
|
|
Top = 5040
|
||
|
|
Width = 1695
|
||
|
|
End
|
||
|
|
Begin VB.Label Label10
|
||
|
|
Caption = "SOAP Envelope"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial Narrow"
|
||
|
|
Size = 12
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = -1 'True
|
||
|
|
Italic = -1 'True
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 375
|
||
|
|
Left = -70920
|
||
|
|
TabIndex = 20
|
||
|
|
Top = 1080
|
||
|
|
Width = 2175
|
||
|
|
End
|
||
|
|
Begin VB.Label Label9
|
||
|
|
Caption = "Message Body"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial Narrow"
|
||
|
|
Size = 12
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = -1 'True
|
||
|
|
Italic = -1 'True
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 495
|
||
|
|
Left = -74880
|
||
|
|
TabIndex = 19
|
||
|
|
Top = 3480
|
||
|
|
Width = 2055
|
||
|
|
End
|
||
|
|
Begin VB.Label Label8
|
||
|
|
Caption = "Message Label"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial Narrow"
|
||
|
|
Size = 12
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = -1 'True
|
||
|
|
Italic = -1 'True
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 375
|
||
|
|
Left = -74880
|
||
|
|
TabIndex = 18
|
||
|
|
Top = 2040
|
||
|
|
Width = 1815
|
||
|
|
End
|
||
|
|
Begin VB.Label Label7
|
||
|
|
Caption = "Browse"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial"
|
||
|
|
Size = 36
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 855
|
||
|
|
Left = -71520
|
||
|
|
TabIndex = 14
|
||
|
|
Top = 120
|
||
|
|
Width = 3495
|
||
|
|
End
|
||
|
|
Begin VB.Label Label4
|
||
|
|
Caption = "Message Body:"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial Narrow"
|
||
|
|
Size = 12
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = -1 'True
|
||
|
|
Italic = -1 'True
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 375
|
||
|
|
Left = 4560
|
||
|
|
TabIndex = 6
|
||
|
|
Top = 1200
|
||
|
|
Width = 3495
|
||
|
|
End
|
||
|
|
Begin VB.Label Label3
|
||
|
|
Caption = "Message Label"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial Narrow"
|
||
|
|
Size = 12
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = -1 'True
|
||
|
|
Italic = -1 'True
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 495
|
||
|
|
Left = 240
|
||
|
|
TabIndex = 5
|
||
|
|
Top = 1200
|
||
|
|
Width = 2295
|
||
|
|
End
|
||
|
|
Begin VB.Label Label1
|
||
|
|
Caption = "Sending"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial"
|
||
|
|
Size = 36
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 975
|
||
|
|
Left = 3840
|
||
|
|
TabIndex = 1
|
||
|
|
Top = 120
|
||
|
|
Width = 3015
|
||
|
|
End
|
||
|
|
End
|
||
|
|
Begin VB.Label lbFormatName
|
||
|
|
Caption = "....place holder for format name display......"
|
||
|
|
Height = 375
|
||
|
|
Left = 120
|
||
|
|
TabIndex = 10
|
||
|
|
Top = 1680
|
||
|
|
Width = 9015
|
||
|
|
End
|
||
|
|
Begin VB.Label Label5
|
||
|
|
Caption = "Queue Name:"
|
||
|
|
Height = 375
|
||
|
|
Left = 4080
|
||
|
|
TabIndex = 9
|
||
|
|
Top = 1200
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin VB.Label Label2
|
||
|
|
Caption = "Machine Name:"
|
||
|
|
Height = 375
|
||
|
|
Left = 120
|
||
|
|
TabIndex = 8
|
||
|
|
Top = 1200
|
||
|
|
Width = 1215
|
||
|
|
End
|
||
|
|
Begin VB.Label Label6
|
||
|
|
Caption = "HTTP Messages"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial"
|
||
|
|
Size = 36
|
||
|
|
Charset = 0
|
||
|
|
Weight = 700
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 975
|
||
|
|
Left = 3000
|
||
|
|
TabIndex = 7
|
||
|
|
Top = 0
|
||
|
|
Width = 5895
|
||
|
|
End
|
||
|
|
End
|
||
|
|
Attribute VB_Name = "Form1"
|
||
|
|
Attribute VB_GlobalNameSpace = False
|
||
|
|
Attribute VB_Creatable = False
|
||
|
|
Attribute VB_PredeclaredId = True
|
||
|
|
Attribute VB_Exposed = False
|
||
|
|
Option Explicit
|
||
|
|
Dim QueueName As String
|
||
|
|
Dim FormatName As String
|
||
|
|
|
||
|
|
Dim rcvQInfo As New MSMQQueueInfo
|
||
|
|
Dim rcvQ As MSMQQueue
|
||
|
|
Dim lastLookupId As Variant
|
||
|
|
Dim lastmsgRec As MSMQMessage
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub SetAndDisplayFormatName()
|
||
|
|
FormatName = "DIRECT=http://" + txtMachineName.Text + "/MSMQ/" + txtQueueName.Text
|
||
|
|
lbFormatName.Caption = "Format name for the queue is: " + FormatName
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub cbNext_Click()
|
||
|
|
Set lastmsgRec = rcvQ.PeekNextByLookupId(lastLookupId)
|
||
|
|
|
||
|
|
Call DisplayLastRecvMessage
|
||
|
|
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub cbPrev_Click()
|
||
|
|
Set lastmsgRec = rcvQ.PeekPreviousByLookupId(lastLookupId)
|
||
|
|
|
||
|
|
Call DisplayLastRecvMessage
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub cbSend_Click()
|
||
|
|
'*************************************************************
|
||
|
|
' Declare the required objects.
|
||
|
|
'*************************************************************
|
||
|
|
Dim qinfo As New MSMQQueueInfo
|
||
|
|
Dim q As MSMQQueue
|
||
|
|
Dim m As New MSMQMessage
|
||
|
|
|
||
|
|
'*************************************************************
|
||
|
|
' Create a destination queue and open it with SEND access.
|
||
|
|
'*************************************************************
|
||
|
|
|
||
|
|
qinfo.FormatName = FormatName
|
||
|
|
Set q = qinfo.Open(MQ_SEND_ACCESS, MQ_DENY_NONE)
|
||
|
|
|
||
|
|
'*************************************************************
|
||
|
|
' Send message with a String body type.
|
||
|
|
'*************************************************************
|
||
|
|
m.Label = txtTitle.Text
|
||
|
|
m.Body = txtBody.Text
|
||
|
|
m.MaxTimeToReachQueue = txtTTRQ.Text
|
||
|
|
m.Send q
|
||
|
|
|
||
|
|
'*************************************************************
|
||
|
|
' Close queue.
|
||
|
|
'*************************************************************
|
||
|
|
q.Close
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub DisplayLastRecvMessage()
|
||
|
|
Dim soapenv As String
|
||
|
|
|
||
|
|
|
||
|
|
tbRcvLabel.Text = lastmsgRec.Label
|
||
|
|
tbRcvBody.Text = lastmsgRec.Body
|
||
|
|
lastLookupId = lastmsgRec.LookupId
|
||
|
|
|
||
|
|
lbLookupId.Caption = lastLookupId
|
||
|
|
|
||
|
|
'
|
||
|
|
'Display the SOAP envlope
|
||
|
|
'using Internet Explorer rendering XML files
|
||
|
|
'
|
||
|
|
soapenv = lastmsgRec.SoapEnvelope
|
||
|
|
|
||
|
|
'Write the SOAP envelope in a temporary file
|
||
|
|
Open "c:\tt.xml" For Output As #1
|
||
|
|
Print #1, soapenv
|
||
|
|
Close
|
||
|
|
|
||
|
|
'and display the file in the browser window
|
||
|
|
WebBrowser1.Navigate "c:\tt.xml"
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub cbStartPeek_Click()
|
||
|
|
'*************************************************************
|
||
|
|
' Declare the required objects.
|
||
|
|
'*************************************************************
|
||
|
|
|
||
|
|
rcvQInfo.FormatName = FormatName
|
||
|
|
'***********************************************************
|
||
|
|
' Open destination queue for retrieving messages.
|
||
|
|
'***********************************************************
|
||
|
|
Set rcvQ = rcvQInfo.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE)
|
||
|
|
|
||
|
|
'************************************************************
|
||
|
|
' Retrieve messages from the queues.
|
||
|
|
'************************************************************
|
||
|
|
'Set msgRec = q.Peek(ReceiveTimeout:=1000)
|
||
|
|
Set lastmsgRec = rcvQ.PeekFirstByLookupId
|
||
|
|
|
||
|
|
Call DisplayLastRecvMessage
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_Load()
|
||
|
|
lbFormatName.Caption = ""
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub txtMachineName_Change()
|
||
|
|
Call SetAndDisplayFormatName
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub txtQueueName_Change()
|
||
|
|
Call SetAndDisplayFormatName
|
||
|
|
End Sub
|