⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainmodule.bas

📁 一个VB实现串口通讯的经典示例.非常简明, 使用, 本人大部分通讯程序与之类同
💻 BAS
字号:
Attribute VB_Name = "MainModule"
Option Explicit

Public Declare Sub WritePortLpt Lib "8255dll.dll" (ByRef Port As Long, ByRef Data As Long)
Public Declare Sub ReadPortLpt Lib "8255dll.dll" (ByRef Port As Long, ByRef Data As Long)

Public oComm As New clsComm, _
    oResultLog As New clsLog, _
    oLog As New clsLog, _
    oIni As New clsIni

Public iPauseAfterBsUp As Integer, iPauseAfterPowerOff As Integer
Public iPauseBetweenAteCmd As Integer, iPauseAfterI2CUp As Integer, lfAteCmdTimeout As Double
Public bStopOnLengthError As Boolean, bStopOnContentError As Boolean
Public aAteCommand(1 To 100) As Variant, aAteResponse(1 To 100) As Variant
Public sUUT As String

'Sub Main()
'    With oResultLog
'        .OpenLog App.Path & "\410KBs.txt"
'        .WriteLine "--- Start on " & Format(Now, "yyyy mmm dd hh:mm:ss")
'    End With
'
'    frmMain.Show vbModal
'End Sub

Sub Init()
Dim i As Integer, sCmd As String, sRes As String

    oIni.FileName = App.Path & "\410kbs.ini"
    
    iPauseAfterI2CUp = CInt(oIni.GetVar("PauseAfterI2CUp"))
    If iPauseAfterI2CUp = 0 Then
        frmMain.DisplayMsg "Cannot access var PauseAfterPower"
        Exit Sub
    End If
    iPauseAfterBsUp = CInt(oIni.GetVar("PauseAfterBsUp"))
    frmMain.DisplayMsg "PauseAfterBsUp= " & iPauseAfterBsUp & " s"
    iPauseAfterPowerOff = CInt(oIni.GetVar("PauseAfterPowerOff"))
    frmMain.DisplayMsg "PauseAfterPowerOff = " & iPauseAfterPowerOff & " s"
    frmMain.DisplayMsg "PauseAfterI2CUp = " & iPauseAfterI2CUp & " s"
    iPauseBetweenAteCmd = CInt(oIni.GetVar("PauseBetweenAteCmd"))
    frmMain.DisplayMsg "PauseBetweenAteCmd = " & iPauseBetweenAteCmd & " ms"
    
    If oIni.GetVar("StopOnLengthError") = "1" Then bStopOnLengthError = True
    frmMain.DisplayMsg "Stop on ATE cmd length error ? " & IIf(bStopOnLengthError, "Yes", "No")
    
    If oIni.GetVar("StopOnContentError") = "1" Then bStopOnContentError = True
    frmMain.DisplayMsg "Stop on ATE cmd content error ? " & IIf(bStopOnContentError, "Yes", "No")
    
    lfAteCmdTimeout = CDbl(oIni.GetVar("AteCmdTimeout"))
    frmMain.DisplayMsg "Ate Cmd timeout = " & lfAteCmdTimeout & " s"
    
    sUUT = oIni.GetVar("UUT")
    frmMain.DisplayMsg "UUT = " & sUUT
    
    For i = 1 To 100
        sCmd = oIni.GetVar("atecmd" & i)
        sRes = oIni.GetVar("ateres" & i)
        If sCmd <> Empty Then
            aAteCommand(i) = sCmd
            aAteResponse(i) = sRes
            
            frmMain.DisplayMsg "ATECmd" & i & "=" & sCmd
            frmMain.DisplayMsg "ATERes" & i & "=" & sRes
        End If
    Next
    
    'init comm port
    With oComm
        .AssignComm frmMain.MSComm1, frmMain.lstAteCmd, frmMain.lstMsg
        .Baud = 115200
        .OpenComm
    End With
End Sub

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

    frmMain.DisplayMsg "Test Loop starts"
    WritePortLpt 3, 128
    
    frmMain.StopTestLoop = True
    
    Do While frmMain.StopTestLoop
        lTrials = lTrials + 1
        iConsecutiveFailureCount = 0
        
        ' power off BS and I2C
        WritePortLpt 0, 0
        frmMain.DisplayMsg lTrials & ". Power off"
        Sleep iPauseAfterPowerOff
        
        ' power on base
        WritePortLpt 0, 4
        frmMain.DisplayMsg lTrials & ". Power on base"
        Sleep iPauseAfterBsUp
        
        ' power on I2C
        WritePortLpt 0, 12
        frmMain.DisplayMsg lTrials & ". Power on I2C"
        
        Sleep iPauseAfterI2CUp
        
        ' try until I2C connected
        With oComm
            Do While frmMain.StopTestLoop And Not .Connect("fp", False)
                DoEvents
                Sleep 1
            Loop
            
            frmMain.DisplayMsg "FP Connected"
            
            For i = 1 To 100
                bError = False
                
                If Not 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
                    
'                    If .ResultHexStr <> aAteResponse(i) Then
'                        frmMain.DisplayMsg "AteCmd" & i & " response incorrect !"
'                        oResultLog.WriteLine ":" & .ResultHexStr
'                        Exit For
'                    End If

                    If i > 1 Then
                        If UBound(.ResultBytes) < 10 Then
                            bError = True
                        Else
                            If .ResultBytes(9) = 0 And .ResultBytes(10) = 0 Then
                                bError = True
                                iConsecutiveFailureCount = iConsecutiveFailureCount + 1
                            End If
                        End If
                    End If
                    
                    If bError And iConsecutiveFailureCount >= 3 Then
                        frmMain.DisplayMsg "3 read DSP values are zero !"
                        frmMain.UpCountFailure
                        oResultLog.WriteLine ":" & .ResultHexStr
                        Exit For
                    End If
                    
                    Sleep iPauseBetweenAteCmd
                End If
            Next
        End With
    Loop
    
    frmMain.DisplayMsg "Test loop stopped !"
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -