modSendCommand Source Code

Option Explicit 

Public Const DP4_PX4_OLD_CFG_SIZE = 64 
Public Whitespace As String 

Public Function DP5_CMD(ByRef Buffer() As Byte, XmtCmd As TRANSMIT_PACKET_TYPE) As Boolean 
    Dim bCmdFound As Boolean 
    Dim iFileNum As Integer 
    Dim D As String 
    Dim bt As Byte 
    Dim idxData As Integer 
    Dim idxMiscData As Integer 
    Dim POUT As Packet_Out 
    Dim lLen As Long 
    Dim cstrCfg As String 
    Dim strTemp As String 
    
    bCmdFound = True 
    POUT.LEN = 0 

    Select Case XmtCmd 
        ''REQUEST_PACKETS_TO_DP5
        Case XMTPT_SEND_STATUS 
            POUT.PID1 = PID1_REQ_STATUS 
            POUT.PID2 = PID2_SEND_DP4_STYLE_STATUS 
        'Case XMTPT_SEND_SPECTRUM
        'Case XMTPT_SEND_CLEAR_SPECTRUM
        Case XMTPT_SEND_SPECTRUM_STATUS 
            POUT.PID1 = PID1_REQ_SPECTRUM 
            POUT.PID2 = PID2_SEND_SPECTRUM_STATUS   ' send spectrum & status
        Case XMTPT_SEND_CLEAR_SPECTRUM_STATUS 
            POUT.PID1 = PID1_REQ_SPECTRUM 
            POUT.PID2 = PID2_SEND_CLEAR_SPECTRUM_STATUS   ' send & clear spectrum & status
        'Case XMTPT_BUFFER_SPECTRUM
        'Case XMTPT_BUFFER_CLEAR_SPECTRUM
        'Case XMTPT_SEND_BUFFER
        'Case XMTPT_SEND_DP4_STYLE_STATUS
        'Case XMTPT_SEND_CONFIG
        Case XMTPT_SEND_SCOPE_DATA 
            POUT.PID1 = PID1_REQ_SCOPE_MISC 
            POUT.PID2 = PID2_SEND_SCOPE_DATA 
        Case XMTPT_SEND_512_BYTE_MISC_DATA 
            POUT.PID1 = PID1_REQ_SCOPE_MISC 
            POUT.PID2 = PID2_SEND_512_BYTE_MISC_DATA ' request misc data
        'Case XMTPT_SEND_SCOPE_DATA_REARM
        'Case XMTPT_SEND_ETHERNET_SETTINGS
        Case XMTPT_SEND_DIAGNOSTIC_DATA 
            POUT.PID1 = PID1_REQ_SCOPE_MISC 
            POUT.PID2 = PID2_SEND_DIAGNOSTIC_DATA   ' Request Diagnostic Packet
            POUT.LEN = 0 
        Case XMTPT_SEND_NETFINDER_PACKET 
            POUT.PID1 = PID1_REQ_SCOPE_MISC 
            POUT.PID2 = PID2_SEND_NETFINDER_READBACK   ' Request NetFinder Packet
            POUT.LEN = 0 
        'Case XMTPT_SEND_HARDWARE_DESCRIPTION
        'Case XMTPT_SEND_SCA
        'Case XMTPT_LATCH_SEND_SCA
        'Case XMTPT_LATCH_CLEAR_SEND_SCA
        'Case XMTPT_SEND_ROI_OR_FIXED_BLOCK
        Case XMTPT_PX4_STYLE_CONFIG_PACKET 
            iFileNum = FreeFile 
            Open App.Path & "\RAW.CFG" For Input As #iFileNum 
            For bt = 0 To 63 
                Input #iFileNum, D$ 
                POUT.DATA(bt) = Val("&H" + D$)
            Next 
            Close #iFileNum 
            POUT.PID1 = PID1_REQ_CONFIG 
            POUT.PID2 = PID2_PX4_STYLE_CONFIG_PACKET   ' PX4-style config packet
            POUT.LEN = DP4_PX4_OLD_CFG_SIZE 
            
'''''        Case XMTPT_SEND_CONFIG_PACKET_TO_HW
'''''                Do
'''''                    Line Input #iFileNum, S$
'''''                    S$ = StrConv(S$, vbUpperCase)   ' convert line to upper case
'''''                    If (Left(S$, 1) >= "A") And (Left(S$, 1) <= "Z") And (InStr(S$, ";") > 0) Then ' for command, first character on line has to be uppercase alpha and ends with ';'
'''''                        S$ = Left(S$, InStr(S$, ";"))
'''''                        For X = 1 To Len(S$)
'''''                            If InStr(1, Whitespace$, Mid$(S$, X, 1)) = 0 Then
'''''                                D$ = D$ + Mid$(S$, X, 1)    ' add character to command string if not whitespace
'''''                            End If
'''''                        Next X
'''''                    End If
'''''                Loop While Not EOF(1)
'''''                For idxData = 1 To Len(D$)
'''''                    POUT.DATA(idxData - 1) = Asc(Mid(D$, idxData, 1))
'''''                Next idxData
'''''                Close #iFileNum
'''''                POUT.PID1 = PID1_REQ_CONFIG
'''''                POUT.PID2 = PID2_TEXT_CONFIG_PACKET   ' text config packet
'''''                POUT.LEN = Len(D$)
''''''            End If
        Case XMTPT_SEND_CONFIG_PACKET_TO_HW 
            cstrCfg = "" 
            cstrCfg = s.HwCfgDP5Out 

            If (s.profile.SendCoarseFineGain) Then 
                cstrCfg = RemoveCmd("GAIN", cstrCfg)
            Else 
                cstrCfg = RemoveCmd("GAIA", cstrCfg)
                cstrCfg = RemoveCmd("GAIF", cstrCfg)
            End If 
            
            cstrCfg = RemoveCmdByDeviceType(cstrCfg, STATUS.PC5_PRESENT, STATUS.DEVICE_ID, STATUS.isDP5_RevDxGains, STATUS.DPP_ECO)

            '''''==== remove whitespace ====================================================
            ''''lLen = Len(cstrCfg)
            ''''strTemp = cstrCfg
            ''''cstrCfg = ""
            ''''If (lLen > 0) Then
            ''''    For idxData = 1 To lLen
            ''''        If InStr(1, Whitespace, Mid(strTemp, idxData, 1)) = 0 Then
            ''''            cstrCfg = cstrCfg & Mid(strTemp, idxData, 1)  'append non-whitespace chars
            ''''        End If
            ''''    Next
            ''''End If
            '''''==== remove whitespace ====================================================
            
            lLen = Len(cstrCfg)
            If (lLen > 0) Then 
                For idxData = 1 To lLen 
                    POUT.DATA(idxData - 1) = Asc(Mid(cstrCfg, idxData, 1))
                Next 
            End If 
            POUT.PID1 = PID1_REQ_CONFIG 
            POUT.PID2 = PID2_TEXT_CONFIG_PACKET  ' text config packet
            POUT.LEN = lLen 
        Case XMTPT_SEND_CONFIG_PACKET_EX           ' bypass any filters
            cstrCfg = "" 
            cstrCfg = s.HwCfgDP5Out 
            lLen = Len(cstrCfg)
            If (lLen > 0) Then 
                For idxData = 1 To lLen 
                    POUT.DATA(idxData - 1) = Asc(Mid(cstrCfg, idxData, 1))
                Next 
            End If 
            POUT.PID1 = PID1_REQ_CONFIG 
            POUT.PID2 = PID2_TEXT_CONFIG_PACKET  ' text config packet
            POUT.LEN = lLen 
         Case XMTPT_READ_CONFIG_PACKET 
            cstrCfg = "" 
            cstrCfg = s.HwRdBkDP5Out 
            lLen = Len(cstrCfg)
            If (lLen > 0) Then 
                For idxData = 1 To lLen 
                    POUT.DATA(idxData - 1) = Asc(Mid(cstrCfg, idxData, 1))
                Next 
            End If 
            POUT.PID1 = PID1_REQ_CONFIG 
            POUT.PID2 = PID2_CONFIG_READBACK_PACKET   ' read config packet
            POUT.LEN = lLen 
         Case XMTPT_FULL_READ_CONFIG_PACKET 
            cstrCfg = "" 
            cstrCfg = CreateFullReadBackCmd()

            lLen = Len(cstrCfg)
            If (lLen > 0) Then 
                For idxData = 1 To lLen 
                    POUT.DATA(idxData - 1) = Asc(Mid(cstrCfg, idxData, 1))
                Next 
            End If 
            POUT.PID1 = PID1_REQ_CONFIG 
            POUT.PID2 = PID2_CONFIG_READBACK_PACKET   ' read config packet
            POUT.LEN = lLen 
        Case XMTPT_ERASE_FPGA_IMAGE 
            POUT.PID1 = PID1_REQ_FPGA_UC 
            POUT.PID2 = PID2_ERASE_FPGA_IMAGE 
            POUT.LEN = 2 
            POUT.DATA(0) = &H12 
            POUT.DATA(1) = &H34 
        'Case XMTPT_UPLOAD_PACKET_FPGA
        'Case XMTPT_REINITIALIZE_FPGA
        'Case XMTPT_ERASE_UC_IMAGE_0
        Case XMTPT_ERASE_UC_IMAGE_1 
            POUT.PID1 = PID1_REQ_FPGA_UC 
            POUT.PID2 = PID2_ERASE_UC_IMAGE_1   ' erase image #1 (sector 5)
            POUT.LEN = 2 
            POUT.DATA(0) = &H12 
            POUT.DATA(1) = &H34 
        
        'Case XMTPT_ERASE_UC_IMAGE_2
        'Case XMTPT_UPLOAD_PACKET_UC
        'Case XMTPT_SWITCH_TO_UC_IMAGE_0
        Case XMTPT_SWITCH_TO_UC_IMAGE_1 
            POUT.PID1 = PID1_REQ_FPGA_UC 
            POUT.PID2 = PID2_SWITCH_TO_UC_IMAGE_1   ' switch to uC image #1
            POUT.LEN = 2 
            POUT.DATA(0) = &HA5 ' uC FLASH unlock keys
            POUT.DATA(1) = &HF1 
        'Case XMTPT_SWITCH_TO_UC_IMAGE_2
        'Case XMTPT_UC_FPGA_CHECKSUMS

        ''VENDOR_REQUESTS_TO_DP5
        'Case XMTPT_CLEAR_SPECTRUM_BUFFER
        Case XMTPT_ENABLE_MCA_MCS 
            POUT.PID1 = PID1_VENDOR_REQ 
            POUT.PID2 = PID2_ENABLE_MCA_MCS 
            POUT.LEN = 0 
        Case XMTPT_DISABLE_MCA_MCS 
            POUT.PID1 = PID1_VENDOR_REQ 
            POUT.PID2 = PID2_DISABLE_MCA_MCS 
            POUT.LEN = 0 
        Case XMTPT_ARM_DIGITAL_OSCILLOSCOPE 
            POUT.PID1 = PID1_VENDOR_REQ 
            POUT.PID2 = PID2_ARM_DIGITAL_OSCILLOSCOPE   ' arm trigger
        'Case XMTPT_AUTOSET_INPUT_OFFSET
        'Case XMTPT_AUTOSET_FAST_THRESHOLD
        'Case XMTPT_READ_IO3_0
        'Case XMTPT_WRITE_IO3_0
        'Case XMTPT_SET_DCAL
        'Case XMTPT_SET_PZ_CORRECTION_UC_TEMP_CAL
        'Case XMTPT_SET_PZ_CORRECTION_UC_TEMP_CAL
        'Case XMTPT_SET_BOOT_FLAGS
        'Case XMTPT_SET_HV_DP4_EMULATION
        'Case XMTPT_SET_TEC_DP4_EMULATION
        'Case XMTPT_SET_INPUT_OFFSET_DP4_EMULATION
        'Case XMTPT_SET_ADC_CAL_GAIN_OFFSET
        'Case XMTPT_SET_SPECTRUM_OFFSET
        'Case XMTPT_REQ_SCOPE_DATA_MISC_DATA_SCA_PACKETS
        'Case XMTPT_SET_SERIAL_NUMBER
        'Case XMTPT_CLEAR_GP_COUNTER
        'Case XMTPT_SWITCH_SUPPLIES
        'Case XMTPT_SEND_TEST_PACKET
        
        Case Else 
            bCmdFound = False 
    End Select 
    
    If bCmdFound Then 
        If (Not POUT_Buffer(POUT, Buffer())) Then 
            bCmdFound = False 
        End If 
    End If 
    DP5_CMD = bCmdFound 
End Function 

Public Function DP5_CMD_Data(ByRef Buffer() As Byte, XmtCmd As TRANSMIT_PACKET_TYPE, DataOut As VariantAs Boolean 
    Dim bCmdFound As Boolean 
    Dim idxData As Integer 
    Dim idxMiscData As Integer 
    Dim POUT As Packet_Out 
    Dim PktLen As Integer 
    
    bCmdFound = False 
    POUT.LEN = 0 
    Select Case XmtCmd 
        Case XMTPT_WRITE_512_BYTE_MISC_DATA 
            POUT.PID1 = PID1_VENDOR_REQ 
            POUT.PID2 = PID2_WRITE_512_BYTE_MISC_DATA ' write misc data
            POUT.LEN = 512 
            For idxMiscData = 0 To 511 
                POUT.DATA(idxMiscData) = Asc(Mid(DataOut + String(512, 0), idxMiscData + 1, 1))
            Next idxMiscData 
            bCmdFound = True 
            If (Not POUT_Buffer(POUT, Buffer())) Then 
                bCmdFound = False 
            End If 
        Case XMTPT_SEND_TEST_PACKET 
            If (Not IsMissing(DataOut)) Then 
                PktLen = Len(DataOut)
                If (PktLen >= 8) Then 
                    For idxData = 0 To PktLen - 1 
                        Buffer(idxData) = CLng(DataOut(idxData))
                    Next 
                    bCmdFound = True 
                End If 
            End If 
        Case Else 
            bCmdFound = False 
    End Select 
    DP5_CMD_Data = bCmdFound 
End Function 

Public Function POUT_Buffer(POUT As Packet_Out, ByRef Buffer() As ByteAs Boolean 
    Dim idxBuffer As Integer 
    Dim CS As Long 
    On Error GoTo POUT_BufferErr 
    
    If (UBound(Buffer) < POUT.LEN + 7) Then ReDim Buffer(POUT.LEN + 7)
    Buffer(0) = SYNC1_ 
    Buffer(1) = SYNC2_ 
    Buffer(2) = POUT.PID1 
    Buffer(3) = POUT.PID2 
    Buffer(4) = (POUT.LEN And &HFF00) \ 256 
    Buffer(5) = POUT.LEN And &HFF 

    CS = SYNC1_ + SYNC2_ + POUT.PID1 + POUT.PID2 + (POUT.LEN And &HFF00) \ 256 + (POUT.LEN And &HFF)

    If POUT.LEN > 0 Then 
        For idxBuffer = 0 To POUT.LEN - 1 
            Buffer(idxBuffer + 6) = POUT.DATA(idxBuffer)
            CS = CS + POUT.DATA(idxBuffer)
        Next idxBuffer 
    End If 
    CS = (CS Xor &HFFFF&) + 1 
    Buffer(POUT.LEN + 6) = (CS And &HFF00) \ 256 
    Buffer(POUT.LEN + 7) = CS And &HFF 
    POUT_Buffer = True 
    Exit Function 
POUT_BufferErr: 
    POUT_Buffer = False 
End Function