autochariot.bas

利用RS232做通訊 可以執行自動功能 謝謝大家使用

Attribute VB_Name = "AutoChariot"

'-----------------------------------------Chariot define two function-------------------------

Public Sub ChrPairsTestFun()

    Dim i As Integer
    Dim TestHandle As Long
    Dim PairHandle(100) As Long
    Dim Errorinfo As String
    Dim FileName As String
    Dim PairNumber As Integer
    Dim Pair(100) As Long
    Dim E1Point(100) As String
    Dim E2Point(100) As String
    Dim protocol(100) As String
    Dim ScriptFile(100) As String
    Dim isStopped As Boolean
    Dim Timer As Integer
    Dim avg(100) As Single
    Dim max(100) As Single
    Dim min(100) As Single
    
    Dim test1 As Long
    Frm_Series.Visible = False
    ChariotStatus.Visible = True
    
    
    
    
    
  '  i = test(5, 6)
  '  MsgBox (i)
    
  '  i = Multi(3, 23)
  '  MsgBox (i)
    
  ' TestString = "Sandy "
  '  MsgBox (TestString)
  '  sd = ReturnVc()
  '  MsgBox (sd)
     
  '--------------------------------------------------------------------Command distribution
         
    FileName = Cmd_Arr(1)
    PairNumber = Cmd_Arr(2)
    For i = 1 To PairNumber
        E1Point(i) = Cmd_Arr(4 * i - 1)
        E2Point(i) = Cmd_Arr(4 * i)
        protocol(i) = Cmd_Arr(4 * i + 1)
        ScriptFile(i) = Cmd_Arr(4 * i + 2)
    Next i
    
    
    
    
    
    
  '--------------------------------------------------------------------Program start
  
    
    ChariotStatus.List1.AddItem "Chariot Api initialize"
     
    rc = DLL_CHR_api_initialize_show_rc()
   
    If rc <> CHR_OK Then
        ChariotStatus.List1.AddItem "Initialization failed : rc = " + rc
        Errorinfo = DLL_CHR_api_initialize_show_error()
        ChariotStatus.List1.AddItem "Extended error info : " + Errorinfo
    Else
        ChariotStatus.List1.AddItem "Chariot API initialize success"
    End If
    
    '//  Create a new test  //
    ChariotStatus.List1.AddItem "Create the test"
    rc = DLL_CHR_test_new_show_rc()
    If rc <> CHR_OK Then
        Call show_error(rc, "Test_new")
    Else
        TestHandle = DLL_CHR_test_new_return_handle()
    End If
    rc = DLL_CHR_test_set_filename_show_rc(TestHandle, Cmd_Arr(1))
    If rc <> CHR_OK Then
        Call show_error(rc, "test_set_filename")
    End If
    
    '// Create a pair //
    
    ChariotStatus.List1.AddItem "Create Pairs   ...  "
    
    For i = 1 To PairNumber
        rc = DLL_CHR_pair_new_show_rc()
        If rc <> CHR_OK Then
            Call show_error(rc, "Pair_new")
        Else
            PairHandle(i) = DLL_CHR_pair_new_return_handle()
        End If
        
        ChariotStatus.List1.AddItem "Set pair attributes ..."
        ChariotStatus.List1.AddItem "Pair " + Str(i) + " Created"
        rc = DLL_CHR_pair_set_comment_show_rc(PairHandle(i))
        If rc <> CHR_OK Then
            Call show_error(rc, "pair_set_comment")
        End If
    
        rc = DLL_CHR_pair_set_e1_addr_show_rc(PairHandle(i), E1Point(i))
        If rc <> CHR_OK Then
            Call show_error(rc, "pair_set_e1_address")
        Else
            ChariotStatus.List1.AddItem "Pair " + Str(i) + "E1 address " + E1Point(i)
        End If
    
        rc = DLL_CHR_pair_set_e2_addr_show_rc(PairHandle(i), E2Point(i))
        If rc <> CHR_OK Then
            Call show_error(rc, "pair_set_e2_address")
        Else
            ChariotStatus.List1.AddItem "Pair " + Str(i) + "E2 address " + E2Point(i)
        End If
    
        rc = DLL_CHR_pair_set_protocol_show_rc(PairHandle(i), protocol(i))
        If rc <> CHR_OK Then
            Call show_error(rc, "pair_set_protocol")
        Else
            ChariotStatus.List1.AddItem "Pair " + Str(i) + "Protocol " + protocol(i)
        End If
        
        rc = DLL_CHR_pair_use_script_filename_show_rc(PairHandle(i), ScriptFile(i))
        If rc <> CHR_OK Then
            Call show_error(rc, "pair_use_script_filename")
        Else
            ChariotStatus.List1.AddItem "Pair " + Str(i) + "Script Filename " + ScriptFile(i)
        End If
    
    '//Add the pair to the test //
    
        rc = DLL_CHR_test_add_pair_show_rc(TestHandle, PairHandle(i))
        If rc <> CHR_OK Then
            Call show_error(rc, "test_add_pair")
        Else
            ChariotStatus.List1.AddItem "Pair " + Str(i) + "Added"
        End If
      
    Next i
    
    '//  The test is defined, Begin to run //
    
    ChariotStatus.List1.AddItem "Run the test ... "
    rc = DLL_CHR_test_start_show_rc(TestHandle)
    If rc <> CHR_OK Then
       Call show_error(rc, "start_test")
    End If
      
    ChariotStatus.List1.AddItem "Wait for the test to stop ..."
    isStopped = False
    Timer = 0
    
    Do While (Not isStopped And Timer < MaxWait)
        rc = DLL_CHR_test_query_stop_show_rc(TestHandle, Timeout)
        If rc = CHR_OK Then
        isStopped = True
        ElseIf rc = CHR_TIMED_OUT Then
                    Timer = Timer + Timeout
                    ChariotStatus.List1.AddItem "Waiting for test to stop" + "(" + Str(Timer) + ")"
               Else
                    Call show_error(rc, "test_query_stop")
        End If
    Loop
    
    If (Not isStopped) Then Call show_error(CHR_TIMED_OUT, "test_query_stop")
    
    '// Show Avg,Max,Min
    
    For i = 1 To PairNumber
        rc = DLL_CHR_pair_results_get_average_show_rc(PairHandle(i))
            If rc <> CHR_OK Then
                Call show_error(rc, "pair_results_get_average")
            Else
                avg(i) = DLL_CHR_pair_results_get_average_return_value()
            End If
        
        rc = DLL_CHR_pair_results_get_maximum_show_rc(PairHandle(i))
            If rc <> CHR_OK Then
                Call show_error(rc, "pair_results_get_maximum")
            Else
                max(i) = DLL_CHR_pair_results_get_maximum_return_value()
            End If
            
        rc = DLL_CHR_pair_results_get_minimum_show_rc(PairHandle(i))
            If rc <> CHR_OK Then
                Call show_error(rc, "pair_results_get_minimum")
            Else
                min(i) = DLL_CHR_pair_results_get_minimum_return_value()
            End If
        
         ChariotStatus.List1.AddItem "Throughtput : Avg =" + Str(avg(i)) + " Max =" + Str(max(i)) + "  Min =" + Str(min(i))
         
    Next i
    
    ChariotStatus.List1.AddItem "Save the test ..."
    
    rc = DLL_CHR_test_save(TestHandle)
    If rc <> CHR_OK Then
        Call show_error(rc, "test_save")
    End If
    
       
    
End Sub


Public Sub ChrGroupTestFun()

    Dim i, j, k As Integer
    Dim index As Integer
    Dim TestHandle As Long
    Dim RunoptsHandle As Long
    Dim DgoptHandle As Long
    Dim GroupHandle(100) As Long
    Dim mPairHandle(100) As Long
    Dim Errorinfo As String
    Dim FileName As String
    Dim MulticastNumber As Integer
    Dim MulticastAddr(100) As String
    Dim MulticastPort(100) As Integer
    Dim PairNumber(100) As Integer
    Dim Pair(100) As Long
    Dim E1Point(100) As String
    Dim MulticastGMember(100) As String
    Dim paircount As Integer
    Dim protocol(100) As String
    Dim ScriptFile(100) As String
    Dim isStopped As Boolean
    Dim Timer As Integer
    Dim avg(100) As Single
    Dim max(100) As Single
    Dim min(100) As Single
    
    Dim test1 As Long
    Frm_Series.Visible = False
    ChariotStatus.Visible = True
    
    
    
    
    
  '  i = test(5, 6)
  '  MsgBox (i)
    
  '  i = Multi(3, 23)
  '  MsgBox (i)
    
  ' TestString = "Sandy "
  '  MsgBox (TestString)
  '  sd = ReturnVc()
  '  MsgBox (sd)
     
  '--------------------------------------------------------------------Command distribution
    PairNumber(0) = 0
    paircount = 0
    FileName = Cmd_Arr(1)
    MulticastNumber = Cmd_Arr(2)
    
    For i = 1 To MulticastNumber
        MulticastAddr(i) = Cmd_Arr(3 + (i - 1) * (6 + PairNumber(i - 1)))
        MulticastPort(i) = Cmd_Arr(4 + (i - 1) * (6 + PairNumber(i - 1)))
        E1Point(i) = Cmd_Arr(5 + (i - 1) * (6 + PairNumber(i - 1)))
        PairNumber(i) = Cmd_Arr(6 + (i - 1) * (6 + PairNumber(i - 1)))
        For j = 1 To PairNumber(i)
            paircount = paircount + PairNumber(i - 1)
            MulticastGMember(j + paircount) = Cmd_Arr(6 + j + (i - 1) * (6 + PairNumber(i - 1)))
        Next j