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 взаимодействия с пользователем ========================= ' 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$ = "Выберите файл", _ 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$ = "Выберите файл", _ 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$ = "Выберите каталог", _ 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