testmodule2.bas

来自「一个VB实现串口通讯的经典示例.非常简明, 使用, 本人大部分通讯程序与之类同」· BAS 代码 · 共 73 行

Attribute VB_Name = "TestModule2"
Option Explicit

Public bQuitApp As Boolean, bAppRunning As Boolean

' This module is for testing repeating sending ATE commands

Sub TestLoop2()
Dim lTrials As Long, i As Integer, bError As Boolean
Dim iConsecutiveFailureCount As Integer

    frmMain.DisplayMsg "Test Loop starts"
    
    frmMain.StopTestLoop = False
    
    Do While Not frmMain.StopTestLoop And Not oComm.Connect(sUUT, False)
        DoEvents
        Sleep 1000
    Loop
    frmMain.DisplayMsg sUUT & " Connected"
    bAppRunning = True
    
    Do While Not frmMain.StopTestLoop
        lTrials = lTrials + 1
        iConsecutiveFailureCount = 0
        
        ' try until I2C connected
        With oComm
            DoEvents
            For i = 1 To 100
                bError = False
                
                If frmMain.StopTestLoop Then Exit For
                
                If aAteCommand(i) <> Empty Then
                    frmMain.DisplayMsg lTrials & ". Send AteCmd " & i, False
                    .SendHex aAteCommand(i)
                    .ReadBytes (Len(aAteResponse(i)) + 1) \ 3, , lfAteCmdTimeout
                    
                    If .ResultHexStr <> aAteResponse(i) Then
                        frmMain.DisplayMsg "AteCmd" & i & " response incorrect !"
                        oResultLog.WriteLine ":" & .ResultHexStr
                        bError = True
                    End If

                    If bError Then
                        frmMain.DisplayMsg "Invalid response"
                        frmMain.UpCountFailure
                        'oResultLog.WriteLine ":" & .ResultHexStr
                        
                        If Len(.ResultHexStr) <> Len(aAteResponse(i)) And bStopOnLengthError _
                            Or bStopOnContentError Then
                            
                            frmMain.StopTestLoop = True
                            .CloseComm
                            MsgBox "Error occurred !" & vbCrLf & .ResultHexStr, vbCritical, "Error"
                        End If
                        
                        Exit For
                    End If
                    
                    Sleep iPauseBetweenAteCmd
                End If
            Next
        End With
    Loop
    
    frmMain.DisplayMsg "Test loop stopped !"
    bAppRunning = False
    If bQuitApp Then Unload frmMain
End Sub