VBCommons/dev/API_MockInteraction.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "API_MockInteraction"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'================ Mock <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> =========================
' Shared module version: 20210331
' Depends on: DevTester, API_UserInteraction
' Required reference:
Option Explicit
Implements API_UserInteraction

Private Enum InteractionType
  T_UI_INVALID = 0
  T_UI_MESSAGE
  T_UI_QUESTION
  T_UI_PROMPT_INPUT
  T_UI_PROMPT_FILE
  T_UI_FOLLOW_HYPERLINK
End Enum

Private Type ExpectationInfo
  type_ As InteractionType
  id_ As Long
  response_ As String
End Type

Private types_ As Collection ' of InteractionType
Private ids_ As Collection ' of Long
Private responses_ As Collection ' of String

Private Sub Class_Initialize()
  Call ResetCollection
End Sub

Public Function ExpectNoInteraction()
  Call ResetExpectations
End Function

Public Function ExpectMessage(nMsg&)
  Call AddExpectation(T_UI_MESSAGE, nMsg)
End Function

Public Function ExpectQuestion(nMsg&, bAnswerYes As Boolean)
  Call AddExpectation(T_UI_QUESTION, nMsg, IIf(bAnswerYes, "YES", "NO"))
End Function

Public Function ExpectInputPrompt(sResponse$)
  Call AddExpectation(T_UI_PROMPT_INPUT, sResponse:=sResponse)
End Function

Public Function ExpectFilePrompt(sResponse$)
  Call AddExpectation(T_UI_PROMPT_FILE, sResponse:=sResponse)
End Function

Public Function ExpectFollowHyperlink(sLink$)
  Call AddExpectation(T_UI_FOLLOW_HYPERLINK, sResponse:=sLink)
End Function

Public Function ResetExpectations() As Boolean
  ResetExpectations = ids_.Count = 0
  If ResetExpectations Then _
    Exit Function
    
  Dim sMsg$: sMsg = "Unrealized expectations: "
  Dim info As ExpectationInfo
  Do While ids_.Count <> 0
    sMsg = sMsg & vbNewLine & InfoToString(PopExpectation)
  Loop
  Call Dev_LogMsg(sMsg)
End Function

Public Function API_UserInteraction_ShowMessage(nMsg&, ParamArray params() As Variant)
  Dim iExpected As ExpectationInfo: iExpected = PopExpectation
  If iExpected.type_ = T_UI_INVALID Then _
    Call Err.Raise(UNEXPECTED_INTERACTION, Description:="ShowMessage " & nMsg)
    
  Dim iActual As ExpectationInfo
  iActual.type_ = T_UI_MESSAGE
  iActual.id_ = nMsg
  iActual.response_ = vbNullString
  
  If Not CompareInfo(iActual, iExpected) Then _
    Call Dev_LogMsg(Fmt("Unrecognized interaction" & vbNewLine & _
                        "Expected: {1}" & vbNewLine & _
                        "Actual: {2}", _
                        InfoToString(iExpected), InfoToString(iActual)))
End Function

Public Function API_UserInteraction_AskQuestion(nQuestion&, ParamArray params() As Variant) As Boolean
  Dim iExpected As ExpectationInfo: iExpected = PopExpectation
  If iExpected.type_ = T_UI_INVALID Then _
    Call Err.Raise(UNEXPECTED_INTERACTION, Description:="AskQuestion " & nQuestion)
    
  Dim iActual As ExpectationInfo
  iActual.type_ = T_UI_QUESTION
  iActual.id_ = nQuestion
  
  If Not CompareInfo(iActual, iExpected) Then _
    Call Dev_LogMsg(Fmt("Unrecognized interaction" & vbNewLine & _
                        "Expected: {1}" & vbNewLine & _
                        "Actual: {2}", _
                        InfoToString(iExpected), InfoToString(iActual)))
  API_UserInteraction_AskQuestion = iExpected.response_ = "YES"
End Function

Public Function API_UserInteraction_PromptInput( _
                                  sPrompt$, _
                                  Optional sTitle$ = vbNullString, _
                                  Optional sInitial As Variant) As String
  Dim iExpected As ExpectationInfo: iExpected = PopExpectation
  If iExpected.type_ = T_UI_INVALID Then _
    Call Err.Raise(UNEXPECTED_INTERACTION, Description:="PromptInput")
    
  Dim iActual As ExpectationInfo
  iActual.type_ = T_UI_PROMPT_INPUT
  
  If Not CompareInfo(iActual, iExpected) Then _
    Call Dev_LogMsg(Fmt("Unrecognized interaction" & vbNewLine & _
                        "Expected: {1}" & vbNewLine & _
                        "Actual: {2}", _
                        InfoToString(iExpected), InfoToString(iActual)))
  API_UserInteraction_PromptInput = iExpected.response_
End Function

Public Function API_UserInteraction_PromptFileFilter( _
                                  sInitialPath$, sDescription$, sFilter$, _
                                  Optional sTitle$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>", _
                                  Optional bNewApplication As Boolean = False) As String
  Dim iExpected As ExpectationInfo: iExpected = PopExpectation
  If iExpected.type_ = T_UI_INVALID Then _
    Call Err.Raise(UNEXPECTED_INTERACTION, Description:="PromptFileFilter")
    
  Dim iActual As ExpectationInfo
  iActual.type_ = T_UI_PROMPT_FILE
  
  If Not CompareInfo(iActual, iExpected) Then _
    Call Dev_LogMsg(Fmt("Unrecognized interaction" & vbNewLine & _
                        "Expected: {1}" & vbNewLine & _
                        "Actual: {2}", _
                        InfoToString(iExpected), InfoToString(iActual)))
  API_UserInteraction_PromptFileFilter = iExpected.response_
End Function

Public Function API_UserInteraction_PromptFile(sInitialPath$, _
                                  Optional sTitle$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>", _
                                  Optional cDescriptions As Collection = Nothing, _
                                  Optional cFilters As Collection = Nothing, _
                                  Optional bNewApplication As Boolean = False) As String
  Dim iExpected As ExpectationInfo: iExpected = PopExpectation
  If iExpected.type_ = T_UI_INVALID Then _
    Call Err.Raise(UNEXPECTED_INTERACTION, Description:="PromptFile")
    
  Dim iActual As ExpectationInfo
  iActual.type_ = T_UI_PROMPT_FILE
  
  If Not CompareInfo(iActual, iExpected) Then _
    Call Dev_LogMsg(Fmt("Unrecognized interaction" & vbNewLine & _
                        "Expected: {1}" & vbNewLine & _
                        "Actual: {2}", _
                        InfoToString(iExpected), InfoToString(iActual)))
  API_UserInteraction_PromptFile = iExpected.response_
End Function

Public Function API_UserInteraction_PromptFolder(sInitialPath$, _
                                  Optional sTitle$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>", _
                                  Optional bNewApplication As Boolean = False) As String
  Dim iExpected As ExpectationInfo: iExpected = PopExpectation
  If iExpected.type_ = T_UI_INVALID Then _
    Call Err.Raise(UNEXPECTED_INTERACTION, Description:="PromptFile")
    
  Dim iActual As ExpectationInfo
  iActual.type_ = T_UI_PROMPT_FILE
  
  If Not CompareInfo(iActual, iExpected) Then _
    Call Dev_LogMsg(Fmt("Unrecognized interaction" & vbNewLine & _
                        "Expected: {1}" & vbNewLine & _
                        "Actual: {2}", _
                        InfoToString(iExpected), InfoToString(iActual)))
  API_UserInteraction_PromptFolder = iExpected.response_
End Function

Public Function API_UserInteraction_FollowHyperlink(oDocument As Object, sAddress$)
  Dim iExpected As ExpectationInfo: iExpected = PopExpectation
  If iExpected.type_ = T_UI_INVALID Then _
    Call Err.Raise(UNEXPECTED_INTERACTION, Description:="FollowHyperlink")
    
  Dim iActual As ExpectationInfo
  iActual.type_ = T_UI_FOLLOW_HYPERLINK
  
  If Not CompareInfo(iActual, iExpected) Then _
    Call Dev_LogMsg(Fmt("Unrecognized interaction" & vbNewLine & _
                        "Expected: {1}" & vbNewLine & _
                        "Actual: {2}", _
                        InfoToString(iExpected), InfoToString(iActual)))
End Function

' =====
Private Function ResetCollection()
  Set ids_ = New Collection
  Set types_ = New Collection
  Set responses_ = New Collection
End Function

Private Function AddExpectation(nType As InteractionType, Optional nID& = 0, Optional sResponse$ = vbNullString)
  Call types_.Add(nType)
  Call ids_.Add(nID)
  Call responses_.Add(sResponse)
End Function

Private Function PopExpectation() As ExpectationInfo
  If ids_.Count = 0 Then
    PopExpectation.id_ = T_UI_INVALID
    Exit Function
  End If
  
  PopExpectation.id_ = ids_.Item(1)
  PopExpectation.type_ = types_.Item(1)
  PopExpectation.response_ = responses_.Item(1)
  
  Call ids_.Remove(1)
  Call types_.Remove(1)
  Call responses_.Remove(1)
End Function

Private Function InfoToString(target As ExpectationInfo) As String
  Select Case target.type_
    Case T_UI_MESSAGE: InfoToString = "Message " & target.id_
    Case T_UI_QUESTION: InfoToString = "Question " & target.id_
    Case T_UI_PROMPT_INPUT: InfoToString = "InputBox with response " & target.response_
    Case T_UI_PROMPT_FILE: InfoToString = "FilePromp with response " & target.response_
    Case T_UI_FOLLOW_HYPERLINK: InfoToString = "Follow hyperlink " & target.response_
  End Select
End Function

Private Function CompareInfo(val1 As ExpectationInfo, val2 As ExpectationInfo) As Boolean
  CompareInfo = False
  If val1.id_ <> val2.id_ Then _
    Exit Function
  If val1.type_ <> val2.type_ Then _
    Exit Function
  CompareInfo = True
End Function