up1037.htm
		nRows = Extract(sResponse, 2)
		'UPGRADE_WARNING: Couldn't resolve default property of object Extract(sResponse, 6). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		sModifierPairs = "�" & Extract(sResponse, 6) & "�"
		'
		ReDim saQSpecs(nCols)
		'Work through the columns taking specs from SelectResult row zero
		For iC = 1 To nCols
			'UPGRADE_WARNING: Couldn't resolve default property of object SelectResult(iC, 0). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
			s = SelectResult(iC, 0)
			saQSpecs(iC) = "A" & "�" & iC & "�" & Field(s, Chr(250), 1) & "����" & Field(s, Chr(250), 3) & "��" & Left(Field(s, Chr(250), 2), 1) & "�" & Mid(Field(s, Chr(250), 2), 2)
			'Modifiers
			iPos = InStr(1, sModifierPairs, "�TOTAL�" & sIdDict & "�", 1)
			If iPos > 1 Then
				saQSpecs(iC) = RReplace(saQSpecs(iC), 4, "T�")
				bTotal = True
			End If
			iPos = InStr(1, sModifierPairs, "�BREAK-ON�" & sIdDict & "�", 1)
			If iPos > 1 Then
				saQSpecs(iC) = RReplace(saQSpecs(iC), 5, "B�")
				'020409 Note for now, sub-total row labels are ignored, in future
				'can do something like: iPos = Instr(iPos, "�", sModifierPairs)
				'-- bBreak = True 'change to flag only if sub-total rows generated
			End If
			'020409 JPC old TOTAL code, DELE
			'If Locate(siddict, "IN", Extract(sResponse, 6), "SETTING", iPos) Then
			'    If Extract(sResponse, 6, iPos - 1) = "TOTAL" Then
			'        saQSpecs(iC) = RReplace(saQSpecs(iC), 4, "T�")
			'    End If
			'    bTotal = True
			'End If
		Next iC
		'
		'Begin building output
		SB = New StringBuilder
		If sDelimiter = "HTML" Then
			Call SB.Append("<table border=1 bordercolor=""#f0f0f0"" cellspacing=0 cellpadding=1 style=""background-Color:white;font-family:arial;font-size:12px"">" & ControlChars.CrLf)
			Call SB.Append("<tr style=""background-color:navy;color:white;font-weight:bold"">" & ControlChars.CrLf)
		End If
		'
		'Check PX.BACKSRV, it ALWAYS returns column 0 as ITEMID with identifier "<&Q-COLS>"
		'
		'If InStr(1, Extract(sResponse, 5), "ID-SUPP", 1) = 0 Then
		If sDelimiter = "HTML" Then
			Call SB.Append("<td width=15%>ItemID</td>" & ControlChars.CrLf)
		Else
			Call SB.Append("ItemID�L�15")
		End If
		nID = 1
		'End If
		ReDim saAlign(nCols - 1 + nID)
		ReDim saRow(nCols - 1 + nID)
		ReDim sBreakMonitor(nCols)
		Dim currTotals(nCols, 1) As Decimal '2nd dimension is sub-totalling for BREAK-ON
		'
		'use DictItems (array saQSpecs) to format output header
		For i = 1 To nCols
			'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(i), 10). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
			nWidth = Val(Extract(saQSpecs(i), 10))
			'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(i), 9). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
			saAlign(i - 1 + nID) = Extract(saQSpecs(i), 9)
			If nWidth = 0 Then nWidth = 10
			If sDelimiter = "HTML" Then
				'020222 JPC note the multivalue level argument 1 for HTML
				'so we avoid use of "====" in headings like "ST�===="
				'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(i), 3, 1). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				Call SB.Append("<td valign=top style=""width:" & nWidth & "%"">" & Extract(saQSpecs(i), 3, 1) & "</td>")
			Else
				If i > 1 Or nID = 1 Then
					Call SB.Append(sDelimiter)
				End If
				'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(i), 3). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				Call SB.Append(Replace(Extract(saQSpecs(i), 3), Chr(253), Chr(252)) & Chr(253) & saAlign(i - 1 + nID) & Chr(253) & nWidth)
			End If
		Next i
		If sDelimiter = "HTML" Then Call SB.Append("</tr>" & ControlChars.CrLf)
		'
		'Main data body of table
		i = 0
		Do 
			If i = nRows Then Exit Do
			i = i + 1
			'UPGRADE_WARNING: Couldn't resolve default property of object SelectResult(0, i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
			saRow(0) = SelectResult(0, i)
			nMV = 1
			bBreak = False
			For iC = 1 To nCols
				'020610
				'UPGRADE_WARNING: Couldn't resolve default property of object SelectResult(iC, i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				sQVal = SelectResult(iC, i)
				'020610 020225 JPC TOTAL
				If bTotal Then
					'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(iC), 4). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					If Extract(saQSpecs(iC), 4) = "T�" Then
						'UPGRADE_WARNING: Couldn't resolve default property of object DCount(sQVal, Chr(253)). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
						For iMV = 1 To DCount(sQVal, Chr(253))
							currTotals(iC, 0) = currTotals(iC, 0) + Val(sQVal)
							currTotals(iC, 1) = currTotals(iC, 1) + Val(sQVal)
						Next iMV
					End If
					'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(iC), 5). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					If Extract(saQSpecs(iC), 5) = "B�" Then
						If sQVal <> sBreakMonitor(iC) And i > 1 And Not bAlreadyBreak Then
							'Break effect goes here!
							bAlreadyBreak = True 'flag to avoid double break when 2 change together
							bBreak = True 'flag that sub-totals are activated so a final sub-total row is appropriate
							'Row with SUB-TOTALS
							If sDelimiter = "HTML" Then
								Call SB.Append("<tr style=font-weight:bold><td>SubTotal(s)</td>")
							Else
								Call SB.Append(ControlChars.Cr & "SubTotal(s)")
							End If
							For k = 1 To nCols - 1 + nID
								'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(k + 1 + nID * -1), 4). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
								If Extract(saQSpecs(k + 1 + (nID * -1)), 4) = "T�" Then
									s = CStr(currTotals(k + 1 + (nID * -1), 1))
									currTotals(k + 1 + (nID * -1), 1) = 0
									'020228 JPC apply formatting code, usually none or "MR2"
									'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(k + 1 + nID * -1), 7). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
									sTemp = Trim(Extract(saQSpecs(k + 1 + (nID * -1)), 7))
									If sTemp > "" Then
										'UPGRADE_WARNING: Couldn't resolve default property of object OConv(s, sTemp). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
										s = OConv(s, sTemp)
									End If
								Else
									s = ""
								End If
								If sDelimiter = "HTML" Then
									If s = "" Then s = "&nbsp;"
									If saAlign(k) = "R" Then
										Call SB.Append("<td align=right>" & s & "</td>")
									Else
										Call SB.Append("<td>" & s & "</td>")
									End If
								Else
									Call SB.Append(sDelimiter & s)
								End If
							Next k
							If sDelimiter = "HTML" Then Call SB.Append("</tr>" & ControlChars.CrLf)
						End If
						sBreakMonitor(iC) = sQVal
					End If
					'End of BREAK-ON handler
				End If
				'
				'Keep track of max number of multivalues nMV for expanding rows ...
				If InStr(sQVal, Chr(253)) Then
					'UPGRADE_WARNING: Couldn't resolve default property of object DCount(sQVal, Chr(253)). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					n = DCount(sQVal, Chr(253))
					If n > nMV Then nMV = n
				End If
				'Build this item
				saRow(iC - 1 + nID) = sQVal
			Next iC
			'One item read in and processed as saRow()
			'Now to format it
			For j = 1 To nMV
				'020222 JPC row is built initially in array saRow
				If sDelimiter = "HTML" Then
					'020223 JPC alternate items are yellow bg
					If i / 2 = i \ 2 Then s = "<tr>" Else s = "<tr style=""background-color:#ffffa0"">"
					Call SB.Append(s)
				Else
					Call SB.Append(ControlChars.Cr)
				End If
				For k = 0 To nCols - 1 + nID
					'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saRow(k), 1, j). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					s = Extract(saRow(k), 1, j)
					If sDelimiter = "HTML" Then
						If s = "" Then s = "&nbsp;"
						If saAlign(k) = "R" Then
							Call SB.Append("<td align=right>" & s & "</td>")
						Else
							Call SB.Append("<td>" & s & "</td>")
						End If
					ElseIf k > 0 Then 
						Call SB.Append(sDelimiter & s)
					Else
						Call SB.Append(s)
					End If
				Next k
			Next j
			'End of row
			If sDelimiter = "HTML" Then Call SB.Append("</tr>" & ControlChars.CrLf)
			'
			'020425 JPC comment-out this batch code handler, need FBF version
			'If i / 100 = i \ 100 Then
			'   gsHTMLWrite = "<BODY text=""#000066"" onload = ""document.forms[0].submit();return true"" >" _
			''   & "<form action=""pixie.asp"">" _
			''   & "<input type=hidden name=""w3hostname"" value="" >" _
			''   & "<input type=hidden name=""w3wpsessionid"" value=""P"" >" _
			''   & "<br><br><br><br><center><h1>Progress Counter: " & i & " / " & UserPort.SelectUbound(2) _
			''   & "</center></h1></form></body></html>"
			'   Call W3Input(s)
			'End If
			If nLimit > 0 Then
				If i >= nLimit Then
					'UPGRADE_WARNING: Couldn't resolve default property of object sAlert. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					sAlert = "Report cut short as it is over its reasonable display limit of " & nLimit & " items."
					Exit Do
				End If
			End If
		Loop 
		'Do final subtotals if BREAK is applicable and activated above
		If bBreak Then
			If sDelimiter = "HTML" Then
				Call SB.Append("<tr style=font-weight:bold><td>SubTotal(s)</td>")
			Else
				Call SB.Append(ControlChars.Cr & "SubTotal(s)")
			End If
			For k = 1 To nCols - 1 + nID
				'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(k + 1 + nID * -1), 4). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If Extract(saQSpecs(k + 1 + (nID * -1)), 4) = "T�" Then
					s = CStr(currTotals(k + 1 + (nID * -1), 1))
					currTotals(k + 1 + (nID * -1), 1) = 0
					'020228 JPC apply formatting code, usually none or "MR2"
					'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(k + 1 + nID * -1), 7). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					sTemp = Trim(Extract(saQSpecs(k + 1 + (nID * -1)), 7))
					If sTemp > "" Then
						'UPGRADE_WARNING: Couldn't resolve default property of object OConv(s, sTemp). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
						s = OConv(s, sTemp)
					End If
				Else
					s = ""
				End If
				If sDelimiter = "HTML" Then
					If s = "" Then s = "&nbsp;"
					If saAlign(k) = "R" Then
						Call SB.Append("<td align=right>" & s & "</td>")
					Else
						Call SB.Append("<td>" & s & "</td>")
					End If
				Else
					Call SB.Append(sDelimiter & s)
				End If
			Next k
			If sDelimiter = "HTML" Then Call SB.Append("</tr>" & ControlChars.CrLf)
			
		End If
		'Show totals
		If bTotal Then
			'blank Row
			If sDelimiter = "HTML" Then
				Call SB.Append("<tr style=font-weight:bold><td colspan=" & nCols + nID & ">Total(s)</td></tr>")
				Call SB.Append(ControlChars.CrLf & "<tr style=font-weight:bold>")
			Else
				Call SB.Append(ControlChars.Cr & "TOTAL(S)")
				For k = 1 To nCols - 1 + nID
					Call SB.Append(sDelimiter)
				Next k
				Call SB.Append(ControlChars.Cr)
			End If
			'
			'Row with TOTALS
			For k = 0 To nCols - 1 + nID
				'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(k + 1 + nID * -1), 4). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If Extract(saQSpecs(k + 1 + (nID * -1)), 4) = "T�" Then
					s = CStr(currTotals(k + 1 + (nID * -1), 0))
					'020228 JPC apply formatting code, usually none or "MR2"
					'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(k + 1 + nID * -1), 7). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					sTemp = Trim(Extract(saQSpecs(k + 1 + (nID * -1)), 7))
					If sTemp > "" Then
						'UPGRADE_WARNING: Couldn't resolve default property of object OConv(s, sTemp). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
						s = OConv(s, sTemp)
					End If
				Else
					s = ""
				End If
				If sDelimiter = "HTML" Then
					If s = "" Then s = "&nbsp;"
					If saAlign(k) = "R" Then
						Call SB.Append("<td align=right>" & s & "</td>")
					Else
						Call SB.Append("<td>" & s & "</td>")
					End If
				ElseIf k > 0 Then 
					Call SB.Append(sDelimiter & s)
				Else
					Call SB.Append(s)
				End If
			Next k
			If sDelimiter = "HTML" Then Call SB.Append("</tr>")
		End If
		'
		'Finish off this table
		If sDelimiter = "HTML" Then Call SB.Append("</table>")
		'UPGRADE_WARNING: Couldn't resolve default property of object sTable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		sTable = SB.toString
	End Function
	
	'011026 JPC
	Public Function SelectResult(ByRef i As Object, ByRef j As Object) As Object
		'UPGRADE_WARNING: Couldn't resolve default property of object UserPort.SelectResult(i, j). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		SelectResult = UserPort.SelectResult(i, j)
	End Function
	
	Public Function SelectUbound(ByRef i As Object) As Object
		'UPGRADE_WARNING: Couldn't resolve default property of object UserPort.SelectUbound(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		SelectUbound = UserPort.SelectUbound(i)
	End Function
	
	'020220 JPC add COUNT variable
	'010328 JPC add function READNEXT, <todo> <pm>
	Public Function ReadNext(ByRef ID As Object, Optional ByRef COUNT As Object = 0) As Boolean
		On Error GoTo Hell
		mnSelectResultIndex = mnSelectResultIndex + 1
		'UPGRADE_WARNING: Couldn't resolve default property of object COUNT. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		COUNT = mnSelectResultIndex
		'UPGRADE_WARNING: Couldn't resolve default property of object UserPort.SelectResult(0, mnSelectResultIndex). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		'UPGRADE_WARNING: Couldn't resolve default property of object ID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		ID = UserPort.SelectResult(0, mnSelectResultIndex)
		ReadNext = True
		Exit Function
		'
Hell: 
		ReadNext = False
	End Function
	
	Public Function RsOOpen(ByVal sQuery As String, ByRef rst As ADODB.Recordset) As Boolean
		RsOOpen = UserPort.RsOOpen(sQuery, rst)
	End Function
	
	Public Sub Mat(ByRef MatArray As Object, ByRef SetValue As Object, Optional ByVal FileVariable As String = "")
		'000308 JPC extend to 2-D arrays
		'000121 JPC matrix functions ...
		Dim j, i, iPos As Integer
		Dim dblSetValue As Object
		Dim sNumericAttributes As String
		Dim b2D As Boolean
		'
		'000309 JPC Are we 2-dimensional ?
		On Error Resume Next
		j = UBound(MatArray, 2)
		If Err.Number = 0 Then b2D = True
		On Error GoTo 0
		
		If IsNothing(SetValue) Then
			Erase MatArray
		ElseIf b2D Then 
			For i = LBound(MatArray, 1) To UBound(MatArray, 1)
				For j = LBound(MatArray, 2) To UBound(MatArray, 2)
					'UPGRADE_WARNING: Couldn't resolve default property of object SetValue. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					'UPGRADE_WARNING: Couldn't resolve default property of object MatArray(i, j). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					MatArray(i, j) = SetValue
				Next j
			Next i
		Else
			For i = LBound(MatArray) To UBound(MatArray)
				'UPGRADE_WARNING: Couldn't resolve default property of object SetValue. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				'UPGRADE_WARNING: Couldn't resolve default property of object MatArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				MatArray(i) = SetValue
			Next i
		End If
		'
	End Sub
	
	
	Public Function MatRead(ByRef ItemArray As Object, ByVal FileVariable As String, ByVal ItemID As String) As Boolean
		Dim sItem As String
		Dim n1, i, j, n2 As Integer
		Dim iPos, nUB As Integer
		Dim sAM As String
		'
		Dim b As Boolean
		sAM = Chr(254)
		nUB = UBound(ItemArray)
		'
		MatRead = UserPort.RRead(sItem, FileVariable, ItemID)
		If MatRead = False Then
			Erase ItemArray
			'Call Mat(ItemArray, "")
			Exit Function
		End If
		'
		'Avoid use of "Join" so we can make this VB5-compatible
		n2 = 0
		For i = 1 To nUB
			n1 = n2
			n2 = InStr(n1 + 1, sItem, sAM)
			If n2 = 0 Then
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				ItemArray(i) = Mid(sItem, n1 + 1)
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If ItemArray(i) = "" Then
					'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					ItemArray(i) = Nothing
				End If
				Exit For
			Else
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				ItemArray(i) = Mid(sItem, n1 + 1, n2 - n1 - 1)
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If ItemArray(i) = "" Then
					'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					ItemArray(i) = Nothing
				End If
			End If
		Next i
		If i < nUB Then
			For j = i + 1 To nUB
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(j). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				ItemArray(j) = Nothing
			Next j
		End If
	End Function
	
	
	
	Public Function MatReadU(ByRef ItemArray As Object, ByVal FileVariable As String, ByVal ItemID As String) As Boolean
		Dim sItem As String
		Dim n1, i, j, n2 As Integer
		Dim iPos, nUB As Integer
		Dim sAM As String
		Dim b As Boolean
		'
		sAM = Chr(254)
		nUB = UBound(ItemArray)
		'
		MatReadU = UserPort.RReadU(sItem, FileVariable, ItemID)
		If MatReadU = False Then
			Erase ItemArray
			'Call Mat(ItemArray, "")
			Exit Function
		End If
		'Avoid use of "Join" so we can make this VB5-compatible
		n2 = 0
		For i = 1 To nUB
			n1 = n2
			n2 = InStr(n1 + 1, sItem, sAM)
			If n2 = 0 Then
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				ItemArray(i) = Mid(sItem, n1 + 1)
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If ItemArray(i) = "" Then
					'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					ItemArray(i) = Nothing
				End If
				Exit For
			Else
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				ItemArray(i) = Mid(sItem, n1 + 1, n2 - n1 - 1)
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If ItemArray(i) = "" Then
					'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
					ItemArray(i) = Nothing
				End If
			End If
		Next i
		If i < nUB Then
			For j = i + 1 To nUB
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(j). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				ItemArray(j) = Nothing
			Next j
		End If
	End Function
	
	
	Public Function MatWrite(ByRef ItemArray As Object, ByVal FileVariable As String, ByVal ItemID As String) As Boolean
		Dim SB As StringBuilder
		Dim sItem As String
		Dim i As Integer
		Dim sAM As String
		Dim iLenItem, iItem, n As Integer
		'
		sAM = Chr(254)
		If MatWriteSafety Then
			For i = 1 To UBound(ItemArray)
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If InStr(ItemArray(i), sAM) Then
					Err.Raise(940,  , "MatWrite safety violation: attr " & i & " contains Chr(254).")
				End If
			Next i
		End If
		'
		'020221 JPC expt speed-up
		SB = New StringBuilder
		Call SB.Append(ItemArray(1))
		For i = 2 To UBound(ItemArray)
			Call SB.Append(sAM)
			Call SB.Append(ItemArray(i))
		Next i
		sItem = SB.toString
		'
		'020221 JPC expt speed-up ?
		'sItem = Join(ItemArray, sAM)
		'i = InStr(sItem, sAM)
		'If i = 0 Then
		'    sItem = ""
		'Else
		'    sItem = Mid$(sItem, i + 1)
		'End If
		'
		'concat code for VB5 support, use instead of above block if JOIN not supported
		'sItem = ItemArray(1)
		'For i = 2 To UBound(ItemArray)
		'    sItem = sItem & sAM & ItemArray(i)
		'Next i
		'
		MatWrite = UserPort.WWrite(sItem, FileVariable, ItemID)
	End Function
	
	
	Public Function MatWriteU(ByRef ItemArray As Object, ByVal FileVariable As String, ByVal ItemID As String) As Boolean
		Dim SB As StringBuilder
		Dim sItem As String
		Dim i As Integer
		Dim sAM As String
		'
		sAM = Chr(254)
		If MatWriteSafety Then
			For i = 1 To UBound(ItemArray)
				'UPGRADE_WARNING: Couldn't resolve default property of object ItemArray(i). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
				If InStr(ItemArray(i), sAM) Then
					Err.Raise(940,  , "MatWriteU safety violation: attr " & i & " contains Chr(254).")
				End If
			Next i
		End If
		'
		'020221 JPC expt speed-up
		SB = New StringBuilder
		Call SB.Append(ItemArray(1))
		For i = 2 To UBound(ItemArray)
			Call SB.Append(sAM)
			Call SB.Append(ItemArray(i))
		Next i
		sItem = SB.toString
		'
		'020221 JPC expt speed-up
		'sItem = Join(ItemArray, sAM)
		'i = InStr(sItem, sAM)
		'If i = 0 Then
		'    sItem = ""
		'Else
		'    sItem = Mid$(sItem, i + 1)
		'End If
		'
		'concat code for VB5 support, use instead of above block if JOIN not supported
		
		'sItem = ItemArray(1)
		'For i = 2 To UBound(ItemArray)
		'    sItem = sItem & sAM & ItemArray(i)
		'Next i
		MatWriteU = UserPort.WWriteU(sItem, FileVariable, ItemID)
	End Function
	
	'----------------------------------------------------
	Private Sub CORREL_PROCESS(ByRef sDictItem As String, ByRef sFVDict As String)
		'020302 JPC support process to pre-process some correlatives for batch query mode
		Dim sProcessCode As String
		Dim saC() As String
		Dim SVAL, sItem As String
		Dim i As Integer
		
		'UPGRADE_WARNING: Couldn't resolve default property of object Extract(sDictItem, 8). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
		sProcessCode = UCase(Extract(sDictItem, 8))
		If Left(sProcessCode, 1) = "A" And InStr(sProcessCode, "N(") Then
			'Handler for "an(aaaa):n(bbbb) --> CUSTOMA;AAAA;:;BBBBB
			sProcessCode = Replace(sProcessCode, ";", "")
			sProcessCode = Replace(sProcessCode, "N(", ";")
			sProcessCode = Replace(sProcessCode, ")", ";")
			If Right(sProcessCode, 1) = ";" Then sProcessCode = Left(sProcessCode, Len(sProcessCode) - 1)
			saC = Split(sProcessCode, ";")
			For i = 1 To UBound(saC)
				Select Case saC(i)
					Case ":", "+", "-", "/", "*", "^"
						'operator OK
					Case Else
						If RRead(sItem, sFVDict, saC(i)) Then
							'UPGRADE_WARNING: Couldn't resolve default property of object Extract(sItem, 2). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
							SVAL = Extract(sItem, 2)
							'UPGRADE_WARNING: Couldn't resolve default property of object Extract(sItem, 8). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
							'UPGRADE_WARNING: Couldn't resolve default property of object Extract(sItem, 7). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm
							If IsNumeric(SVAL) And Trim(Extract(sItem, 7)) = "" And Trim(Extract(sItem, 8)) = "" Then
								saC(i) = SVAL
							Else
								'can't proceed - handover to custom
								Exit Sub
							End If
						Else
							'can't proceed - handover to custom
							Exit Sub
						End If
				End Select
			Next i
			saC(0) = "CUSTOMA"
			sProcessCode = Join(saC, ";")
			sDictItem = RReplace(sDictItem, 8, sProcessCode)
		End If
	End Sub
	
	Public Function SSystem(ByVal n As Integer) As Object
		SSystem = ExecutePS("SYSTEM " & n)
	End Function
End Module'This is the model for all modules = files of convenient groupings of subroutines.
'You must have these first 3 lines, plus line 'Module ' followed by your module name,
'plus the line at the end .. 'End Module'
'Options are "Off" for emulating PICK and some other classical legacy systems.
'For new work, switching Explicit 'On' and possibly Strict 'On' as well, is appropriate
'depending on your programming style and preferences, and maybe your workplace policy too.  
'Refer Microsoft documentation and VB community websites for more about this.
'
Option Strict Off
Option Explicit Off
Imports Microsoft.VisualBasic
Module basTest

Public Sub Test1
'Simple test program you can use to test that this
'object is working, without any dependency on files
'
'Optional extra, use this kind of technique for wide-carriage
'bulk print dot-matrix printers etc.  You print direct-to-port
'like a traditional MV Server
'   Call ExecutePS("DEV-MAKE P 2 'Name of my dot matrix monster'")
'   Call ExecutePS("SP-ASSIGN 2 H")
'
'Call ExecutePS ("PRINTER ON")  'uncomment for printer test
'
'000804 JPC signal this is classical terminal
'       to speed up change of display mode
'       when working from VBGUI menu via "umenu"
Crt("<TERMINAL>")
'
Crt (TTag(-1))
Crt (TTag(0,0) & "Starting with function tests")
Crt ("Field(""aaa bbb ccc ddd"", "" "", 3) = " & Field("aaa bbb ccc ddd", " ", 3))
Crt ("DCount(""aaa bbb ccc ddd"", "" "") = " & DCount("aaa bbb ccc ddd", " "))
Crt (TTag(0, 7) & TTag(-39) & "Now in the test app, dotNet version.")
Crt (TTag(-40))
Crt (TTag(0, 9))
Crt ("App Starts - enter something! Enter 'x' to exit" & vbCrLf & "?")
Do
    IInput(s)
    Select Case UCase(Trim(s))
    Case "X", "OFF", "EXIT", "QUIT"
        Exit Do
    End Select
    i = i + 1
    'PPrint (s)  'uncomment for printer test
    Crt ("Echoing " & TTag(-37) & "'" & UCase$(s) & "'" & TTag(-40) & " at step " & i & vbCrLf & "?")
Loop
Crt ("Test1 ends, now returning to TCL")
'ExecutePS ("PRINTER CLOSE")  'uncomment for printer test

End Sub

End Module
	
MZ����@���	�!�
L�!This program cannot be run in DOS mode.

$PEL
�]�=�!
@ ~Z `@ �,ZO`��  H.text�: @ `.rsrc�`P@@.reloc�`@B`ZH@$�5
0"
�	{
9�	{
�	
o`**0"
�	(
�	 }�	}
*0

 �
  U� 
 ��  S�  :�  ��  o�  o�  N�  �� 	 �� 
 h�  Y�  m� 
 x�  (�  S�
(

�	{
o
�	t
}�	s
}*0t�	(
�	{:	�	(�s�
�	{t


o
}�	
}
�	{t

o
&�
�	(
�*
	`i

0��	(
�	{o

  <��	{o
t{
;k{
�	
t

o
 �_ ;G�	{o
�	{{o
 
=(�	}�	}8 
X?e����
�	(
�*
	��

0
�	(
�	�	
t
}*0��	(
�	{9X�	{o

  <8�	{o
t�	{{o
 
X?�����&��
�	(
�*
	kt
	v

0
�	o��	(
*BSJB

v1.0.3705`H%#~�%�	#Strings0/#GUID@/�#Blob
W?�	�
3
�t
�J
$<U
w	
����
�

�'
�7
�G
�Q
�e
�j
��
��
��
��
��
��
��
��!�-�KUh�}�������������


�



$
.�.
]

;-
_�X
a�]
a
h
��w
���
�
�
�
����
��

��

��

��
�
�

��
��
��
�
D$�
P(�d-�
w$	�
�(
�
�$�
�(�
�$
�
�$�
�5�
�5�
�9�
�A�
5�
5�
'G�
7$�GM�NR�m[�y[!��a#��g&��m(��r)��v)��}+���,���/���2���6��9��=��@��C�%�G�.�K�5�M�>�O�j9Y�r\�	�
\�	�]�	�^�	_�	D$`�	P(a�
d-b�	w$d�	�(e�	�$f�	�(g�	�$h�	�$i�	�5j�	�5k�	�9l�	�Ao�	
5q�	5r�	'Gs�	7$t�
GMu�
NRv�
m[z�
y[|�
�a~�
�g��
�m��
�r��
�v��
�}��
����
����
����
����
���
���
���
���
%���
.���
5���
>���
j9��
����
�������������F#G��
*���
@���
h���
{���
����
����
�$��
�(������!���B���Y���a
��{
���
���
��� 
���,
���6
���,
���?
���I
��I
��M
��9��"R
��+���?W
��F\
��Ja
��Qg
��Wg

�]m

�gs

�{y


�y

��

��m

���

�r
�	*�
�	@�
�	h�
�	{�
�	��
�	��
�	�$
�	�(
�
��
�
!�
�
B�#
�
Y�'
�
a
(
�
{
+
�
�
/
�
�
2
�
� 
3
�
�,
8
�
�6
>
�
�,
C
�
�?
I
�
�I
M
�
I
M
�
M
M
�
9O
�
"R
R
�
+�T
�
?W
X
�
F\
Y
�
Ja
Z
�
Qg
]
�
Wg
`
�
]m
c
�
gs
f
�
{y
h
�
y
j
�
�
l
�
�m
o
�
��
r
��Gt
P FGu
� �ru
� 
�ru
�!F��u
T"F�u
D#�Mu
l#F�ru
 $F�ru
 
 
�

/ 
 
\
 
l s 
 
 
 
      
� �  
�   
 
 
L 
UW\e
 
Uq
 
Uq 

��  
�
 
U
 
� � 
� 
� �
 � 
� �
 � 
� �
 �
� 
� �
 � 
� � � � 
� �
 � 
� �
 � 
� �
 �
� 
� �
 �
� 
�
 �0
�0� 
 
C R U X [ ^ a d 	g  
U q 
 
�

/ 
 
\
 
l s 
 
 
 
      
� �  
�   
 
 
L 
UW\e
 
Uq
 
Uq 

��  
�
 
U
 
� � 
� 
� �
 � 
� �
 � 
� �
 �
� 
� �
 � 
� � � � 
� �
 � 
� �
 � 
� �
 �
� 
� �
 �
� 
�
 �0
�0� 
 
C R U X [ ^ a d 	g  
U q 
U

V

�

� 
 
� 
 
U
 
  
 
0
 6
 < 
 
K
 S
 V

_  
h
 q  
K
 
 �
 
U
 6
� 
U  
U �0�0�  
U
�
 � � �  
U
� � �  
U
�
 � � �
 
6
 �
 � � 
 
U  
  
 
' 
 
2
 7
 :
 
'
 
U 
 
U
O 
 
U
 q 
 
U
 q 
 
U
 a
 
U
 o  
U  
U 
 
U
 q 
 
U
 q 
 
U

V

�

� 
 
� 
 
U
 
  
 
0
 6
 < 
 
K
 S
 V

_  
h
 q  
K
 
 �
 
U
 6
� 
U  
U �0�0�  
U
�
 � � �  
U
� � �  
U
�
 � � �
 
6
 �
 � � 
 
U  
  
 
' 
 
2
 7
 :
 
'
 
U 
 
U
O 
 
U
 q 
 
U
 q 
 
U
 a
 
U
 o  
U  
U 
 
U
 q 
 
U
 q 
 
U 
U$	(M�(��
)��
A��Q��
a��
i��
q�(��r���
i��
	�r���
�	�
��r�$	�
�*	�
�1	�
�5	�
�:	I
�D	�
�M	�
�T	�
�]	�
�f	�
��(q�
u�
y�
��
��
��
5
9
�
�
�
�
�
�
�
�
�
�

�
��a�
e�
��
��
 M)M.p.��CFCIV`Mc�c;HcCOc�i_�V�+��#��q�V�#��z�_�3%����_�q�F��
h
�
�
;H	
� 
q#
q#
3)
�@
qC
-C
WC
S�I
�`
zc
[gi
��
z�
��
��
��
��
��
��
M�	V �)_@�Iq`�iz�����������������	� �)�@�I�`�i��
���
��������%	� .)�@7I�`@i��I���R�[�dm v@`������MM V@V`_�_�h�q�qz z@�`���������� �@�`���������	� 	
@	
`	�	�	%�	.�	7
@ 
I@
R`
[�
d�
m�
v�
� �@� �@�`���������
� 
�@
�`
��
��
��
��
�� @`�"�+�9�BK T@]`f�o�x����� �@�`��������� �@�`���������� �@�`���������� @`�"�+�9�BK T@]`f�o�x����� �@�`���������^�K4�)K4�
�
�

�
�
�
�
�
�
�
�
�
�
!�
#�
%�
'�
)�
+�
-�
/�
1�
3�
5�
7�
?�
C�
G�
M�
O�
Q�
S�
U�
W�
Y�
[�
]�
_�
a�
c�
e�
g�
i�
m�
o�
q�
s�
u�
w�
y�
{�
}�
�
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��

�

�

�
	
�

�


�

�

�

�

�

�

�

�

�

�
#
�
%
�
'
�
)
�
+
�
-
�
/
�
1
�
3
�
5
�
7
�
9
�
;
�
=
�
?
�
A
�
E
�
G
�
I
�
M
�
O
�
Q
�
S
�
U
�
W
�
Y
�
[
�
]
�
_
�
a
�
c
�
e
�
g
�
i
�
k
�
m
�
o
�
w
�
y
�
{
�
}
�

�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�
�

�
�
�
�
	�
�

�
�
�
�
�
�
�
�
�
�
!�
#�
%�
'�
)�
+�
3�
5�
7�
9�
;�
=�
?�
A�
C�
E�
G�
I�
K�
M�
Q�
S�
U�
W�
Y�
[�
]�
_�
a�
e�
g�
i�
k�
m�
o�
q�
s�
w�
y�
{�
}�
�
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��
��


!��/�\�~�����������������������/�\�~���������������������V�
��
��
��V�
��
��
��[\

]^

		

	



/
01!
2!
4#3#
7%6%8'
9':);+<-=/>1?3@5A7C9
B9
b;a;c=
d=e?
f?gA
hA�C
�C�E
�E�G
�G�I
�I^`bd
fhjlnprtvxz |"~$�&�(�*�,�.�0�2�4�6�8�:�<�>�@�B�D�F�H�J�L�N�P�R�T�V�X�Z����
�
�
�
�
�
�
� 
�"
�$
�&
�(
�*
�,
�.
�0
�2
�4
�6
�8
�:
�<
�>
�@
�B
�D
�F
�H
�J
�L
�N
�P

R

T

V

X

Z


\

^

�
�
�
��
�<Module>_Portinterop.pixieenginePortClass__Port_Event__Port_ResponseAEventHandlerPort_FunctionsFunctionsClassFunctions__Port__Port_SinkHelper__Port_EventProvidermscorlibScriptingVBAADODBObjectSystemGuidAttributeSystem.Runtime.InteropServicesTypeLibTypeAttributeDictionaryDispIdAttributeVbCompareMethodRecordsetComVisibleAttributeTypeComEventInterfaceAttributeMulticastDelegateCoClassAttributeClassInterfaceAttributeComSourceInterfacesAttributeArrayParamArrayAttributeInterfaceTypeAttributeClassInterfaceTypeIDisposableUCOMIConnectionPointContainerArrayListSystem.CollectionsUCOMIConnectionPointGuidByteMonitorSystem.ThreadingDelegateGCExceptionImportedFromTypeLibAttributeget_XCommon_VtblGap8set_XCommonXCommonget_ExecuteCompareMethodset_ExecuteCompareMethodExecuteCompareMethodget_msStateset_msStatemsStateRsOOpensQueryrstget_TermTypeset_TermTypeget_UserInstset_UserInstget_UserNameget_Stateget_Connection_IDget_SelectArrayget_SelectResultijget_SelectUboundget_ErrorDetailget_Responseset_Descriptionget_DescriptionEchovIInputsnLenbNewLinetimeForCRTNewlinePPrintTTagxYExecutePSsCmdRequestAPortCCloseOOPenFFileFileVariableCCloseRReadItemItemIDRReadTRRReadVValueFieldNumberRReadURReadVUWWriteWWriteUWWriteVWWriteVUDeleteRReleaseXRunsProcedureNameP1P2P3P4P5P6P7P8TOConvsProcessCodeTermTypeUserInstUserNameStateConnection_IDSelectArraySelectResultSelectUboundErrorDetailResponseDescription.ctoradd_ResponseAremove_ResponseAResponseAInvokeget_PxCaseSensitivityset_PxCaseSensitivityPxCaseSensitivityget_RReplaceSafetyset_RReplaceSafetyRReplaceSafetyget_InsertSafetyset_InsertSafetyInsertSafetyget_ErrorDetailFnset_ErrorDetailFnErrorDetailFnPropertyParsesPropertysDelimiterSegmentReplacesTextsFindsReplCConvertsStrings1s2SleeptDCountInStringDelimiterFieldnSegmentNumberIndexnOccurAlphaExtractnAttribnValuenSubvalueRReplacei254AbcDyleteInsertLocatesSepsStringIndCol1Col2NumMModDividendDivisorNNotargMVBoolArg1OpArg2MCBoolSeqSStrnIConvOConvFmtsCodeMatchesProcessCodeMVRMVWMVOConvMVIConvUpCasem_ResponseADelegatem_dwCookieInitFinalizeDisposem_ConnectionPointContainerm_aEventSinkHelpersm_ConnectionPointFindConnectionPointEnterAdviseAddExitget_Countget_ItemEqualsRemoveAtUnadviseSuppressFinalizePixieEngine.dll;�=����@�R��=�g��z\V4�� 
 

  

  

    
 

 

  
  
 
 
  
 	     	
 

 
  

   

    
 	  	   
 
 
 
     
  
QUY 

 

 
%% 

% 

I 

	 
]Y

 
 
 
 
����
���


Y],,)
$B56F5674-EBD2-4671-9F94-02219C08EB2D
�
�@
�@
�@
�`
�h
�h
�h
�h
�h
�h
�h
�h
�h
�h
�h
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`
�`)
$059DB0F6-AB20-11D3-AA05-F06905C10000

J
interop.pixieengine.__Port)interop.pixieengine.__Port_EventProvider"
interop.pixieengine.PortClass
!
interop.pixieengine.__Port)
$0921FFF2-F90F-439C-A661-288091604339
@
!@
"@
$@
`
 `
!`
"`
#`
$`
%`
&`
'`
(`
)`
*`
+`

,`
-`
.`
/`
0`
1`
2`
3`
4`
5`
6`
7`
8`
9`
:`
;`
<`
=`)
$5882B23D-709B-4BD1-BB34-36CF5C62FFD4'
"interop.pixieengine.FunctionsClass)
$3A53EA55-6FF0-4E6F-BC80-68596D782853
�


)
$059db0f4-ab20-11d3-aa05-f06905c10000
PixieEngineTZnZ `Z_CorDllMainmscoree.dll�% @
�

0�
HX`((4VS_VERSION_INFO���
?D
VarFileInfo$Translation��
StringFileInfod
007f04b0
Comments $
CompanyName ,
FileDescription 4	
FileVersion12.0.0.0H
InternalNameinterop.pixieengine(
LegalCopyright ,
LegalTrademarks X
OriginalFilenameinterop.pixieengine.dll�0
ProductNameAssembly imported from type library PixieEngine8	
ProductVersion12.0.0.0P�: