sMockInput, iPos - 1) gsMockInput = Mid(gsMockInput, iPos + 1) Else s = gsMockInput gsMockInput = "" End If Exit Sub '020116 JPC Custom, protect batch web apps from illegal IInput '020311 JPC extend to phantom case ElseIf gbWebBatch Or gbPhantom Then s = "" Exit Sub End If ' 'UPGRADE_NOTE: IsMissing(a2) was changed to IsNothing(a2). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1021.htm 'UPGRADE_NOTE: IsMissing(a1) was changed to IsNothing(a1). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1021.htm If IsNothing(a1) Then Call UserPort.IInput(s) ElseIf IsNothing(a2) Then 'UPGRADE_WARNING: VarType has a new behavior. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1041.htm Select Case VarType(a1) Case VariantType.Short, VariantType.Integer, VariantType.Single 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, a1) Case VariantType.String 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sA1Trim = Trim(LCase(a1)) If sA1Trim = "true" Or sA1Trim = "false" Then 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, -1, a1) ElseIf sA1Trim = ":" Then Call UserPort.IInput(s, -1, False) ElseIf IsNumeric(a1) Then 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, a1) Else 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, -1, a1) End If Case Else 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, -1, a1) End Select Else 'UPGRADE_WARNING: Couldn't resolve default property of object a2. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, a1, a2) End If '991223 JPC controlled tidy closing of callback object ' on sudden disconnection of port or admin remote control If s = "<&PORT_DISCONNECT>" Then 'UPGRADE_NOTE: Object UserPort may not be destroyed until it is garbage collected. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1029.htm UserPort = Nothing End If ' End Sub Public Sub IInputUT(ByRef s As Object, Optional ByVal a1 As Object = Nothing, Optional ByVal a2 As Object = Nothing) Dim iType As Short Dim sA1Trim As String ' 'UPGRADE_NOTE: IsMissing(a2) was changed to IsNothing(a2). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1021.htm 'UPGRADE_NOTE: IsMissing(a1) was changed to IsNothing(a1). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1021.htm If IsNothing(a1) Then Call UserPort.IInput(s) ElseIf IsNothing(a2) Then 'UPGRADE_WARNING: VarType has a new behavior. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1041.htm Select Case VarType(a1) Case VariantType.Short, VariantType.Integer, VariantType.Single 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, a1) Case VariantType.String 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sA1Trim = Trim(LCase(a1)) If sA1Trim = "true" Or sA1Trim = "false" Then 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, -1, a1) ElseIf sA1Trim = ":" Then Call UserPort.IInput(s, -1, False) ElseIf IsNumeric(a1) Then 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, a1) Else 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, -1, a1) End If Case Else 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, -1, a1) End Select Else 'UPGRADE_WARNING: Couldn't resolve default property of object a2. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object a1. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call UserPort.IInput(s, a1, a2) End If ' '000314 MYW IInputUT gives common filtering of input s = Trim(UCase(s)) If s = "" Then s = Nothing End If '020214 JPC replaces next line 'If Len(s) > 0 And Matches(s, "0N") Then s = Val(s) '991223 JPC controlled tidy closing of callback object ' on sudden disconnection of port or admin remote control If s = "<&PORT_DISCONNECT>" Then 'UPGRADE_NOTE: Object UserPort may not be destroyed until it is garbage collected. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1029.htm UserPort = Nothing End If ' End Sub Public Function IInputFor(ByRef s As Object, ByVal nLen As Integer, ByVal bNewLine As Boolean, ByVal timeFor As Integer) As Boolean ' '991224 JPC this is the full-version of "Input" but comes at ' the "cost" of a strict syntax 'IInputFor = UserPort.IInput(s, nLen, bNewLine, timeFor) IInput(s) '991223 JPC tidy closing of callback object ' on sudden disconnection of port or admin remote control If InStr(s, "<&PORT_DISCONNECT>") > 0 Then 'UPGRADE_NOTE: Object UserPort may not be destroyed until it is garbage collected. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1029.htm UserPort = Nothing End If ' End Function Public Sub IIn(ByRef sChr As Object) Dim s As String '020902 JPC try a change here Call UserPort.IInput(s, -2) '--(was)--Call UserPort.IInput(s, 1, False) If Len(s) = 1 Then 'UPGRADE_WARNING: Couldn't resolve default property of object sChr. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sChr = Asc(s) Else 'UPGRADE_WARNING: Couldn't resolve default property of object sChr. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sChr = Nothing End If End Sub Public Function IInFor(ByRef sChr As Object, ByVal timeFor As Integer) As Boolean Dim s As String '020902 JPC try a change here IInFor = UserPort.IInput(s, 1, True, timeFor) '--(was)--IInFor = UserPort.IInput(s, 1, False, timeFor) If Len(s) = 1 Then 'UPGRADE_WARNING: Couldn't resolve default property of object sChr. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sChr = Asc(s) Else 'UPGRADE_WARNING: Couldn't resolve default property of object sChr. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sChr = Nothing End If End Function Public Sub Crt(ByVal s As Object, Optional ByVal NEWLINE As Boolean = True) Call UserPort.Crt(s, NEWLINE) End Sub '010726 JPC Optional 1st arg Public Sub PPrint(Optional ByRef s As Object = "", Optional ByVal NEWLINE As Boolean = True) Call UserPort.PPrint(s, NEWLINE) End Sub Public Function TTag(ByVal x As Integer, Optional ByVal y As Integer = -1) As String 'This is equivalent to the "@-function" TTag = UserPort.TTag(x, y) End Function '991214 JPC Public Function ErrorDetail() As Object 'UPGRADE_WARNING: Couldn't resolve default property of object UserPort.ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm ErrorDetail = UserPort.ErrorDetail End Function Public Function OOPen(ByRef FFILE As Object, ByRef FileVariable As Object) As Boolean '000208 JPC apply lcase to FFILE ' TODO check apparent unexpected MySQL case-sensitivity ' OOPen = True '010310 JPC Custom fixes for file names which are reserved names in SQL '011005 JPC allow for D3 and UV drivers If Left(gsDataStore, 2) <> "MV" Then FFILE = LCase(FFILE) '010415 JPC special cases 1-account only FFILE = Replace(FFILE, ".", "_") '010426 JPC check "-" in SQL table names FFILE = Replace(FFILE, "-", "_") '010704 JPC autofix for DICT FILENAME If Left(FFILE, 5) = "dict " Then FFILE = Trim(Mid(FFILE, 6)) & "_dict" End If ' Select Case FFILE Case "table" FFILE = "table_px" Case "key" FFILE = "key_px" End Select End If OOPen = UserPort.OOPen(FFILE, FileVariable) '010415 JPC poss temp debug If OOPen = True Then '010415 JPC temp cover for MSSQL Type N returning stray spaces in FileVariable ' delete FileVariable = Replace(FileVariable, " ", "") Else DebugLog("OOpen ERROR! '" & FFILE & "' " & ErrorDetail) End If End Function Public Function CClose(ByRef FileVariable As Object) As Boolean CClose = UserPort.CClose(FileVariable) End Function Public Function ClearFile(ByRef FileTableName As Object) As Boolean Dim sDatastore As String ClearFile = True sDatastore = ExecutePS("SYSTEM DATASTORE") Select Case sDatastore Case "MV1", "MV2" If ExecutePS("DELETE " & FileTableName & " *") = "ERROR" Then ClearFile = False Case Else If ExecutePS("DELETE FROM " & FileTableName) = "ERROR" Then ClearFile = False End Select End Function Public Function RRead(ByRef ITEM As Object, ByRef FileVariable As Object, ByRef ItemID As Object) As Boolean Dim b As Boolean Dim sCacheID, sKey As String Dim iPos As Integer ' '011005 JPC uncomment next line 'DebugLog "RRead FV = " & FileVariable & ", ID = " & ItemID If CStr(ItemID) = "" Then ITEM = "" DebugLog("RREAD ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function ElseIf FileVariable = "" Then '020426 JPC cover case like fail to find dict when looking for specs ITEM = "" DebugLog("RREAD ALERT, FileVariable = '' so exit function.") Exit Function End If '010424 JPC try caching common repeated reference material sCacheID = FileVariable & "ý" & ItemID If Locate(sCacheID, "IN", gsCacheID, "SETTING", iPos) Then ITEM = msCache(iPos) 'If Item = "" Then Item = Empty RRead = True DebugLog(" RREAD CACHED Item " & Left(ITEM, 40) & " ...") Exit Function End If b = UserPort.RRead(ITEM, FileVariable, ItemID) 'DebugLog " Item = " & Left$(Item, 40) & " ..." If ErrorDetail > "" Then '011005 JPC more reporting ... DebugLog("RREAD ErrorDetail = " & ErrorDetail & ControlChars.CrLf & " FV = " & FileVariable & ", ID = " & ItemID) End If RRead = b Select Case LCase(Field(FileVariable, ".", 2)) Case "table", "table_px", "w3html", "syscon", "w3syscon", "w3guests" 'Note no need to test for already there, because if already there, 'code above will have exit-ed this routine gsCacheID = RReplace(gsCacheID, -1, sCacheID) iPos = DCount(gsCacheID, "þ") ReDim Preserve msCache(iPos) msCache(iPos) = ITEM End Select 'If Item = "" Then Item = Empty End Function Public Function WWrite(ByRef ITEM As Object, ByRef FileVariable As Object, ByRef ItemID As Object) As Boolean Dim iPos As Integer ' 'DebugLog "WWrite FV = " & FileVariable & ", ItemID = " & ItemID If CStr(ItemID) = "" Then '020221 JPC better PICKBASIC mirroring 'Item = Empty DebugLog("WWRITE ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function End If 'DebugLog " Item = " & Left$(Item, 40) & " ..." WWrite = UserPort.WWrite(ITEM, FileVariable, ItemID) If ErrorDetail > "" Then DebugLog("WWRITE ErrorDetail = " & ErrorDetail) '010704 JPC Parallel-write into cache ElseIf Locate(FileVariable & "ý" & ItemID, "IN", gsCacheID, "SETTING", iPos) Then msCache(iPos) = ITEM End If 'DebugLog " (after WWrite)" End Function Public Function RReadTR(ByRef ITEM As Object, ByRef FileVariable As Object, ByRef ItemID As Object) As Boolean RReadTR = UserPort.RReadTR(ITEM, FileVariable, ItemID) End Function Public Function RReadU(ByRef ITEM As Object, ByRef FileVariable As Object, ByRef ItemID As Object) As Boolean Dim b As Boolean ' 'DebugLog "RReadU FV = " & FileVariable & ", ID = " & ItemID 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If CStr(ItemID) = "" Then 'UPGRADE_WARNING: Couldn't resolve default property of object ITEM. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm ITEM = "" 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("RREADU ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function End If 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm RReadU = UserPort.RReadU(ITEM, FileVariable, ItemID) 'DebugLog " Item = " & Left$(Item, 40) & " ..." 'UPGRADE_WARNING: Couldn't resolve default property of object ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If ErrorDetail > "" Then DebugLog("RREADU ErrorDetail = " & ErrorDetail) End If '010704 JPC NOTE no caching code as RReadU must go to the database ' to do its locking functions. End Function Public Function RReadV(ByRef Value As Object, ByRef FileVariable As Object, ByRef ItemID As Object, ByRef FieldNumber As Object) As Boolean Dim b As Boolean Dim iPos As Integer 'DebugLog "RReadV FV = " & FileVariable & ", ID = " & ItemID & ", # = " & FieldNumber 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If CStr(ItemID) = "" Then 'UPGRADE_WARNING: Couldn't resolve default property of object Value. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Value = "" 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("RREADV ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function '010424 JPC try caching common repeated reference material ElseIf InStr(1, gsCacheID, FileVariable & "ý" & ItemID, 1) Then 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If Locate(FileVariable & "ý" & ItemID, "IN", gsCacheID, "SETTING", iPos) Then 'UPGRADE_WARNING: Couldn't resolve default property of object Extract(msCache(iPos), FieldNumber). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object Value. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Value = Extract(msCache(iPos), FieldNumber) RReadV = True 'DebugLog " RREAD CACHED Item " & Left$(msCache(iPos), 40) & " ..." Exit Function End If End If ' 'UPGRADE_WARNING: Couldn't resolve default property of object FieldNumber. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm b = UserPort.RReadV(Value, FileVariable, ItemID, FieldNumber) 'DebugLog " Value = " & Value 'UPGRADE_WARNING: Couldn't resolve default property of object ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If ErrorDetail > "" Then DebugLog("RREADV ErrorDetail = " & ErrorDetail) End If RReadV = b End Function Public Function RReadVU(ByRef Value As Object, ByRef FileVariable As Object, ByRef ItemID As Object, ByRef FieldNumber As Object) As Boolean Dim b As Boolean Dim iPos As Integer ' 'DebugLog "RReadVU FV = " & FileVariable & ", ID = " & ItemID & ", # = " & FieldNumber 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If CStr(ItemID) = "" Then 'UPGRADE_WARNING: Couldn't resolve default property of object Value. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Value = "" 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("RReadVU ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function End If ' b = UserPort.RReadVU(Value, FileVariable, ItemID, FieldNumber) 'UPGRADE_WARNING: Couldn't resolve default property of object ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If ErrorDetail > "" Then DebugLog("RREADVU ErrorDetail = " & ErrorDetail) End If 'DebugLog " Value = " & Value RReadVU = b '010704 JPC NOTE no caching code as RReadVU must go to the database ' to do its locking functions. End Function Public Function WWriteU(ByRef ITEM As Object, ByRef FileVariable As Object, ByRef ItemID As Object) As Boolean Dim iPos As Integer ' 'DebugLog "WWriteU FV = " & FileVariable & ", ItemID = " & ItemID 'DebugLog " Item = " & Left$(Item, 40) & " ..." 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If CStr(ItemID) = "" Then '020221 JPC 'Item = "" 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("WWRITEU ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function End If ' 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm WWriteU = UserPort.WWriteU(ITEM, FileVariable, ItemID) 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If ErrorDetail > "" Then DebugLog("WWRITEU ErrorDetail = " & ErrorDetail) '010704 JPC Cache fix ElseIf Locate(FileVariable & "ý" & ItemID, "IN", gsCacheID, "SETTING", iPos) Then 'UPGRADE_WARNING: Couldn't resolve default property of object ITEM. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm msCache(iPos) = ITEM End If 'DebugLog " (after WWriteU)" End Function Public Function WWriteV(ByRef Value As Object, ByRef FileVariable As Object, ByRef ItemID As Object, ByRef FieldNumber As Object) As Boolean Dim iPos As Integer ' 'DebugLog "WWriteV FV = " & FileVariable & ", ItemID = " & ItemID & ", # = " & FieldNumber 'DebugLog " Value = " & Value 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If CStr(ItemID) = "" Then '020214 JPC think better of this '-- Value = "" 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("WWRITEV ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function End If ' 'UPGRADE_WARNING: Couldn't resolve default property of object FieldNumber. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm WWriteV = UserPort.WWriteV(Value, FileVariable, ItemID, FieldNumber) 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If ErrorDetail > "" Then DebugLog("WWRITEV ErrorDetail = " & ErrorDetail) '010704 JPC Cache fix ElseIf Locate(FileVariable & "ý" & ItemID, "IN", gsCacheID, "SETTING", iPos) Then msCache(iPos) = RReplace(msCache(iPos), FieldNumber, Value) End If 'DebugLog " (after WWriteV)" End Function Public Function WWriteVU(ByRef Value As Object, ByRef FileVariable As Object, ByRef ItemID As Object, ByRef FieldNumber As Object) As Boolean Dim iPos As Integer ' 'DebugLog "WWriteV FV = " & FileVariable & ", ItemID = " & ItemID & ", # = " & FieldNumber 'DebugLog " Value = " & Value 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If CStr(ItemID) = "" Then '020214 JPC think better of this! '-- Value = "" 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("WWRITEVU ALERT, ItemID = '' so exit function (FV = '" & FileVariable & "')") Exit Function End If ' 'UPGRADE_WARNING: Couldn't resolve default property of object FieldNumber. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm WWriteVU = UserPort.WWriteVU(Value, FileVariable, ItemID, FieldNumber) 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If ErrorDetail > "" Then DebugLog("WWRITEVU ErrorDetail = " & ErrorDetail) '010704 JPC Cache fix ElseIf Locate(FileVariable & "ý" & ItemID, "IN", gsCacheID, "SETTING", iPos) Then msCache(iPos) = RReplace(msCache(iPos), FieldNumber, Value) End If 'DebugLog " (after WWriteVU)" End Function Public Sub RELEASE(Optional ByVal FileVariable As Object = "", Optional ByVal ItemID As Object = "") Call UserPort.RRelease(FileVariable, ItemID) 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("RELEASE FV = " & FileVariable & ", ID = " & ItemID) '--Debug.Assert FileVariable > "" End Sub '000114 JPC Public Function Delete(ByRef FileVariable As Object, ByRef ItemID As Object) As Boolean Dim iPos As Integer ' 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm DebugLog("Delete FV = " & FileVariable & ", ID = " & ItemID) Delete = UserPort.Delete(FileVariable, ItemID) 'UPGRADE_WARNING: Couldn't resolve default property of object ItemID. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object FileVariable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object ErrorDetail. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If ErrorDetail > "" Then DebugLog("Delete ERROR on Delete = " & ErrorDetail) '010704 JPC clean up any cache (although need for this is highly unlikely!) ElseIf Locate(FileVariable & "ý" & ItemID, "IN", gsCacheID, "SETTING", iPos) Then gsCacheID = RReplace(gsCacheID, iPos, "##Deleted##") End If DebugLog(" delete end function") End Function '000115 JPC relate to new functions as TCL-like strings ... Public Function ExecutePS(ByVal sCmd As String) As String Dim s As String ExecutePS = UserPort.ExecutePS(sCmd) Select Case UCase(Trim(Field(sCmd, " ", 1))) Case "SELECT", "PSELECT", "QSELECT", "SSELECT", "SORT", "LIST" mnSelectResultIndex = -2 'UPGRADE_WARNING: Couldn't resolve default property of object DCount(ExecutePS, Chr(254)). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If DCount(ExecutePS, Chr(254)) >= 2 Then 'SelectArray = UserPort.SelectArray '020220 JPC set to -2, 0 rather than -1, 1 to better support COUNT in RREADNEXT mnSelectResultIndex = 0 End If End Select End Function Public Function ExecuteQuery(ByRef sQuery As Object, ByRef sTable As Object, ByRef sAlert As Object, Optional ByVal sDelimiter As String = "HTML", Optional ByVal nLimit As Integer = 500) As Object ' '020610 JPC different handler for MV situation If Left(gsDataStore, 2) = "MV" Then 'UPGRADE_WARNING: Couldn't resolve default property of object ExecuteQueryMV(sQuery, sTable, sAlert, sDelimiter, nLimit). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm ExecuteQuery = ExecuteQueryMV(sQuery, sTable, sAlert, sDelimiter, nLimit) Exit Function End If ' '020409 JPC BREAK-ON support Dim sModifierPairs, sIdDict As String Dim sBreakMonitor() As String Dim bAlreadyBreak, bBreak As Boolean ' Dim b As Boolean Dim k, i, j, n As Integer ' Dim iMV, iC, iPos As Integer Dim nNoSpec, nID, nMV As Integer Dim nWidth, nCols, nWidthTotal As Integer ' Dim sQVal, s, sTemp, sQList As String Dim sId, sdItem As String Dim sFV, sFVDict As String Dim sSpec As String Dim sQSpec As String Dim saQSpecs() As String Dim saAlign() As String Dim saRow() As String 'Dim currTotals() As Decimal Dim bTotal As Boolean ' Dim sResponse As String ' Dim SB As StringBuilder '020313 JPC printing these reports 'Dim sPageHeading As String, naColPads() As Long, naColWidths() As Long ' '020221 JPC 'Queries are parsed inside PixieEngine and split into a SELECT to run with 'fields/attributes-as-column-headers returned here for analysis with a RREAD loop 'or similar ' 'Example, CUSTOMER query, raw sQuery = 'SORT AR BY ARCUST WITH ID HEADING "R-AR700 ** CUSTOMER LISTING ** PAGE'P' " ARCUST S.ARNAME ARCITY ARST ARZIP ARPHONE GM.SLSMN ID-SUPP ' 'sResponse = '0þ1441þARCUSTýS.ARNAMEýARCITYýARSTýARZIPýARPHONEýGM.SLSMNþþHEADINGý'R-AR700 (19544.467606366) ** CUSTOMER LISTING ** PAGE''P'' 'ýID-SUPPþþSELECT AR.A0 FROM AR WHERE AR.A0 > '' ORDER BY AR.A0 ' 'Dynamic variable string '<1> = "0" '<2> = number of rows '<3> = MV list of DictIDs '<4> = List of ItemIDs to use instead of Select by criteria '<5> = Options eg "COL-HDR-SUPP" '<6> = BY-EXP which needs separate treatment after remainder of query runs. '<7> = Interpreted SQL query ' 'Analysis code in the first place based on PX.BACKSRV as used 'by PixieWare for "PixieExcel" ' 'UPGRADE_WARNING: Couldn't resolve default property of object sAlert. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sAlert = "" 'UPGRADE_WARNING: Couldn't resolve default property of object sQuery. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sResponse = ExecutePS(sQuery) ExecuteQuery = sResponse 'UPGRADE_WARNING: Couldn't resolve default property of object Extract(sResponse, 3). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sQList = Extract(sResponse, 3) '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) & "ý" '011017 JPC Q.COLS builds column info for Excel etc ' 'UPGRADE_WARNING: Couldn't resolve default property of object sQuery. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm s = Replace(Trim(sQuery), " ", " ") Do b = False If InStr(s, " ") Then s = Replace(s, " ", " ") b = True End If If b = False Then Exit Do Loop 'UPGRADE_WARNING: Couldn't resolve default property of object sTable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sTable = Field(s, " ", 2) '020426 JPC cope with LIST DICT CUST etc 'UPGRADE_WARNING: Couldn't resolve default property of object sTable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If LCase(sTable) = "dict" Then s = Replace(s, " dict " & Field(s, " ", 3), " " & Field(s, " ", 3) & "_dict", 1, 1, 1) 'UPGRADE_WARNING: Couldn't resolve default property of object sTable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sTable = Field(s, " ", 2) End If ' If Not OOPen(sTable, sFV) Then 'UPGRADE_WARNING: Couldn't resolve default property of object sTable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm 'UPGRADE_WARNING: Couldn't resolve default property of object sAlert. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm sAlert = "Can not open file/table '" & sTable & "', System message(if any) = '" & ErrorDetail & "'" Exit Function End If ' '020426 JPC if no dict result here, then carry on, sFVDict = "" is no-dict flag 'UPGRADE_WARNING: Couldn't resolve default property of object sTable. Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm Call OOPen("DICT " & sTable, sFVDict) 'If Not OOPen("DICT " & sTable, sFVDict) Then ' sAlert = "Can not open file/table 'DICT " & sTable & "', System message(if any) = '" & ErrorDetail & "'" ' Exit Function 'End If ' 'UPGRADE_WARNING: Couldn't resolve default property of object DCount(sQList, Chr(253)). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm nCols = DCount(sQList, Chr(253)) If nCols >= 1 Then ReDim saQSpecs(nCols) For iC = 1 To nCols sIdDict = Field(sQList, Chr(253), iC) If Not RRead(saQSpecs(iC), sFVDict, sIdDict) Then If InStr(sIdDict, ".") Then 'Early version of PixieEditor may have wrongly changed "." to "_" for an itemid. Call RRead(saQSpecs(iC), sFVDict, Replace(sIdDict, ".", "_")) ElseIf UCase(Left(sIdDict, 1)) = "A" And IsNumeric(Mid(sIdDict, 2)) Then '020426 A1, A2, A3 etc saQSpecs(iC) = "Aþ" & Mid(sIdDict, 2) & "þ" & UCase(sIdDict) & "þþþþþþþþþþ" End If End If If saQSpecs(iC) > "" Then 'Check for a column header and if none, use the Dict item ID 'UPGRADE_WARNING: Couldn't resolve default property of object Extract(saQSpecs(iC), 3). Click for more: ms-help://MS.MSDNVS/vbcon/html/vbup1037.htm If Trim(Extract(saQSpecs(iC), 3)) = "" Then saQSpecs(iC) = RReplace(saQSpecs(iC), 3, sIdDict) End If 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 Else saQSpecs(iC) = "ERRORþþERROR(" & sIdDict & ")" End If Call CORREL_PROCESS(saQSpecs(iC), sFVDict) Next iC Else ' Cover case of "LIST MYFILE" where DICT MYFILE has default items 1, 2, 3, ... nNoSpec = 0 iC = 0 ReDim saQSpecs(0) For i = 1 To 1000 If RRead(sQSpec, sFVDict, i) Then iC = iC + 1 ReDim Preserve saQSpecs(iC) saQSpecs(iC) = sQSpec Call CORREL_PROCESS(saQSpecs(iC), sFVDict) Else nNoSpec = nNoSpec + 1 If nNoSpec = 4 Then Exit For End If Next i nCols = iC End If ' 'Begin building output SB = New StringBuilder If sDelimiter = "HTML" Then Call SB.Append("" & ControlChars.CrLf) Call SB.Append("