my PROMIS Know-How

What would an IT Techie name his twins

2010-04-29T00:39:00.001-07:00

If ever an IT techie would have twins, what will their names be?

The picture will say it all...

Main Form - Forms Designer Code

2010-02-11T01:11:00.000-08:00

For this code set, I once again checked with my IT colleague. It is readily available in .NET platform, this so-called Windows Forms Designer Code - but for VB6, you have to go to the file directory, right click on the file (.frm, in this case), then Open With 'Notepad'. Below is the code.

Now why am I so interested in getting this code set?

Many years ago, when I switched to VB .NET 2003, I happen to get a form corrupted, but I was already having a hunch on what use this 'forms designed code' is for, so I saved a copy of it. A corrupted form, having so many controls built into it, now that's some headache that won't go away in a day!

Since I can't view the form in the 'View form' mode, I viewed the code, removed everything, then did a copy-and-paste of the 'forms designer' code. If you are following this, you can guess what happened.

The form was reconstructed magically!

So that is what is keeping me interested in this 'forms designer code'. This is one of those lifelines as a software developer.

----------
VERSION 5.00
Begin VB.Form frmMain
Caption = "Call Procedure PINS List Generator"
ClientHeight = 10140
ClientLeft = 60
ClientTop = 450
ClientWidth = 13095
LinkTopic = "Form1"
ScaleHeight = 10140
ScaleWidth = 13095
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text12
Height = 285
Left = 600
TabIndex = 31
Text = "WG7OFERVAB_1ST-AT-W-00"
Top = 2160
Width = 2655
End
Begin VB.TextBox Text11
Height = 285
Left = 600
TabIndex = 30
Text = "CS42L58-CWZR/A1-WW-W-00"
Top = 1800
Width = 2655
End
Begin VB.TextBox Text10
Height = 285
Left = 3360
TabIndex = 29
Text = "JC7CDPKV_D_ST_MBI-AT-W-00"
Top = 2160
Width = 2655
End
Begin VB.TextBox Text9
Height = 285
Left = 3360
TabIndex = 28
Text = "ADL5502ACB7-J019Z-WW-W-00"
Top = 1800
Width = 2655
End
Begin VB.TextBox Text8
Height = 285
Left = 1560
TabIndex = 27
Text = "FRE003RSPR-NI-AT-W-00"
Top = 1440
Width = 3135
End
Begin VB.TextBox Text7
Height = 285
Left = 1560
TabIndex = 26
Text = "EL8176FIZ-T7-WW-W-00"
Top = 1080
Width = 3135
End
Begin VB.TextBox Text6
Height = 285
Left = 3360
TabIndex = 25
Text = "WP-CU-IPD-SP-09-EI_1X"
Top = 3000
Width = 2175
End
Begin VB.TextBox Text5
Height = 285
Left = 3360
TabIndex = 24
Text = "WP-CU-IPD-BB-09-EI_1X"
Top = 2640
Width = 2175
End
Begin VB.TextBox Text4
Height = 285
Left = 1080
TabIndex = 23
Text = "WP-CU-IPD-FC-08-EI_1X"
Top = 3000
Width = 2175
End
Begin VB.TextBox txtStatus0a
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 480
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 22
Top = 6720
Width = 4815
End
Begin VB.TextBox txtStatus0
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 19
Top = 7320
Width = 4815
End
Begin VB.TextBox txtStatus4
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1335
Left = 6690
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 4320
Width = 5775
End
Begin VB.TextBox txtStatus3
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Left = 7050
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 1680
Width = 5415
End
Begin VB.TextBox txtStatus2
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 450
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 9120
Width = 4815
End
Begin VB.TextBox Text3
Height = 285
Left = 1560
TabIndex = 6
Text = "BF561KBCT-H33G600Z_M1-AT-B-00"
Top = 720
Width = 3135
End
Begin VB.TextBox txtStatus1
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3375
Left = 5730
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 6240
Width = 6735
End
Begin VB.TextBox Text2
Height = 285
Left = 1080
TabIndex = 4
Text = "EW-E1RDL-BB-03_2Y-I"
Top = 2640
Width = 2175
End
Begin VB.TextBox Text1
Height = 285
Left = 1560
TabIndex = 3
Text = "M0724-K2_DUMMYDEV_UBM-EW-0-EQ"
Top = 360
Width = 3135
End
Begin VB.TextBox tbxCallProcName
Height = 375
Left = 1710
TabIndex = 2
Text = "WP-CU-IPD-SP-09-EI_1X"
Top = 3990
Width = 3375
End
Begin VB.CommandButton btnGetFlowListing
Caption = "Get Flow Listing"
Height = 375
Left = 2400
TabIndex = 1
Top = 4455
Width = 1815
End
Begin VB.Label Label6
Caption = "Get Active Prcd ID"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 510
TabIndex = 21
Top = 5280
Width = 1575
End
Begin VB.Label lblTPQuery0
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 480
TabIndex = 20
Top = 5640
Width = 4815
End
Begin VB.Label lblPrcdID
Caption = "PrcdID: "
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2520
TabIndex = 18
Top = 5280
Width = 3375
End
Begin VB.Label lblPinsCount
Caption = "Pins Count:"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 11040
TabIndex = 17
Top = 5880
Width = 1455
End
Begin VB.Label lblTPQuery4
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 6690
TabIndex = 16
Top = 3480
Width = 5775
End
Begin VB.Label lblTPQuery3
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 7050
TabIndex = 15
Top = 720
Width = 5415
End
Begin VB.Label lblTPQuery2
BorderStyle = 1 'Fixed Single
Caption = "TP Query"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 450
TabIndex = 14
Top = 8400
Width = 4815
End
Begin VB.Label Label4
Caption = "Get Prod Status"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 13
Top = 8040
Width = 1935
End
Begin VB.Label Label3
Caption = "Get PINS 5xx Series"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 7080
TabIndex = 12
Top = 360
Width = 2895
End
Begin VB.Label Label2
Caption = "Get Full PINS Data Set"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6720
TabIndex = 11
Top = 3120
Width = 2895
End
Begin VB.Label Label1
Caption = "Processed Result"
BeginProperty Font
Name = "Lucida Console"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5760
TabIndex = 10
Top = 5880
Width = 1695
End
Begin VB.Label lblCallProcHeader
Caption = "Enter Call Proc to capture flow listing:"
Height = 255
Left = 1710
TabIndex = 0
Top = 3630
Width = 2895
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim PROMIS_LOGIN As String
Dim QueryStatus As String
Dim sCommand As String
Dim sQueue As String
Dim thisActivePrcdID As String
Const username As String = "STATSAPP"
Const password As String = "STATSAPP"
Const PROMIS_HEADER As String = "1C"
Const PROMIS_HEADER_SIZE As Integer = 8
Const PROMIS_COMMAND_SIZE As Integer = 40
Dim PipeIndex As Integer
Dim IntStr As String
Dim IntStr2 As String
Dim myCurrPinsDataSet(300, 7) As String

Private Sub btnGetFlowListing_Click()
txtStatus0.Text = ""
txtStatus0a.Text = ""
lblTPQuery0 = ""
txtStatus1.Text = ""
lblTPQuery2 = ""
txtStatus2.Text = ""
lblTPQuery3 = ""
txtStatus3.Text = ""
lblTPQuery4 = ""
txtStatus4.Text = ""
Me.lblPinsCount = "Pins Count: "
GetPinsData (Me.tbxCallProcName.Text)
End Sub

Private Sub Form_Load()
Dim status As Long
' Always call pams_exit on startup. This avoids
' leaving open connections if the app is stopped
' from VB run-mode without detaching.
'
status = pams_exit()

#If MessageQ_Server Then
txtStatus1.Text = "MessageQ Server environment"
#Else
txtStatus1.Text = "MessageQ Client environment"
#End If
End Sub

Function GetPinsData(ByVal myProcName As String) As Integer
Dim status As Long
Dim ReturnedData As Integer
'
GetPins500Series = 0
ReturnedData = 0
' attach Q
status = DmqAttachQ()
If (status <> 1) Then
' error attaching Q
txtStatus1.Text = "Error attaching Q"
Else
' means status is OK
' put msg
' query: "GetActivePrVersion"
QueryStatus = ""
Sleep (100)
Call PutMsg4(myProcName, "GetActivePrVersion", lblTPQuery0)
' get Msg
Sleep (100)
QueryStatus = GetMsg4(txtStatus0a)
' assign a default value for the Prcd Name
thisActivePrcdID = myProcName
' process the data
If (InStr(QueryStatus, "SUCCESS") > 0) Then
ReturnedData = Me.CleanSingleColumnTPResult(QueryStatus, txtStatus0)
If (ReturnedData > 0) Then
lblPrcdID = "PrcdID: " & txtStatus0.Text
thisActivePrcdID = txtStatus0.Text
Else
thisActivePrcdID = myProcName
End If
End If
' put Msg
' query: "CheckProdStatus"
QueryStatus = ""
Sleep (100)
Call PutMsg4(thisActivePrcdID, "CheckProdStatus", lblTPQuery2)
' get Msg
Sleep (100)
QueryStatus = GetMsg4(txtStatus2)
' put Msg
' query: "GetPins500Series"
QueryStatus = ""
Sleep (200) ' safe number, especially when the # of rows is increasing
Call PutMsg4(thisActivePrcdID, "GetPins500Series", lblTPQuery3)
' get Msg
Sleep (300) ' safe number, especially when the # of rows is increasing
QueryStatus = GetMsg4(txtStatus3)
' put Msg
' query: "GetFullPINSSet"
QueryStatus = ""
Sleep (400) ' safe number, especially when the # of rows is increasing
Call PutMsg4(thisActivePrcdID, "GetFullPINSSet", lblTPQuery4)
' get Msg
Sleep (500) ' safe number, especially when the # of rows is increasing
QueryStatus = GetMsg4(txtStatus4)
' process the data
If (InStr(QueryStatus, "SUCCESS") > 0) Then
GetPinsData = CleanCurrPinsDataSet(QueryStatus, txtStatus1)
If (GetPinsData > 0) Then
' show the full data set
'MsgBox ("Number of PINS is " & GetPinsData)
Me.lblPinsCount = "Pins Count: " & GetPinsData
End If
End If
End If
' detach Q, whether failed or succeeded
DmqExit
' clean up the msg, and return how many are captured
End Function

Sub PutMsg4(ByVal DataBuffer As String, ByVal ComType As String, ByVal thisLabel As Label)
Dim status As Long
Dim MsgArea As String * 4096

PutMsg.SrcTarget.Group = 1
PutMsg.SrcTarget.Queue = 4
PutMsg.Class = 0
PutMsg.Type = 0
PutMsg.timeout = 60000
PutMsg.MsgAreaSize = Len(MsgArea)

MsgArea = Compose1(DataBuffer, ComType)
thisLabel = MsgArea

status = DmqPutMsg(PutMsg, MsgArea)
End Sub

Function GetMsg4(ByVal thisControl As TextBox) As String
Dim status As Long
Dim MsgArea As String * 8192
thisControl.Text = ""
GetMsg.timeout = 900
GetMsg.MsgAreaSize = Len(MsgArea)
status = DmqGetMsg(GetMsg, MsgArea)
If (status = PAMS__NOMOREMSG) Then
thisControl.Text = thisControl.Name + ": " + DmqStatusText(status)
ElseIf (status = PAMS__SUCCESS) Then
thisControl.Text = thisControl.Name + ": " + MsgArea
Else
thisControl.Text = thisControl.Name + ": " + "GetMsg status: " + DmqStatusText(status)
End If
GetMsg4 = MsgArea
End Function

Function Compose1(ByVal DataBuffer As String, ByVal ComType As String) As String
PROMIS_LOGIN = "USERID " + username + "|PWD " + password + "|"
Compose1 = ""
Select Case ComType
Case "GetActivePrVersion"
VarProds = "LOWID " & DataBuffer & "|HIGHID " & DataBuffer & "|"
sCommand = "PROPRCD_LIST"
sQueue = VarProds + "FROM PRCDSET|" & _
"WHERE PRODSTATUS EQ 'A' AND ACTIVEFLAG EQ 'A'|" & _
"SHOW EXTERN(PRCDID)|"
Case "GetPins500Series"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_INSTRUCTIONS"
sQueue = VarProds + "NUMBERINSTRUCTIONS 100|FROM PINSSET|" & _
"WHERE (PINSINSTNUM GE '500.000' AND PINSINSTNUM LT '595.000')|" & _
"SHOW PINSINSTNUM|SHOW INSTTYPE|SHOW STAGE|SHOW EXECUTERECPID|" & _
"SHOW LOCATIONID|SHOW CALLPRCDID|"
Case "GetFullPINSSet"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_INSTRUCTIONS"
sQueue = VarProds + "NUMBERINSTRUCTIONS 300|FROM PINSSET|" & _
"SHOW PINSINSTNUM|SHOW INSTTYPE|SHOW EXECUTERECPID|SHOW STAGE|" & _
"SHOW LOCATIONID|SHOW CALLPRCDID|"
Case "CheckProdStatus"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_HEADER"
sQueue = VarProds + "SHOW PRCD.PRODSTATUS|"
End Select
Compose1 = Me.FormQuery(sCommand, sQueue)
End Function

Public Function FormQuery(ByVal sCommand As String, ByVal sQueue As String) As String
FormQuery = PROMIS_HEADER & Space(PROMIS_HEADER_SIZE - Len(PROMIS_HEADER)) & _
Trim(sCommand) & Space(PROMIS_COMMAND_SIZE - Len(Trim(sCommand))) & _
"|" & PROMIS_LOGIN & sQueue & "END|"
End Function

Public Function CleanSingleColumnTPResult(ByVal thisReplyMsg As String, ByVal thisTextBox As TextBox) As Integer
Dim thisBuffer As String
Dim thisCntr As Integer
thisBuffer = ""
thisCntr = 0
CleanSingleColumnTPResult = 0
thisTextBox.Text = ""
'
PipeIndex = InStr(1, thisReplyMsg, "|")
IntStr = Right(thisReplyMsg, (Len(thisReplyMsg)) - PipeIndex)
PipeIndex = InStr(1, IntStr, "|")
thisCntr = Left(IntStr, (PipeIndex - 1))
'
If (thisCntr <> "0") Then
For i = 0 To (thisCntr - 1)
IntStr2 = Right(IntStr, (Len(IntStr)) - PipeIndex)
PipeIndex = InStr(1, IntStr2, "|")
thisBuffer = Left(IntStr2, PipeIndex - 1)
IntStr = IntStr2
myCurrPinsDataSet(i, 0) = thisBuffer
thisTextBox.Text = thisBuffer
Next
CleanSingleColumnTPResult = thisCntr
Else
CleanSingleColumnTPResult = 0
End If
End Function

Public Function CleanCurrPinsDataSet(ByVal thisReplyMsg As String, ByVal thisTextBox As TextBox) As Integer
Dim thisBuffer As String
Dim thisCntr As Integer
thisBuffer = ""
thisCntr = 0
CleanCurrPinsDataSet = 0
thisTextBox.Text = ""
'
PipeIndex = InStr(1, thisReplyMsg, "|")
IntStr = Right(thisReplyMsg, (Len(thisReplyMsg)) - PipeIndex)
PipeIndex = InStr(1, IntStr, "|")
thisCntr = Left(IntStr, (PipeIndex - 1))
'
If (thisCntr <> "0") Then
For i = 0 To (thisCntr - 1)
For j = 0 To 5
IntStr2 = Right(IntStr, (Len(IntStr)) - PipeIndex)
PipeIndex = InStr(1, IntStr2, "|")
thisBuffer = Left(IntStr2, PipeIndex - 1)
IntStr = IntStr2
If (j = 0) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 1) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 2) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 3) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 4) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 5) Then
myCurrPinsDataSet(i, j) = thisBuffer
End If
Next
Next
CleanCurrPinsDataSet = thisCntr
' do the textbox population here, so main code is clean
' current data set:
' 0 - Inst Num (7 chars, into 8)
' 1 - Inst Type (2 chars, into 3)
' 2 - Exec Recipe (5 chars, into 6)
' 3 - Stage (max 10 chars, into 11)
' 4 - LocationID (max 10 chars, into 11)
' 5 - Call Prcd (max 32 chars, into 33)
Dim tmpPinsBfr As String
' assign the header in the Textbox
thisTextBox.Text = "InstNum -Ityp -Recipe - StageID - LocationID - Call Procedure Name " & vbCrLf & _
"======= -==== -====== - ======= - ========== - =================== " & vbCrLf
For i = 0 To (thisCntr - 1)
For j = 0 To 5
If (j = 0) Then
thisTextBox.Text = thisTextBox.Text & myCurrPinsDataSet(i, j)
ElseIf (j = 1) Then
thisTextBox.Text = thisTextBox.Text & " - " & myCurrPinsDataSet(i, j)
ElseIf (j = 2) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(6 - Len(tmpPinsBfr))
ElseIf (j = 3) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(11 - Len(tmpPinsBfr))
ElseIf (j = 4) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(11 - Len(tmpPinsBfr))
ElseIf (j = 5) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(33 - Len(tmpPinsBfr)) & vbCrLf
End If
Next
Next
Else
CleanCurrPinsDataSet = 0
End If
End Function
----------

DMQAPI (dmqapi.bas)

2010-02-11T00:20:00.000-08:00

The second (and final) file copied from the examples...
Note that Sleep was added in, to put a delay in-between the code execution. Without the delay, the Putmsg and Getmsg functions will go haywire. Seems that VB6 cannot handle the speed of computers these days, thus, the Sleep code.

----------
' *
' * MessageQ API Definitions for Visual Basic
' *
' * Module DMQAPI.BAS
' *
' * Copyright (c) 1997 BEA Systems Inc.
' * All rights reserved
' *
' * The software contained on this media is proprietary to and embodies the
' * confidential technology of BEA Systems, Inc.. Possession, use,
' * duplication or dissemination of the software and media is authorized
' * only pursuant to a valid written license from BEA Systems, Inc..
' *
' * RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure by the U.S.
' * Government is subject to restrictions as set forth in Subparagraph
' * (c)(1)(ii) of DFARS 252.227-7013, or in FAR 52.227-19, as applicable.
' *
' ****************************************************************************************
'
' ****************************************************************************************
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' ****************************************************************************************
'
Global Const DMQ_GENERIC_VERSION = "V400"
'
Global Const PAMS__SUCCESS = 1
Global Const PAMS__LINK_UP = 3
Global Const PAMS__JOURNAL_ON = 5
Global Const PAMS__NOMOREMSG = 7
Global Const PAMS__DISC_SUCCESS = 11
Global Const PAMS__DISCL_SUCCESS = 13
Global Const PAMS__DLJ_SUCCESS = 15
Global Const PAMS__DLQ_SUCCESS = 17
Global Const PAMS__RTS_SUCCESS = 19
Global Const PAMS__SAF_SUCCESS = 21
Global Const PAMS__RECOVERMODE = 23
Global Const PAMS__NO_UMA = 25
Global Const PAMS__UMA_NA = 27
Global Const PAMS__TRACEBACK = 29
Global Const PAMS__STORED = 31
Global Const PAMS__ENQUEUED = 33
Global Const PAMS__UNATTACHEDQ = 35
Global Const PAMS__CONFIRMREQ = 37
Global Const PAMS__PROPAGATE = 39
Global Const PAMS__DETACHED = 41
Global Const PAMS__SAF_FORCED = 43
Global Const PAMS__TRUNCATED = 45
Global Const PAMS_LAST_SUCCESS = 45
'
'
Global Const PAMS__NOSEND = -2
Global Const PAMS__WAKEFAIL = -4
Global Const PAMS__TIMERACT = -6
Global Const PAMS__MSGACT = -8
Global Const PAMS__BADDECLARE = -10
Global Const PAMS__BADFREE = -12
Global Const PAMS__TIMEOUT = -14
Global Const PAMS__ACKTMO = -16
Global Const PAMS__MSGUNDEL = -18
Global Const PAMS__NOTALLOCATE = -20
Global Const PAMS__MSGTOBIG = -22
Global Const PAMS__BIGBLKSIZE = -24
Global Const PAMS__BADRECEIVE = -26
Global Const PAMS__INVALIDID = -36
Global Const PAMS__INVFORMAT = -50
Global Const PAMS__INVALIDNUM = -52
Global Const PAMS__PNUMNOEXIST = -54
Global Const PAMS__NOTACTIVE = -54
Global Const PAMS__EXCEEDQUOTA = -56
Global Const PAMS__BADPRIORITY = -58
Global Const PAMS__BADDELIVERY = -60
Global Const PAMS__BADPROCNUM = -62
Global Const PAMS__BADTMPPROC = -64
Global Const PAMS__BADSYNCHNUM = -66
Global Const PAMS__BADTMPSYNCH = -68
Global Const PAMS__NOTDCL = -70
Global Const PAMS__STATECHANGE = -72
Global Const PAMS__INVUCBCNTRL = -74
Global Const PAMS__NOLINK = -76
Global Const PAMS__CIRACT = -78
Global Const PAMS__PROTOCOL = -80
Global Const PAMS__ABORT = -82
Global Const PAMS__BADASSIGN = -84
Global Const PAMS__LOGNAME = -90
Global Const PAMS__LOGNAME2 = -92
Global Const PAMS__LOGNAME3 = -94
Global Const PAMS__LOGNAME4 = -96
Global Const PAMS__LOGNAME5 = -98
Global Const PAMS__NOOPEN = -100
Global Const PAMS__BADSCRIPT = -102
Global Const PAMS__DECLARED = -106
Global Const PAMS__EXHAUSTBLKS = -108
Global Const PAMS__BADTIME = -110
Global Const PAMS__BIGMSG = -120
Global Const PAMS__MSGTOSMALL = -122
Global Const PAMS__AREATOSMALL = -124
Global Const PAMS__NOCANSEND = -126
Global Const PAMS__QUECORRUPT = -128
Global Const PAMS__REMQUEFAIL = -130
Global Const PAMS__INSQUEFAIL = -132
Global Const PAMS__CREATEFAIL = -134
Global Const PAMS__DCLTMPFAIL = -136
Global Const PAMS__PAMSDOWN = -138
Global Const PAMS__BADASTPARM = -140
Global Const PAMS__EX_Q_LEN = -156
Global Const PAMS__POSSDUPL = -158
Global Const PAMS__STUB = -160
Global Const PAMS__SENDER_TMO_EXPIRED = -162
Global Const PAMS__MRQTBLFULL = -164
Global Const PAMS__NOOBJECT = -166
Global Const PAMS__CANCEL = -168
Global Const PAMS__EXCMAXUNCONF = -170
Global Const PAMS__OBJNOTACTIVE = -172
Global Const PAMS__BUFFEROVF = -174
Global Const PAMS__INVBUFFPTR = -176
Global Const PAMS__BADJOURNAL = -178
Global Const PAMS__COMMERR = -180
Global Const PAMS__BADSELIDX = -182
Global Const PAMS__IDXTBLFULL = -184
Global Const PAMS__BADPARAM = -186
Global Const PAMS__NOMRS = -188
Global Const PAMS__DISC_FAILED = -190
Global Const PAMS__DISCL_FAILED = -192
Global Const PAMS__DLJ_FAILED = -194
Global Const PAMS__DLQ_FAILED = -196
Global Const PAMS__DQF_DEVICE_FAIL = -198
Global Const PAMS__INVUMA = -200
Global Const PAMS__DQF_FULL = -202
Global Const PAMS__INVJH = -204
Global Const PAMS__LINK_DOWN = -206
Global Const PAMS__BADSEQ = -208
Global Const PAMS__NOTJRN = -210
Global Const PAMS__MRS_RES_EXH = -212
Global Const PAMS__NOMOREJH = -214
Global Const PAMS__REJECTED = -216
Global Const PAMS__NOSUCHPCJ = -218
Global Const PAMS__UCBERROR = -220
Global Const PAMS__BADUMA = -222
Global Const PAMS__BADRESPQ = -224
Global Const PAMS__BADARGLIST = -226
Global Const PAMS__NO_DQF = -228
Global Const PAMS__NO_SAF = -230
Global Const PAMS__RTS_FAILED = -232
Global Const PAMS__SAF_DEVICE_FAIL = -234
Global Const PAMS__SAF_FAILED = -236
Global Const PAMS__BADLOGIC = -238
Global Const PAMS__SELRCVACT = -240
Global Const PAMS__NOMRQRESRC = -242
Global Const PAMS__DUPLQNAME = -244
Global Const PAMS__RESRCFAIL = -246
Global Const PAMS__BADTAG = -248
Global Const PAMS__BADTBQHANDLE = -250
Global Const PAMS__INVACCESS = -252
Global Const PAMS__BADNAME = -254
Global Const PAMS__NAMETOOLONG = -256
Global Const PAMS__BADCMD = -258
Global Const PAMS__RESPQREQ = -260
Global Const PAMS__INTERNAL = -262
Global Const PAMS__NOQUOTA = -264
Global Const PAMS__NOTPRIMARYQ = -266
Global Const PAMS__NOTSUPPORTED = -268
Global Const PAMS__NOTSECONDARYQ = -270
Global Const PAMS__FATAL = -272
Global Const PAMS__WRONGDOS = -274
Global Const PAMS__NETERROR = -276
Global Const PAMS__NETNOLINK = -278
Global Const PAMS__NETLINKLOST = -280
Global Const PAMS__BADINITFILE = -282
Global Const PAMS__JOURNAL_FULL = -284
Global Const PAMS__JOURNAL_FAIL = -286
Global Const PAMS__BADQTYPE = -288
Global Const PAMS__BUSNOTSET = -290
Global Const PAMS__GROUPNOTSET = -292
Global Const PAMS__PREVCALLBUSY = -294
Global Const PAMS__EXPIRED = -296
Global Const PAMS__CONFLICT = -298
Global Const PAMS__NOACL = -300
Global Const PAMS__NOACCESS = -302
Global Const PAMS__STALE = -304
Global Const PAMS__BADMSGBUF = -308
Global Const PAMS__DNSCLASSBAD = -310
Global Const PAMS__DNSDIRFAIL = -312
Global Const PAMS__DNSFMTBAD = -314
Global Const PAMS__NOPRIV = -316
Global Const PAMS__FAILED = -320
Global Const PAMS__BADHANDLE = -322
Global Const PAMS__NOSUCHTAG = -324
Global Const PAMS__NOTBOUND = -328
Global Const PAMS__NSBADNAME = -330
Global Const PAMS__NSBADPATH = -332
Global Const PAMS__NSBADCLASS = -334
Global Const PAMS__NSUNKNOWNENTRY = -336
Global Const PAMS__NSENTRYEXISTS = -338
Global Const PAMS__NSUNKNOWNATTR = -340
Global Const PAMS__NSBADATTR = -342
Global Const PAMS__NSACCESSERR = -344
Global Const PAMS__NSWRITERR = -346
Global Const PAMS__NSNOTAVAIL = -348
Global Const PAMS__BOUND = -350
Global Const PAMS__NOMEMORY = -352
Global Const PAMS__NOMORETAG = -354
Global Const PAMS__UNBINDING = -356
Global Const PAMS__STOPPED = -358
Global Const PAMS__ATTACHED = -360
Global Const PAMS__ENDOFSOURCE = -362
Global Const PAMS__LOCKED = -364
Global Const PAMS__MSG = -366
Global Const PAMS__NONEXT = -368
Global Const PAMS__NOTMRQ = -370
Global Const PAMS__SELACTIVE = -372
Global Const PAMS_LAST_FAIL = -374

' End of DMQ constants defined in P_RETURN.H
'
' **************************************************************************
' Selective Receive symbols
' **************************************************************************
'
Global Const PSEL_PRI_P0 = 1
Global Const PSEL_PRI_P1 = 2
Global Const PSEL_PRI_ANY = 3
Global Const PSEL_SOURCE = -1
Global Const PSEL_CLASS = -2
Global Const PSEL_TYPE = -3
'
' *************************************************************************
' Define the Select-by-Queue macros
' *************************************************************************
'
Global Const PSEL_BY_MASK = -1
Global Const PSEL_PQ = -2
Global Const PSEL_AQ = -3
Global Const PSEL_PQ_AQ = -4
Global Const PSEL_AQ_PQ = -5
Global Const PSEL_PQ_TYPE = -6
Global Const PSEL_PQ_CLASS = -7
Global Const PSEL_PQ_PRI = -8
Global Const PSEL_UCB = -9
Global Const PSEL_TQ_PQ = -10
Global Const PSEL_TQ_PQ_AQ = -11
'
' *************************************************************************
' Define the Selective Operators
' *************************************************************************
'
Global Const PSEL_OPER_ANY = 0
Global Const PSEL_OPER_EQ = 1
Global Const PSEL_OPER_NEQ = 2
Global Const PSEL_OPER_GTR = 3
Global Const PSEL_OPER_LT = 4
Global Const PSEL_OPER_GTRE = 5
Global Const PSEL_OPER_LTE = 6
'
' *************************************************************************
' Define the Selective Order
' *************************************************************************
'
Global Const PSEL_ORDER_FIFO = 0
Global Const PSEL_ORDER_MIN = 11
Global Const PSEL_ORDER_MAX = 12
'
' *************************************************************************
' Define PAMS_LOCATE_Q symbols
' *************************************************************************
'
Global Const PSEL_TBL_PROC = -50
Global Const PSEL_TBL_GRP = -51
Global Const PSEL_TBL_DNS_CACHE = -52
Global Const PSEL_TBL_BUS = -52
Global Const PSEL_TBL_DNS_LOW = -53
Global Const PSEL_TBL_BUS_LOW = -53
Global Const PSEL_TBL_DNS_MED = -54
Global Const PSEL_TBL_BUS_MED = -54
Global Const PSEL_TBL_DNS_HIGH = -55
Global Const PSEL_TBL_BUS_HIGH = -55
'
' **************************************************************************
' MRS include file symbols V1.0
' **************************************************************************

Global Const PDEL_MODE_DG_LOG = 0
Global Const PDEL_MODE_DG = 1
Global Const PDEL_MODE_RTS = 10
Global Const PDEL_MODE_WFQ = 20
Global Const PDEL_MODE_ST_RECOVER = 22
Global Const PDEL_MODE_WF_SAF = 25
Global Const PDEL_MODE_WF_DQF = 26
Global Const PDEL_MODE_WF_NET = 27
Global Const PDEL_MODE_WF_RCM = 28
Global Const PDEL_MODE_WF_MEM = 29
Global Const PDEL_MODE_AK_SAF = 30
Global Const PDEL_MODE_AK_DQF = 31
Global Const PDEL_MODE_AK_NET = 32
Global Const PDEL_MODE_AK_RCM = 33
Global Const PDEL_MODE_AK_MEM = 34
Global Const PDEL_MODE_NN_SAF = 35
Global Const PDEL_MODE_NN_DQF = 36
Global Const PDEL_MODE_NN_NET = 37
Global Const PDEL_MODE_NN_RCM = 38
Global Const PDEL_MODE_NN_MEM = 39
Global Const PDEL_MODE_WF_DEQ = 40
Global Const PDEL_MODE_AK_DEQ = 41
Global Const PDEL_MODE_WF_CONF = 42
Global Const PDEL_MODE_AK_CONF = 43
Global Const PDEL_MODE_WF_ACK = 44
Global Const PDEL_MODE_AK_ACK = 45

' **************************************************************************
' Undeliverable Message Action symbols
' **************************************************************************

Global Const PDEL_UMA_RTS = 1
Global Const PDEL_UMA_DLJ = 2
Global Const PDEL_UMA_DLQ = 3
Global Const PDEL_UMA_SAF = 4
Global Const PDEL_UMA_DISC = 5
Global Const PDEL_UMA_DISCL = 6

'**************************************************************************
' define PAMS_ATTACH_Q symbols
'**************************************************************************

Global Const PSYM_DCL_PQ = -200
Global Const PSYM_DCL_SQ = -201
Global Const PSYM_ATTACH_PQ = -200
Global Const PSYM_ATTACH_SQ = -201
Global Const PSYM_SCOPE_LOCAL = -202
Global Const PSYM_SCOPE_GLOBAL = -203
Global Const PSYM_ATTACH_MRQ = -207
Global Const PSYM_ATTACH_BY_NAME = -210
Global Const PSYM_ATTACH_BY_NUMBER = -211
Global Const PSYM_ATTACH_TEMPORARY = -212

'**************************************************************************
' define PAMS_DETACH_Q symbols
'**************************************************************************

Global Const PSYM_NOFLUSH_Q = 1
Global Const PSYM_DETACH_ALL = 2
Global Const PSYM_CANCEL_SEL_MASK = 3

' **************************************************************************
' PAMS_CONFIRM_MSG force journal symbols
' **************************************************************************

Global Const PDEL_DEFAULT_JRN = 0
Global Const PDEL_FORCE_JRN = 1
Global Const PDEL_NO_JRN = 2

' **************************************************************************
' Queue Control LineState values
' **************************************************************************

Global Const LINE_DISCONNECTED = 0
Global Const LINE_CONNECTED = 1
Global Const LINE_JOURNAL_ON = 2

' **************************************************************************
' PAMS_LOCATE_Q symbols
' **************************************************************************

Global Const PSYM_WF_RESP = -70
Global Const PSYM_AK_RESP = -71
'
' *************************************************************************
' Define the Queue Type symbols
' *************************************************************************
'
Global Const PSYM_QTYPE_PQ = 1
Global Const PSYM_QTYPE_SQ = 2
Global Const PSYM_QTYPE_MRQ = 3
Global Const PSYM_QTYPE_UCB = 4
'
' *************************************************************************
' Define status return symbols for que notify services.
' *************************************************************************
'
Global Const PSYM_QNOT_SUCCESS = 1
Global Const PSYM_QNOT_FAIL = 0
Global Const PSYM_QNOT_BADPARAM = -2
'
' *************************************************************************
' Define symbols for SDM tags
' *************************************************************************
'
Global Const PSDM_NULL_TAG = -2146435073
Global Const PSDM_BOOLEAN = -2130706432
Global Const PSDM_INT8 = -1996488704
Global Const PSDM_UINT8 = -1862270976
Global Const PSDM_CHAR = -1728053248
Global Const PSDM_INT16 = -2113929216
Global Const PSDM_UINT16 = -1979711488
Global Const PSDM_INT32 = -2080374784
Global Const PSDM_UINT32 = -1946157056
Global Const PSDM_TIME = -1811939328
Global Const PSDM_FLOAT = -2097152000
Global Const PSDM_QID = -1962934272
Global Const PSDM_INT64 = -2063597568
Global Const PSDM_UINT64 = -1929379840
Global Const PSDM_DOUBLE = -1795162112
Global Const PSDM_STRING = -2013265920
Global Const PSDM_OCTET = -1879048192
Global Const PSDM_FIRST = 1
Global Const PSDM_LAST = 2
Global Const PSDM_ANY = 4
Global Const PSDM_PREVIOUS = 1024
Global Const PSDM_NEXT = 2048
Global Const PSDM_BEFORE = 4096
Global Const PSDM_AFTER = 8192
Global Const PSDM_AT = 16384
'
' *************************************************************************
' Define symbols for large and handled message
' *************************************************************************
'
Global Const PSYM_MSG_HANDLE = -1
Global Const PSYM_MSG_LARGE = -2
'
' **************************************************************************
' Define MessageQ data types
' **************************************************************************

'
' Argument type for pams_attach_q, pams_locate_q, pams_put_msg, pams_get_msg
'
Type QAddress
Queue As Integer
Group As Integer
End Type

'
' Argument type for pams_get_msg
'
Type ShowBuffer
Version As Long
TransferStatus As Long
TransferSize As Long
reserved(7) As Long
Target As QAddress
OriginalTarget As QAddress
Source As QAddress
OriginalSource As QAddress
Delivery As Long
Priority As Long
Endian As Long
End Type

Global Const SHOW_BUFFER_LEN = 68

Type MsgSeqNumberType
FirstLong As Long
SecondLong As Long
End Type

'
' Argument type for pams_put_msg, pams_get_msg
'
Type PSB
TypeOfPsb As Integer
CallDependent As Integer
DelPsbStatus As Long
MsgSeqNumber As MsgSeqNumberType
UmaPsbStatus As Long
PsbReserved(6) As Integer
End Type

'
' Argument type for pams_set_select
'
Type SelectionRecord
Queue As Long
Priority As Long
Key_1_Offset As Long
Key_1_Size As Long
Key_1_Value As Long
Key_1_Oper As Long
Key_2_Offset As Long
Key_2_Size As Long
Key_2_Value As Long
Key_2_Oper As Long
OrderOffset As Long
OrderSize As Long
OrderOrder As Long
End Type

'
' Declare a user-defined type for a DmqMsgT object
'
Type DmqMsgT
Priority As Byte ' signed byte
SrcTarget As QAddress ' longword
Class As Integer ' signed word
Type As Integer ' signed word
Delivery As Byte ' signed byte
MsgAreaSize As Integer ' signed word
MsgLen As Integer ' signed word
timeout As Long ' signed longword
SelFilter As Long ' signed longword
PSB As PSB ' PSB type
UMA As Byte ' signed byte
RespQ As QAddress ' longword
End Type

Type PamsHandle
reserved(16) As Byte
End Type

Type Int64
Value(2) As Long
End Type

'
' Declare MessageQ Client Custom Control EXPORTED functions. The OCX file name
' is dmqclcc.ocx for both VB4-16 and VB4-32.
'
Declare Function DmqGetMsgArea Lib "dmqclcc.ocx" (MsgArea As Any, ByVal MsgAreaSize As Long) As Long

Declare Function DmqSetMsgArea Lib "dmqclcc.ocx" (MsgArea As Any, ByVal MsgAreaSize As Long) As Long

'
' MessageQ API function declarations. Define the conditional compilation
' symbol MessageQ_Server to use this file in the MessageQ server environment.
' If MessageQ_Server is not defined (the normal situation), the function
' declarations will use the MessageQ Client DLL.
'
#If MessageQ_Server Then ' Using the MessageQ Server

Declare Function pams_attach_q Lib "dmq.dll" (AttachMode As Long, QAttached As QAddress, QType As Long, ByVal QName As String, QNameLen As Long, NameSpaceList As Any, NameSpaceListLen As Long, timeout As Long, NullArg1 As Any, NullArg2 As Any) As Long

Declare Function pams_bind_q Lib "dmq.dll" (QAttach As QAddress, ByVal QName As String, QNameLen As Long, NameSpaceList As Any, NameSpaceListLen As Long, timeout As Long, NullArg1 As Any) As Long

Declare Function pams_cancel_select Lib "dmq.dll" (IndexHandle As Long) As Long

Declare Function pams_cancel_timer Lib "dmq.dll" (TimerId As Long) As Long

Declare Function pams_confirm_msg Lib "dmq.dll" (SeqNumber As MsgSeqNumberType, ConfirmStatus As Long, ForceJ As Byte) As Long

Declare Function pams_create_handle Lib "dmq.dll" (MsgHandle As PamsHandle, HandleType As Long) As Long

Declare Function pams_decode_int8 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_decode_uint8 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_decode_int16 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_decode_uint16 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_decode_int32 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_decode_uint32 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_decode_int64 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_decode_uint64 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_decode_float Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Single) As Long

Declare Function pams_decode_double Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Double) As Long

Declare Function pams_decode_string Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, ByVal Value As String, BuffLen As Long, StringLen As Long) As Long

Declare Function pams_decode_array Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Any, BuffLen As Long, NumElements As Long) As Long

Declare Function pams_decode_qid Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As QAddress) As Long

Declare Function pams_delete_handle Lib "dmq.dll" (MsgHandle As PamsHandle) As Long

Declare Function pams_detach_q Lib "dmq.dll" (QDettach As QAddress, OptionList As Long, OptionListLen As Long, MsgsFlushed As Long) As Long

Declare Function pams_encode_int8 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_encode_uint8 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_encode_int16 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_encode_uint16 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_encode_int32 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_encode_uint32 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_encode_int64 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_encode_uint64 Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_encode_float Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Single) As Long

Declare Function pams_encode_double Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Double) As Long

Declare Function pams_encode_qid Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As QAddress) As Long

Declare Function pams_encode_string Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, ByVal Value As String, StringLen As Long) As Long

Declare Function pams_encode_array Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Any, ArrayLen As Long) As Long

Declare Function pams_exit Lib "dmq.dll" () As Long

Declare Function pams_extract_buffer Lib "dmq.dll" (MsgHandle As PamsHandle, Buffer As Any, BuffLen As Long, MsgLength As Long) As Long

Declare Function pams_get_msg Lib "dmq.dll" (MsgArea As Any, Priority As Byte, Source As QAddress, Class As Integer, MsgType As Integer, MsgAreaLen As Integer, LenData As Integer, SelFilter As Long, PSB As PSB, ShowBuff As ShowBuffer, ShowBuffLen As Long, LargeAreaLen As Long, LargeSize As Long, NullArg1 As Any) As Long

Declare Function pams_get_msgw Lib "dmq.dll" (MsgArea As Any, Priority As Byte, Source As QAddress, Class As Integer, MsgType As Integer, MsgAreaLen As Integer, LenData As Integer, timeout As Long, SelFilter As Long, PSB As PSB, ShowBuff As ShowBuffer, ShowBuffLen As Long, LargeAreaLen As Long, LargeSize As Long, NullArg1 As Any) As Long

Declare Function pams_insert_buffer Lib "dmq.dll" (MsgHandle As PamsHandle, Buffer As Byte, BuffLen As Long) As Long

Declare Function pams_locate_q Lib "dmq.dll" (ByVal QName As String, QNameLen As Long, QAddrFound As QAddress, WaitMode As Long, RequestId As Long, RespQ As QAddress, NameSpaceList As Any, NameSpaceListLen As Long, timeout As Long) As Long

Declare Function pams_msg_length Lib "dmq.dll" (MsgHandle As PamsHandle, MsgLength As Long) As Long

Declare Function pams_next_msg_field Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, FieldLen As Long) As Long

Declare Function pams_put_msg Lib "dmq.dll" (MsgArea As Any, Priority As Byte, Target As QAddress, Class As Integer, MsgType As Integer, Delivery As Byte, MsgSize As Integer, timeout As Long, PSB As PSB, UMA As Byte, RespQ As QAddress, LargeSize As Long, NullArg1 As Any, NullArg2 As Any) As Long

Declare Function pams_remove_encoding Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Flags As Long) As Long

Declare Function pams_set_msg_position Lib "dmq.dll" (MsgHandle As PamsHandle, Tag As Long, Flags As Long) As Long

Declare Function pams_set_select Lib "dmq.dll" (SelectionArray As SelectionRecord, NumMasks As Integer, IndexHandle As Long) As Long

Declare Function pams_set_timer Lib "dmq.dll" (TimerId As Long, TimeFormat As Integer, P_Timeout As Long, S_Timeout As Long) As Long

Declare Function pams_status_text Lib "dmq.dll" (StatusCode As Long, severity As Long, ByVal StatusText As String, buflen As Long, retlen As Long) As Long

Declare Function putil_show_pending Lib "dmq.dll" (QueueCountArray As Long, InQueueList As Integer, OutPendingList As Long) As Long

#Else ' Using the MessageQ Client

Declare Function pams_attach_q Lib "dmqcl32.dll" (AttachMode As Long, QAttached As QAddress, QType As Long, ByVal QName As String, QNameLen As Long, NameSpaceList As Any, NameSpaceListLen As Long, timeout As Long, NullArg1 As Any, NullArg2 As Any) As Long

Declare Function pams_bind_q Lib "dmqcl32.dll" (QAttach As QAddress, ByVal QName As String, QNameLen As Long, NameSpaceList As Any, NameSpaceListLen As Long, timeout As Long, NullArg1 As Any) As Long

Declare Function pams_cancel_select Lib "dmqcl32.dll" (IndexHandle As Long) As Long

Declare Function pams_cancel_timer Lib "dmqcl32.dll" (TimerId As Long) As Long

Declare Function pams_confirm_msg Lib "dmqcl32.dll" (SeqNumber As MsgSeqNumberType, ConfirmStatus As Long, ForceJ As Byte) As Long

Declare Function pams_create_handle Lib "dmqcl32.dll" (MsgHandle As PamsHandle, HandleType As Long) As Long

Declare Function pams_decode_int8 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_decode_uint8 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_decode_int16 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_decode_uint16 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_decode_int32 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_decode_uint32 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_decode_int64 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_decode_uint64 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_decode_float Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Single) As Long

Declare Function pams_decode_double Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Double) As Long

Declare Function pams_decode_string Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Any, BuffLen As Long, StringLen As Long) As Long

Declare Function pams_decode_array Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Any, BuffLen As Long, NumElements As Long) As Long

Declare Function pams_decode_qid Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As QAddress) As Long

Declare Function pams_delete_handle Lib "dmqcl32.dll" (MsgHandle As PamsHandle) As Long

Declare Function pams_detach_q Lib "dmqcl32.dll" (QDettach As QAddress, OptionList As Long, OptionListLen As Long, MsgsFlushed As Long) As Long

Declare Function pams_encode_int8 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_encode_uint8 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Byte) As Long

Declare Function pams_encode_int16 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_encode_uint16 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Integer) As Long

Declare Function pams_encode_int32 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_encode_uint32 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Long) As Long

Declare Function pams_encode_int64 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_encode_uint64 Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Int64) As Long

Declare Function pams_encode_float Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Single) As Long

Declare Function pams_encode_double Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Double) As Long

Declare Function pams_encode_qid Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As QAddress) As Long

Declare Function pams_encode_string Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, ByVal Value As String, StringLen As Long) As Long

Declare Function pams_encode_array Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Value As Any, ArrayLen As Long) As Long

Declare Function pams_exit Lib "dmqcl32.dll" () As Long

Declare Function pams_extract_buffer Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Buffer As Any, BuffLen As Long, MsgLength As Long) As Long

Declare Function pams_get_msg Lib "dmqcl32.dll" (MsgArea As Any, Priority As Byte, Source As QAddress, Class As Integer, MsgType As Integer, MsgAreaLen As Integer, LenData As Integer, SelFilter As Long, PSB As PSB, ShowBuff As ShowBuffer, ShowBuffLen As Long, LargeAreaLen As Long, LargeSize As Long, NullArg1 As Any) As Long

Declare Function pams_get_msgw Lib "dmqcl32.dll" (MsgArea As Any, Priority As Byte, Source As QAddress, Class As Integer, MsgType As Integer, MsgAreaLen As Integer, LenData As Integer, timeout As Long, SelFilter As Long, PSB As PSB, ShowBuff As ShowBuffer, ShowBuffLen As Long, LargeAreaLen As Long, LargeSize As Long, NullArg1 As Any) As Long

Declare Function pams_insert_buffer Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Buffer As Byte, BuffLen As Long) As Long

Declare Function pams_locate_q Lib "dmqcl32.dll" (ByVal QName As String, QNameLen As Long, QAddrFound As QAddress, WaitMode As Long, RequestId As Long, RespQ As QAddress, NameSpaceList As Any, NameSpaceListLen As Long, timeout As Long) As Long

Declare Function pams_msg_length Lib "dmqcl32.dll" (MsgHandle As PamsHandle, MsgLength As Long) As Long

Declare Function pams_next_msg_field Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, FieldLen As Long) As Long

Declare Function pams_put_msg Lib "dmqcl32.dll" (MsgArea As Any, Priority As Byte, Target As QAddress, Class As Integer, MsgType As Integer, Delivery As Byte, MsgSize As Integer, timeout As Long, PSB As PSB, UMA As Byte, RespQ As QAddress, LargeSize As Long, NullArg1 As Any, NullArg2 As Any) As Long

Declare Function pams_remove_encoding Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Flags As Long) As Long

Declare Function pams_set_msg_position Lib "dmqcl32.dll" (MsgHandle As PamsHandle, Tag As Long, Flags As Long) As Long

Declare Function pams_set_select Lib "dmqcl32.dll" (SelectionArray As SelectionRecord, NumMasks As Integer, IndexHandle As Long) As Long

Declare Function pams_set_timer Lib "dmqcl32.dll" (TimerId As Long, TimeFormat As Integer, P_Timeout As Long, S_Timeout As Long) As Long

Declare Function pams_status_text Lib "dmqcl32.dll" (StatusCode As Long, severity As Long, ByVal StatusText As String, buflen As Long, retlen As Long) As Long

Declare Function putil_show_pending Lib "dmqcl32.dll" (QueueCountArray As Long, InQueueList As Integer, OutPendingList As Long) As Long

#End If
----------

DMQVB (dmqvb.bas)

2010-02-11T00:18:00.000-08:00

The first of two sample files, copied from the examples provided with Bea Message Q installation...

----------
'
' Global Variables
'
Global PutMsg As DmqMsgT
Global GetMsg As DmqMsgT
Global MyQueue As QAddress

Global DmqAttached As Integer

'
' DmqAttachQ
'
' Attach to the DMQ message bus using a temporary queue
'
'
'
Function DmqAttachQ() As Long
Dim status As Long
Dim attach_mode As Long
Dim q_type As Long
Dim q_name As String * 10
Dim q_name_len As Long
Dim name_space_list(2) As Long
Dim nsl_len As Long
Dim timeout As Long
'
' Set attach parameters
'
attach_mode = PSYM_ATTACH_TEMPORARY
q_type = PSYM_ATTACH_PQ
q_name = ""
q_name_len = 0
nsl_len = 0
timeout = 0

MyQueue.Group = 0
MyQueue.Queue = 0

status = pams_attach_q(attach_mode, MyQueue, q_type, q_name, q_name_len, name_space_list(0), nsl_len, timeout, ByVal 0&, ByVal 0&)

DmqAttachQ = status

End Function

'
' DmqExit
'
' Exit from the DMQ bus
'
Function DmqExit()
DmqExit = pams_exit()
End Function

'
' DmqGetMsg
'
' Receive a DmqMsgT message if one is available
'
'
Function DmqGetMsg(Msg As DmqMsgT, MsgArea As String) As Long
Dim status As Long
Static show_buffer As ShowBuffer
Dim show_bufflen As Long
Dim large_area_len As Long
Dim large_size As Long

show_bufflen = SHOW_BUFFER_LEN
large_area_len = 0

status = pams_get_msg(ByVal MsgArea, Msg.Priority, Msg.SrcTarget, Msg.Class, Msg.Type, Msg.MsgAreaSize, Msg.MsgLen, Msg.SelFilter, Msg.PSB, show_buffer, show_bufflen, large_area_len, large_size, ByVal 0&)

DmqGetMsg = status

End Function

'
' DmqGetMsgW
'
' Receive a DmqMsgT message if one is available
'
'
Function DmqGetMsgW(Msg As DmqMsgT, MsgArea As String) As Long
Dim status As Long
Static show_buffer As ShowBuffer
Dim show_bufflen As Long
Dim large_area_len As Long
Dim large_size As Long

show_bufflen = SHOW_BUFFER_LEN
large_area_len = 0

status = pams_get_msgw(ByVal MsgArea, Msg.Priority, Msg.SrcTarget, Msg.Class, Msg.Type, Msg.MsgAreaSize, Msg.MsgLen, Msg.timeout, Msg.SelFilter, Msg.PSB, show_buffer, show_bufflen, large_area_len, large_size, ByVal 0&)

DmqGetMsgW = status

End Function

'
' DmqPutMsg
'
' Send a DmqMsgT to the target queue
'
'
Function DmqPutMsg(Msg As DmqMsgT, MsgArea As String) As Long
Dim status As Long
Dim large_size As Long

large_size = 0

status = pams_put_msg(ByVal MsgArea, Msg.Priority, Msg.SrcTarget, Msg.Class, Msg.Type, Msg.Delivery, Msg.MsgAreaSize, Msg.timeout, Msg.PSB, Msg.UMA, Msg.RespQ, large_size, ByVal 0&, ByVal 0&)

DmqPutMsg = status

End Function

'
' DmqStatusText
'
' Converts a DmQ status code into a descriptive string
'
Function DmqStatusText(Code As Long) As String
Dim status As Long
Dim severity As Long ' Receives severity code
Dim msg_text As String * 4096 ' Receives message text (original = 256, changed to 512)
Dim buflen As Long ' Size of string for message
Dim retlen As Long ' Length of returned message

buflen = Len(msg_text)
status = pams_status_text(Code, severity, msg_text, buflen, retlen)

If Not status = PAMS__FAILED Then
DmqStatusText = msg_text
Else
DmqStatusText = "DmqStatusText failed!"
End If

End Function
----------

frmMain, frmGetCPflowList.frm

2010-02-11T00:13:00.000-08:00

This is the main form code:

----------
Dim PROMIS_LOGIN As String
Dim QueryStatus As String
Dim sCommand As String
Dim sQueue As String
Dim thisActivePrcdID As String
Const username As String = "STATSAPP"
Const password As String = "STATSAPP"
Const PROMIS_HEADER As String = "1C"
Const PROMIS_HEADER_SIZE As Integer = 8
Const PROMIS_COMMAND_SIZE As Integer = 40
Dim PipeIndex As Integer
Dim IntStr As String
Dim IntStr2 As String
Dim myCurrPinsDataSet(300, 7) As String

Private Sub btnGetFlowListing_Click()
txtStatus0.Text = ""
txtStatus0a.Text = ""
lblTPQuery0 = ""
txtStatus1.Text = ""
lblTPQuery2 = ""
txtStatus2.Text = ""
lblTPQuery3 = ""
txtStatus3.Text = ""
lblTPQuery4 = ""
txtStatus4.Text = ""
Me.lblPinsCount = "Pins Count: "
GetPinsData (Me.tbxCallProcName.Text)
End Sub

Private Sub Form_Load()
Dim status As Long
' Always call pams_exit on startup. This avoids
' leaving open connections if the app is stopped
' from VB run-mode without detaching.
'
status = pams_exit()

#If MessageQ_Server Then
txtStatus1.Text = "MessageQ Server environment"
#Else
txtStatus1.Text = "MessageQ Client environment"
#End If
End Sub

Function GetPinsData(ByVal myProcName As String) As Integer
Dim status As Long
Dim ReturnedData As Integer
'
GetPins500Series = 0
ReturnedData = 0
' attach Q
status = DmqAttachQ()
If (status <> 1) Then
' error attaching Q
txtStatus1.Text = "Error attaching Q"
Else
' means status is OK
' put msg
' query: "GetActivePrVersion"
QueryStatus = ""
Sleep (100)
Call PutMsg4(myProcName, "GetActivePrVersion", lblTPQuery0)
' get Msg
Sleep (100)
QueryStatus = GetMsg4(txtStatus0a)
' assign a default value for the Prcd Name
thisActivePrcdID = myProcName
' process the data
If (InStr(QueryStatus, "SUCCESS") > 0) Then
ReturnedData = Me.CleanSingleColumnTPResult(QueryStatus, txtStatus0)
If (ReturnedData > 0) Then
lblPrcdID = "PrcdID: " & txtStatus0.Text
thisActivePrcdID = txtStatus0.Text
Else
thisActivePrcdID = myProcName
End If
End If
' put Msg
' query: "CheckProdStatus"
QueryStatus = ""
Sleep (100)
Call PutMsg4(thisActivePrcdID, "CheckProdStatus", lblTPQuery2)
' get Msg
Sleep (100)
QueryStatus = GetMsg4(txtStatus2)
' put Msg
' query: "GetPins500Series"
QueryStatus = ""
Sleep (200) ' safe number, especially when the # of rows is increasing
Call PutMsg4(thisActivePrcdID, "GetPins500Series", lblTPQuery3)
' get Msg
Sleep (300) ' safe number, especially when the # of rows is increasing
QueryStatus = GetMsg4(txtStatus3)
' put Msg
' query: "GetFullPINSSet"
QueryStatus = ""
Sleep (400) ' safe number, especially when the # of rows is increasing
Call PutMsg4(thisActivePrcdID, "GetFullPINSSet", lblTPQuery4)
' get Msg
Sleep (500) ' safe number, especially when the # of rows is increasing
QueryStatus = GetMsg4(txtStatus4)
' process the data
If (InStr(QueryStatus, "SUCCESS") > 0) Then
GetPinsData = CleanCurrPinsDataSet(QueryStatus, txtStatus1)
If (GetPinsData > 0) Then
' show the full data set
'MsgBox ("Number of PINS is " & GetPinsData)
Me.lblPinsCount = "Pins Count: " & GetPinsData
End If
End If
End If
' detach Q, whether failed or succeeded
DmqExit
' clean up the msg, and return how many are captured
End Function

Sub PutMsg4(ByVal DataBuffer As String, ByVal ComType As String, ByVal thisLabel As Label)
Dim status As Long
Dim MsgArea As String * 4096

PutMsg.SrcTarget.Group = 1
PutMsg.SrcTarget.Queue = 4
PutMsg.Class = 0
PutMsg.Type = 0
PutMsg.timeout = 60000
PutMsg.MsgAreaSize = Len(MsgArea)

MsgArea = Compose1(DataBuffer, ComType)
thisLabel = MsgArea

status = DmqPutMsg(PutMsg, MsgArea)
End Sub

Function GetMsg4(ByVal thisControl As TextBox) As String
Dim status As Long
Dim MsgArea As String * 8192
thisControl.Text = ""
GetMsg.timeout = 900
GetMsg.MsgAreaSize = Len(MsgArea)
status = DmqGetMsg(GetMsg, MsgArea)
If (status = PAMS__NOMOREMSG) Then
thisControl.Text = thisControl.Name + ": " + DmqStatusText(status)
ElseIf (status = PAMS__SUCCESS) Then
thisControl.Text = thisControl.Name + ": " + MsgArea
Else
thisControl.Text = thisControl.Name + ": " + "GetMsg status: " + DmqStatusText(status)
End If
GetMsg4 = MsgArea
End Function

Function Compose1(ByVal DataBuffer As String, ByVal ComType As String) As String
PROMIS_LOGIN = "USERID " + username + "|PWD " + password + "|"
Compose1 = ""
Select Case ComType
Case "GetActivePrVersion"
VarProds = "LOWID " & DataBuffer & "|HIGHID " & DataBuffer & "|"
sCommand = "PROPRCD_LIST"
sQueue = VarProds + "FROM PRCDSET|" & _
"WHERE PRODSTATUS EQ 'A' AND ACTIVEFLAG EQ 'A'|" & _
"SHOW EXTERN(PRCDID)|"
Case "GetPins500Series"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_INSTRUCTIONS"
sQueue = VarProds + "NUMBERINSTRUCTIONS 100|FROM PINSSET|" & _
"WHERE (PINSINSTNUM GE '500.000' AND PINSINSTNUM LT '595.000')|" & _
"SHOW PINSINSTNUM|SHOW INSTTYPE|SHOW STAGE|SHOW EXECUTERECPID|" & _
"SHOW LOCATIONID|SHOW CALLPRCDID|"
Case "GetFullPINSSet"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_INSTRUCTIONS"
sQueue = VarProds + "NUMBERINSTRUCTIONS 300|FROM PINSSET|" & _
"SHOW PINSINSTNUM|SHOW INSTTYPE|SHOW EXECUTERECPID|SHOW STAGE|" & _
"SHOW LOCATIONID|SHOW CALLPRCDID|"
Case "CheckProdStatus"
VarProds = "PRCDID " + DataBuffer + "|"
sCommand = "PROPRCD_GETPRCD_HEADER"
sQueue = VarProds + "SHOW PRCD.PRODSTATUS|"
End Select
Compose1 = Me.FormQuery(sCommand, sQueue)
End Function

Public Function FormQuery(ByVal sCommand As String, ByVal sQueue As String) As String
FormQuery = PROMIS_HEADER & Space(PROMIS_HEADER_SIZE - Len(PROMIS_HEADER)) & _
Trim(sCommand) & Space(PROMIS_COMMAND_SIZE - Len(Trim(sCommand))) & _
"|" & PROMIS_LOGIN & sQueue & "END|"
End Function

Public Function CleanSingleColumnTPResult(ByVal thisReplyMsg As String, ByVal thisTextBox As TextBox) As Integer
Dim thisBuffer As String
Dim thisCntr As Integer
thisBuffer = ""
thisCntr = 0
CleanSingleColumnTPResult = 0
thisTextBox.Text = ""
'
PipeIndex = InStr(1, thisReplyMsg, "|")
IntStr = Right(thisReplyMsg, (Len(thisReplyMsg)) - PipeIndex)
PipeIndex = InStr(1, IntStr, "|")
thisCntr = Left(IntStr, (PipeIndex - 1))
'
If (thisCntr <> "0") Then
For i = 0 To (thisCntr - 1)
IntStr2 = Right(IntStr, (Len(IntStr)) - PipeIndex)
PipeIndex = InStr(1, IntStr2, "|")
thisBuffer = Left(IntStr2, PipeIndex - 1)
IntStr = IntStr2
myCurrPinsDataSet(i, 0) = thisBuffer
thisTextBox.Text = thisBuffer
Next
CleanSingleColumnTPResult = thisCntr
Else
CleanSingleColumnTPResult = 0
End If
End Function

Public Function CleanCurrPinsDataSet(ByVal thisReplyMsg As String, ByVal thisTextBox As TextBox) As Integer
Dim thisBuffer As String
Dim thisCntr As Integer
thisBuffer = ""
thisCntr = 0
CleanCurrPinsDataSet = 0
thisTextBox.Text = ""
'
PipeIndex = InStr(1, thisReplyMsg, "|")
IntStr = Right(thisReplyMsg, (Len(thisReplyMsg)) - PipeIndex)
PipeIndex = InStr(1, IntStr, "|")
thisCntr = Left(IntStr, (PipeIndex - 1))
'
If (thisCntr <> "0") Then
For i = 0 To (thisCntr - 1)
For j = 0 To 5
IntStr2 = Right(IntStr, (Len(IntStr)) - PipeIndex)
PipeIndex = InStr(1, IntStr2, "|")
thisBuffer = Left(IntStr2, PipeIndex - 1)
IntStr = IntStr2
If (j = 0) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 1) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 2) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 3) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 4) Then
myCurrPinsDataSet(i, j) = thisBuffer
ElseIf (j = 5) Then
myCurrPinsDataSet(i, j) = thisBuffer
End If
Next
Next
CleanCurrPinsDataSet = thisCntr
' do the textbox population here, so main code is clean
' current data set:
' 0 - Inst Num (7 chars, into 8)
' 1 - Inst Type (2 chars, into 3)
' 2 - Exec Recipe (5 chars, into 6)
' 3 - Stage (max 10 chars, into 11)
' 4 - LocationID (max 10 chars, into 11)
' 5 - Call Prcd (max 32 chars, into 33)
Dim tmpPinsBfr As String
' assign the header in the Textbox
thisTextBox.Text = "InstNum -Ityp -Recipe - StageID - LocationID - Call Procedure Name " & vbCrLf & _
"======= -==== -====== - ======= - ========== - =================== " & vbCrLf
For i = 0 To (thisCntr - 1)
For j = 0 To 5
If (j = 0) Then
thisTextBox.Text = thisTextBox.Text & myCurrPinsDataSet(i, j)
ElseIf (j = 1) Then
thisTextBox.Text = thisTextBox.Text & " - " & myCurrPinsDataSet(i, j)
ElseIf (j = 2) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(6 - Len(tmpPinsBfr))
ElseIf (j = 3) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(11 - Len(tmpPinsBfr))
ElseIf (j = 4) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(11 - Len(tmpPinsBfr))
ElseIf (j = 5) Then
tmpPinsBfr = myCurrPinsDataSet(i, j)
If (tmpPinsBfr = "") Then tmpPinsBfr = "Undef"
thisTextBox.Text = thisTextBox.Text & " - " & tmpPinsBfr & Space(33 - Len(tmpPinsBfr)) & vbCrLf
End If
Next
Next
Else
CleanCurrPinsDataSet = 0
End If
End Function
----------

TP Query in VB6 - Main Form - populated

2010-02-11T00:12:00.000-08:00

This is how the form looks like when the query is run...

TP Query in VB6 - Main Form

2010-02-11T00:09:00.001-08:00

This is the Main Form, since a file can't be attached...

PROMIS TP Query written in VB6

2010-02-10T22:45:00.000-08:00

Image via Wikipedia

After migrating all of my codes from VB6 to VB .NET 2003, then to VB .NET 2005, I now find that many of the 'complex' apps that are used in our company are never migrated over.

I learned that many of the libraries that were passed over by software vendors didn't include the source codes, so that tied up those applications to VB6 legacy.

Anyway, here's the real headache that I faced:

I had many process flows created that extended beyond the limit 'imposed' by that old code, which is 50 rows max, even if you specify a number higher than that in the code provided. So I was asking, why was that provision there, when it doesn't work in the first place? An empty promise, eh?

Anyway, no use asking why. So I said, I'll try to work out something from scratch.

So I did. I don't know where to begin, but I remembered that many, many years ago, when I started working on my very first codes using TP Query in VB6 platform, I did the same thing: take the example from the DMQ installation.

I did just that, but then, I never thought that I have completely forgotten VB6 coding. So I was paralyzed in all extremities. Cannot move, even an inch.

But a step has to be made, or at least, I know what I wanted to do: a simple form, bare-simple, and a simple code, stripped of complexities. just to make the code work by extending the number of rows that will be captured.

And then again, when I started working on VB6, I always asked my colleagues in the main IT line, and it is not for free. It is a sort of "quid pro quo" thing. I give, I take. I help you now, you help me later. It is always a bilateral interaction.

So even with the simplest line of code, I have to admit that I've no more knowledge of VB6 code. After trying out and copying from VB .NET codes, I find that these don't work, or that the syntax is already different, I called up my counterpart in IT, who is supposedly the recipient of this code I am working on. Thankfully enough, he is very patient to answer my lowdown questions.

I got my piece of code working bit by bit, and I was able to proceed step by step.

Then came another road block. I managed to get up to 100 rows, but no more. For 3 days I dwelt on the same problem, changing parts of the code here and there, enlarging string definitions, as I was thinking that maybe, it cannot take the large chunk of data being returned, etc., etc.

No progress.

In desperation, I fired a mail to the nearest PROMIS Support Team, and that confirmed my guess immediately! What was it about? That the 100 rows is a site-setting parameter. And the guy right away provided the steps and procedure to extend that limit.

Our system administrator immediately tried it out. There were some snags, and since it was Friday, we agreed to continue by next week. We don't want nobody to be spoiling their weekend, eh.

Came the awaited Monday (that was 8th-Feb-2010), and I was caught up in a number of items needing my attention. And I just saw the notification mail that the admin guy sent out, telling that he succeeded in setting the limit from 100 to 300. Right there and then I dropped what I'm doing, and dug up my code, changed also the limit from 100 to 300, and voila! It worked!

And for me to have a copy of that code, I'm putting it here. I actually searched high and low on my archive files, in all of the 4 PCs that I am using at work, and I wasn't fortunate to find my old VB6 codes. I have those samples that are downloadable, even those that I asked as samples from our IT team before, but they don't give a workable solution - so that made me creating a new set of codes.

And now that I have done it (again) after a long, long time, I'm keeping it here, for reference in the future, or for anybody who may need it.

To note: when the data being sent (Putmsg) or received (Getmsg) is getting bigger, the size of the string should be adjusted accordingly. I was trying String * 256 at first, then I'm getting that the data is bigger than the buffer, so I progressively changed that to 512, 1024, 2048, and so on.
What I now have that worked even with the longest process flow is Putmsg MsgArea String * 4096, and Metmsg MsgArea String * 8192 definitions.

Happy coding (once again) in VB6.

Ice breaker!

2009-04-26T21:04:00.000-07:00

Haven't got my thoughts assembled in the past month, so I'm just breaking the silence. Will be posting soon!

What is PROMIS?

2009-03-27T23:20:00.001-07:00

PROMIS is an acronym that stand for PROcess Manufacturing Integration System. It is basically a shopfloor control system.

It is written primarily using Fortran, and was initially lauched running in VAX platform, and later on, a separate version was created to run in Unix.

Being text-based, it was fast and efficient, and since it was introduced while every computer program was running in DOS mode, that wasn't a problem - it was the norm.

However, with the introduction of Windows-based computing, this text-based computing was losing appeal. By then, Promis (the company) was already brewing something to catch up.

Windows-like user interfaces were presented to replace the text-based interactive session windows, for used by Manufacturing folks, and even for keyusers, who define the mainstream flow and devices in PROMIS, were given a GUI, again, to replace the text-based windows session.

But what's the price to pay?

These are all add-on to the currently existing system, and is not really a breakthrough, so many of the people already "used" to the text-based mode were resistant to embrace the GUIs, especially for the management folks, who knew that there is not really a significant improvement in other parts of the system. It is sugar-coating, in some ways.

But there are those who have taken advantage of starting off the PROMIS and using the GUIs - from the start. They have deemed that using GUI-based user interfaces when everything else is GUI-based makes sense.

There is really nothing wrong if you use text-based interface, or GUI-based interface. It is, to some point, already your preference. That is the case to me, since I started computing when DOS was the only prevaling operating system (I mean, for PC). But to the management folks, this spells out money, and they would usually go for less expenses when the job can be done just the same.

PROMIS is mostly suitable to wafer fabrication manufacturing, or for factories that manufacture medicines, and the likes.

When applied to backend semiconductor manufacturing, there are areas where it is always grey, where the implementation and customization is dependent on site requirements. So although PROMIS is a canned software that can be used straight from the box, there is a certain degree to which it can be "tweaked" or customized, per site, or, per implementing company.

Aside from the system management team (purel IT jobs), a group of keyusers, or main users, is a must who will be tasked to define the building blocks of the system, the knowledge and skillset of which is a hybrid of end-users and IT folks.

I belong once to the system management, but I am currently with the keyuser team. I serve my team (and company) better this way.

So that is PROMIS in its introduction. I will be back discussing scripts and techniques on scripting in PROMIS. This will touch on a bit of VAX scripting, the platform that I am using for abou 15 years now.

Leave a comment, a question, or a clarification. I'd love to hear from you.

Till then.