The Pipe is Being Closed

[Mike Bond]

I am running the following code and after my get file via MSHTA, it locks up and I get a script error. Confusing thing is... not everyone that uses this gets the error and some people can run it, no problem. Any assistance would be great!

#$language = "VBScript"
#$interface = "1.0"

'Global vars
g_continue = True
g_checkout = False


Sub Main

securityCheckInput = LCase(InputBox("Please enter property code:","ZZ Wholesaler Audit"))
If securityCheckInput = "" Then : Exit Sub : End If

sBegin = MsgBox("To proceed, select OSTAT report...", vbOKCancel + vbQuestion, "Check Out ZZ (Wholesaler)")
IF sBegin = vbCancel Then
Exit Sub
End IF

Option Explicit

Dim strFile

strFile = SelectFile( )

If strFile = "" Then
WScript.Echo "No file selected."
Else
WScript.Echo """" & strFile & """"
End If
referencefile = SelectFile()
If referencefile = "" Then
Exit Sub
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFileInput = objFSO.OpenTextFile(referencefile,True)
strInputFile = objTextFileInput.ReadAll
objTextFileInput.Close
inputLines = Split(strInputFile, vbcrlf)

'Check config/(check excel)
Set WshShell = CreateObject("WScript.Shell")
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
If Err AND Err.Number = 429 Then
ExcelOpen = False
Else
ExcelOpen = True
End If
On Error Goto 0
If NOT ExcelOpen Then
Set objExcel = CreateObject("Excel.Application")
Else
Set objExcel = GetObject(,"Excel.Application")
End If
config = WshShell.CurrentDirectory & "\Wholesaler CO.xlsm"
With objExcel
.Application.Visible = True
.ScreenUpdating = True
.DisplayAlerts = False
Set objWorkbook = .Workbooks.Open((config))
objWorkbook.Worksheets("OTA Catalogue").Activate
End With

'Pull OTA segments from list. starts @ line 6 in excel
EMPLOYEENUMBER = objExcel.Cells(2, 2). Value
PROPERTYCODE = LCase(objExcel.Cells(3, 2). Value)
Set lOTA = CreateObject("System.Collections.ArrayList")
row_excel = 6
Do Until objExcel.Cells(row_excel, 1). Value = ""
lOTA.Add objExcel.Cells(row_excel, 1) & ";" & objExcel.Cells(row_excel, 2)
row_excel = row_excel + 1
Loop
'For each item in lOTA
'msgbox item
'Next

'Security Check - matches typed property code to excel doc's
If NOT securityCheckInput = PROPERTYCODE Then : msgbox "ERROR: Property Code does not match" : Exit Sub : End If

'Iterate thru
For each strLine in inputLines
resnum = left(strLine, 6)
zzcheck = mid(strLine, 29, 2)
If IsNumeric(resnum) AND zzcheck = "ZZ" Then
For each item in lOTA
spl_segment = split(item, ";")
If Trim(Mid(strLine, 19,8)) = spl_segment(0) Then
'Return to MOHOMAIN/MOFOMAIN
Do Until crt.Screen.Get(1,53,1,54) = "MO" And crt.Screen.Get(1,57,1,60) = "MAIN"
crt.Screen.Send vbcr
Loop
crt.sleep 100
If crt.Screen.Get(1,55,1,56) = "FO" Then
crt.Screen.Send "10 4" & vbcr
ElseIf crt.Screen.Get(1,55,1,56) = "HO" Then
crt.Screen.Send "1 10 4" & vbcr
End If
'Credit Auth Entry
Call checkScreen("C=CONF#):",resnum)
waitUntil("ENTER SELECTION (1=PMT METHOD, 2=D/B ACCT NUMBER, 3=BOTH):")
currentBalance = Trim(crt.screen.get(7,65,7,78))
If onScreen("ACCOUNTING TO REVIEW") Or currentBalance = ".00" Then
'check for manual audit flag
'msgbox "acct to review or current bal = 0"
cSe("")
Else
'continue otherwise
Call checkScreen("3=BOTH):","3")
Call checkScreen("ENTER METHOD OF PAYMENT","DB ")
Call checkScreen("ENTER CUSTOMER ID:",spl_segment(1))
'msgbox "DB enabled"
Call waitUntilOnScreen2("CORRECT CUSTOMER ID? (Y/N):","CUSTOMER ID NOT FOUND, PRESS <ENTER>")
If onScreen("(Y/N):") Then
Call checkScreen("IS THIS THE CORRECT CUSTOMER ID? (Y/N):","y")
Do Until crt.Screen.Get(1,53,1,54) = "MO" And crt.Screen.Get(1,57,1,60) = "MAIN"
crt.Screen.Send vbcr
Loop
crt.sleep 100
If crt.Screen.Get(1,55,1,56) = "FO" Then
crt.Screen.Send "2 1" & vbcr
ElseIf crt.Screen.Get(1,55,1,56) = "HO" Then
crt.Screen.Send "1 2 1" & vbcr
End If
Call checkScreen("OR OPTION:",resnum)
waitUntil("OR LINE#:")
If NOT onScreen("ACCOUNTING TO REVIEW") Then
Call checkScreen("OR LINE#:","a")
Call waitUntilOnScreen2("SHIFT NUMBER:","(R)EGISTRATION")
If onScreen("SHIFT NUMBER:") Then : cSe("3") : End If
Call checkScreen("(R)EGISTRATION","12")
crt.sleep 300
Call waitUntilOnScreen2("(P)=POST","(R)EGISTRATION")

Do Until NOT g_continue
Call AuditFolio
If g_continue Then : cSe("") : crt.sleep 250 : End If
Loop

If g_checkout Then
If onScreen("(P)=POST") Then : cSe("p") : End If
Call checkScreen("ENTER:","1")
Call waitUntilOnScreen2("!! EARLY OR LATE DEPARTURE !! PRESS ENTER.","ENTER YOUR EMPLOYEE NUMBER:")
If onScreen("!! EARLY OR LATE DEPARTURE !! PRESS ENTER.") Then : cSe("") : End If
Call checkScreen("ENTER YOUR EMPLOYEE NUMBER:",EMPLOYEENUMBER)
'sChargeENTER = MsgBox("OK to proceed with charging, cancel to exit", vbOKCancel + vbQuestion, resnum & " complete")
'IF sChargeENTER = vbCancel Then : Exit Sub : End IF
Call checkScreen("IF PAID IN FULL:","33")
'sContinueENTER = MsgBox("goto next?? (cancel to view account)", vbOKCancel + vbQuestion, resnum & " complete")
'IF sContinueENTER = vbCancel Then : cSe("a") : Exit Sub : End IF
End If
Else
'msgbox "manual audit flag"
cSe("")

End If

'sContinue = MsgBox("proceed to next??", vbOKCancel + vbQuestion, "complete")
'IF sContinue = vbCancel Then : Exit Sub : End IF

Else
msgbox "Invalid DB Account, process terminated. Please verify correct DB account listed in Excel file."
Exit Sub
End If
End If

End If
Next
End If

g_continue = True
g_checkout = False

Next

msgbox("Complete!")

objExcel.Quit
Set objExcel = Nothing

End Sub


'Sub Func
Function AuditFolio
For counter = 9 To 17
auditline = Trim(crt.Screen.Get(counter,15,counter,22))
Select Case auditline

Case "ROOMS TR","STATE TX","CITY TAX","SCR FEE","ROOM PKG","ROOM"
'do nothing
'msgbox auditline & " found"

Case "TELECOMM"
'msgbox auditline & " found, check for 0$"
If NOT crt.Screen.Get(counter,49,counter,52) = " .00" Then
If onScreen("(P)=POST") Then : cSe("p") : End If
Call checkScreen("ENTER:", "")
Call checkScreen("OR LINE#:", "10")
Call checkScreen("<\D>ONE", "ACCOUNTING TO REVIEW ")
crt.sleep 250
'msgbox "accounting to review"
Call checkScreen("<\D>ONE", "\d")
g_continue = False
Exit Function
End If

Case ""
'msgbox auditline & "blank line found - exit"
g_continue = False
g_checkout = True
Exit Function

Case "DIR BILL"
'msgbox auditline & " found"
g_continue = False
g_checkout = False
Exit Function

Case "CASH"
'msgbox auditline & " found"
If auditline = "CASH" AND crt.Screen.Get(counter,49,counter,52) = " .00" AND counter = 17 AND onScreen("(R)EGISTRATION") Then
screentest = crt.screen.get(counter,5,counter,7)
cSe("12")
crt.sleep 250
screentest2 = crt.screen.get(counter,5,counter,7)
If screentest2 = screentest Then
g_continue = False
g_checkout = True
Exit Function
End If
Else
g_continue = True
End If

Case Else
If onScreen("(P)=POST") Then : cSe("p") : End If
Call checkScreen("ENTER:", "")
Call checkScreen("OR LINE#:", "10")
Call checkScreen("<\D>ONE", "ACCOUNTING TO REVIEW ")
crt.sleep 250
'msgbox "accounting to review"
Call checkScreen("<\D>ONE", "\d")
g_continue = False
Exit Function
'MsgBox counter & " " & auditline & " error"

End Select
next
End Function

'==FUNCTIONS==
Function SelectFile( )
Dim objExec, strMSHTA, wshShell

SelectFile = ""

strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
& "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
& ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""

Set wshShell = CreateObject( "WScript.Shell" )
Set objExec = wshShell.Exec( strMSHTA )

SelectFile = objExec.StdOut.ReadLine

Set objExec = Nothing
Set wshShell = Nothing
End Function

Function waitUntilOnScreen2(tree1,tree2)
Do Until onScreen(tree1) OR onScreen(tree2)
crt.sleep 120
Loop
End Function

Function cSe(var)
crt.Screen.Send var & vbcr : crt.sleep 50
End Function

Function checkScreen(test, send)
Do Until InStr(crt.Screen.Get2(1,1,24,80), test) : crt.sleep 100 : Loop
crt.Screen.Send send & vbcr
End Function

Function onScreen(var)
onScreen = False
If InStr(crt.Screen.Get2(1,1,24,80), var) Then : onScreen = True : End If
End Function

Function waitUntil(var)
Do Until onScreen(var) : crt.sleep 100 : Loop
End Function

[JJ]

On Wed, 9 Feb 2022 07:41:06 -0800 (PST), Mike Bond wrote:
> I am running the following code and after my get file via MSHTA, it locks up and I get a script error. Confusing thing is... not everyone that uses this gets the error and some people can run it, no problem. Any assistance would be great!
>

[snip]

> Function SelectFile( )
> Dim objExec, strMSHTA, wshShell
>
> SelectFile = ""
>
> strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
> & "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
> & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
>
> Set wshShell = CreateObject( "WScript.Shell" )
> Set objExec = wshShell.Exec( strMSHTA )
>
> SelectFile = objExec.StdOut.ReadLine
>
> Set objExec = Nothing
> Set wshShell = Nothing
> End Function

Main reason is because the StdOut pipe has been closed at the time ReadLine
is performed.

This may be due to failed on process execution, or succeeded on process
execution but the process ends before ReadLine is performed.

And IME, buffer overrun may also cause same/similar pipe related error.

I'd suggest checking the execution status first. If it doesn't fail, perform
ReadLine. After ReadLine, perform ReadAll by its own (ignore the result) to
eat any remaining data in the pipe buffer. Then perform a sleep of 1ms to
let the process completely terminates. Clean up then exit function.