frmwiretest.frm

来自「电梯检测系统是对电梯性能进行检测的系统。是一个用来学习的程序。」· FRM 代码 · 共 1,274 行 · 第 1/3 页

        
      
        '写入output buffer
        ReadCom.Output = bSndAry
 
        '读取input buffer全部数据
        iLenB = iLen * 2
        sTime = Timer
        bolReadPlcB_03 = True
        Do While bolReadPlcB_03
           If ReadCom.InBufferCount >= iLenB + 5 Then
              bolReadPlcB_03 = True
              Exit Do
           End If
           cTime = Timer
           If (cTime - sTime) > cTimeOut Then
              bolReadPlcB_03 = False
           Else
              If (Timer - sTime) < 0 Then sTime = Timer
           End If
          ' Dummy = DoEvents()
        Loop
 
        If bolReadPlcB_03 Then
           vRetAryB = ReadCom.Input
           vCrc = CrcB(vRetAryB, iLenB + 3)
           If vRetAryB(0) <> bSndAry(0) Or vRetAryB(1) <> bSndAry(1) Or _
              vCrc(0) <> vRetAryB(iLenB + 3) Or vCrc(1) <> vRetAryB(iLenB + 4) Then
              
              bolReadPlcB_03 = False
                '设置运行状态信号灯
              Exit Function
           End If
        End If
        
        
        
        Exit Function
       
        
readplcerr:
        bolReadPlcB_03 = False
        '设置运行状态信号灯
End Function


Sub ShowErrorText(number As Integer)
  Dim TempValue As Byte
  Dim TempI As Long
  Open App.Path & "\ErrReport\" & TempFileName & "Err.txt" For Append As #1
  Select Case number
    Case 1
      If SignalBitRight(LngVRetAryB, iXPOWER1 - 16, 0) Then
        Print #1, , "iXPOWER1 = " & 0
      End If
      If SignalBitRight(LngVRetAryB, iXPOWER2 - 16, 1) Then
        Print #1, , "iXPOWER2 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXLight1 - 16, 1) Then
        Print #1, , "iXlight1 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXLight2 - 16, 1) Then
        Print #1, , "iXLight2 = " & 1
      End If
    Case 2
      If SignalBitRight(LngVRetAryB, iXPOWER1 - 16, 1) Then
        Print #1, , "iXPOWER1 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXPOWER2 - 16, 0) Then
        Print #1, , "iXPOWER2 = " & 0
      End If
      If SignalBitRight(LngVRetAryB, iXLight1 - 16, 1) Then
        Print #1, , "iXlight1 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXLight2 - 16, 1) Then
        Print #1, , "iXLight2 = " & 1
      End If
    Case 3
      If SignalBitRight(LngVRetAryB, iXPOWER1 - 16, 1) Then
        Print #1, , "iXPOWER1 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXPOWER2 - 16, 1) Then
        Print #1, , "iXPOWER2 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXLight1 - 16, 0) Then
        Print #1, , "iXlight1 = " & 0
      End If
      If SignalBitRight(LngVRetAryB, iXLight2 - 16, 1) Then
        Print #1, , "iXLight2 = " & 1
      End If
    Case 4
      If SignalBitRight(LngVRetAryB, iXPOWER1 - 16, 1) Then
        Print #1, , "iXPOWER1 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXPOWER2 - 16, 1) Then
        Print #1, , "iXPOWER2 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXLight1 - 16, 1) Then
        Print #1, , "iXlight1 = " & 1
      End If
      If SignalBitRight(LngVRetAryB, iXLight2 - 16, 0) Then
        Print #1, , "iXLight2 = " & 0
      End If
  End Select
  Close #1
  SetWindowPos FrmErrorMsg.hwnd, HWND_TOPMOST, 200, 160, 350, 230, SWP_SHOWWINDOW
  FrmErrorMsg.ReusultText.Text = ""
  FrmErrorMsg.ReusultText.FileName = App.Path & "\ErrReport\" & TempFileName & "Err.txt"
  
End Sub

Sub ShowErrorTextbak(ErrId As String)

Dim TempStr As String
TempStr = TempStr & GetFromINI("wireerrorinfo", Trim$(ErrId) & "-1", App.Path & "\ini\wireinfo.ini")
TempStr = TempStr & Chr(10) & Chr(13) & GetFromINI("wireerrorinfo", Trim$(ErrId) & "-2", App.Path & "\ini\wireinfo.ini")
TempStr = TempStr & Chr(10) & Chr(13) & GetFromINI("wireerrorinfo", Trim$(ErrId) & "-3", App.Path & "\ini\wireinfo.ini")
FrmErrorMsg.Show
FrmErrorMsg.ReusultText = TempStr

End Sub

' Save picCanvas's original bitmap bytes,
' initialize values, and draw the initial picture.
Private Sub Form_Load()
  Dim i As Integer
  Dim CurSendSucc As Boolean
  Dim cTime As Single
  WireNum = 0
  WireInput.Text = ""
  TestResult.Text = ""
  ReadCom.commport = commport
  ReadCom.Settings = portsetting
  ReadCom.InputLen = 0
  If Not ReadCom.PortOpen Then
    ReadCom.PortOpen = True
  End If
  For i = 1 To 4
    WireTstPass(i - 1) = False
  Next i

' set T2 off
  CurSendSucc = False
  cTime = Timer
  Do Until Timer - cTime > 2
    If bolWritePlcB_05(0, T2Addr, &H0) Then
       CurSendSucc = True
       Exit Do
     End If
  Loop
  If Not CurSendSucc Then
     TestResult.Text = "Handshake failed! Exit test!" & Chr(10) & TestResult.Text
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Exit Sub
  End If
  
  WireTstBegin = False
End Sub
Private Function bolWritePlcB_05(ByVal iDeviceID As Integer, ByVal iAddr As Integer, ByVal iSetValue As Integer) As Boolean
'作者:Henry
'目的:
'     写入传入字符串至Plc，可选定地址
'传入:
'     iFuncIndex:功能号
'     iAddr:欲写入数据的起始地址
'     iSetValue:欲强制的状态（&HFF or &H00)
'传回:
'     True:成功
'     False:失败
'   有应答正确性检核
 
 
        Dim sTime, cTime As Single
        Dim Dummy As Integer
        Dim vSndAry As Variant
        Dim iSndLen As Integer
        Dim vRetAry As Variant
        Dim vCrcAry As Variant
        Dim i As Integer
        Dim bHeadAry(5) As Byte
        Dim k As Long, m As Long
        On Error GoTo WritePlcErr
        
        bHeadAry(0) = iDeviceID
        bHeadAry(1) = 5
        bHeadAry(2) = iAddr \ 256
        bHeadAry(3) = iAddr Mod 256 - 1
        bHeadAry(4) = iSetValue
        bHeadAry(5) = 0
                        
        iSndLen = 8 '9 + iLenB - 1
        ReDim vSndAry(0 To iSndLen - 1)
        
        vSndAry = CmbAryB(bHeadAry, CrcB(bHeadAry, 6))
        If ReadCom.PortOpen = False Then
            ReadCom.PortOpen = True
        End If

        'clear input/output buffer
        ReadCom.InBufferCount = 0
        ReadCom.OutBufferCount = 0
 
        'write to output buffer
        ReadCom.Output = vSndAry
 
        'read from input buffer
        sTime = Timer
        bolWritePlcB_05 = True
        Do While bolWritePlcB_05
           If ReadCom.InBufferCount >= 8 Then
              bolWritePlcB_05 = True
              Exit Do
           End If
           cTime = Timer
           If (cTime - sTime) > cTimeOut Then
              bolWritePlcB_05 = False
           Else
              If (Timer - sTime) < 0 Then sTime = Timer
           End If
           Dummy = DoEvents()
        Loop
        
        If bolWritePlcB_05 Then
           vRetAry = ReadCom.Input
           vCrcAry = CrcB(vRetAry, 6)
           If vCrcAry(0) <> vRetAry(6) Or vCrcAry(1) <> vRetAry(7) _
              Or vSndAry(0) <> vRetAry(0) Or vSndAry(1) <> vRetAry(1) Then
              bolWritePlcB_05 = False
              Exit Function
           End If
        End If
        
        Exit Function
       
      
WritePlcErr:
        bolWritePlcB_05 = False
End Function
 



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  TestFinishCmd_Click
End Sub

Private Sub FuncTestMenu_Click()
  FrmFuncTest.Show
End Sub

Private Sub mnuAbout_Click()
frmAbout.Show

End Sub

Private Sub mnuExit_Click()

'判断系统当前是否正在运行

If MsgBox("Are you sure exit system?", vbQuestion + vbYesNo + vbDefaultButton1) = vbYes Then
   End
End If

End Sub

Private Sub mnuOnlineHelp_Click()
MsgBox "Online Help", vbInformation
End Sub

Private Sub mnuReport_Click()

FrmReport.Show

End Sub


Private Sub mnuTestPrj_Click()
  FrmProjSet.Show
End Sub






Private Sub StartCmd_Click()
  Dim cTime
  Dim CurSendSucc As Boolean
  Dim i As Integer, TestInfo(50) As String, TestResultInfo(50) As String
  WireTestOn = True
  WireTstBegin = False
  FillComp = False
  FillSucc = False
  WireNum = 0
  WireInput.Text = ""
  TestResult.Text = ""
  WireInput.Text = "Before begin the wire test,you have to fill in some test information in the next form." & Chr(10) & Chr(13) & WireInput.Text
  ''''''''''''''''''''''''
  SetWindowPos FrmWireHead.hwnd, HWND_TOPMOST, 100, 50, 505, 405, SWP_SHOWWINDOW
  FillComp = False
  Do Until FillComp
    DoEvents
  Loop
  If Not FillSucc Then
    TestResult.Text = "You did not fill the information completely." & Chr(10) & TestResult.Text
    '''''''''''''''''''''''''
    WireTestOn = False
    Exit Sub
  End If
  
  WireTstBegin = True
  WireInput.Text = "Now begin the wire test." & Chr(10) & WireInput.Text
  ''''''''''''''''''''''''''''''''''''''''''
  For i = 0 To 3
    WireTstPass(i) = False
  Next i
  
  Open App.Path & "\ErrReport\" & TempFileName & "Err.txt" For Output As #1
  Print #1, "EquipmentID = " & TempFileName
  Close #1

  DbMsgShow.Text1.Text = ""
  DbMsgShow.Text1.FileName = App.Path & ("\showmsg\WireInfo1.txt")
  SetWindowPos DbMsgShow.hwnd, HWND_TOPMOST, 200, 100, 500, 350, SWP_SHOWWINDOW
  FillComp = False
  FillSucc = False
  Do Until FillComp
    DoEvents
  Loop
  If Not FillSucc Then
    WireTestOn = False
    TestFinishCmd_Click
    Exit Sub
  End If

  'Test xpower1
  WireInput.Text = "Now test XPOWER1." & Chr(10)
  ''''''''''''''''''''''''''''''
      '====set color begin
  WireInput.SelStart = 9
  WireInput.SelLength = 7
  WireInput.SelColor = vbRed
  WireInput.SelBold = True
  WireInput.SelLength = 0
    '=====set color end
    
  WireNum = WireNum + 1
  TestLineNumLable.Caption = WireNum
    
  WireInput.Text = "Send XPOWER1 signal." & Chr(10) & WireInput.Text
  ''''''''''''''''''''''''''''''''''
      '====set color begin
  WireInput.SelStart = 5
  WireInput.SelLength = 7
  WireInput.SelColor = vbRed
  WireInput.SelBold = True
  WireInput.SelLength = 0
    '=====set color end
  
  
  'set XPOWER1 to 1
  CurSendSucc = False
  cTime = Timer
  Do Until Timer - cTime > 2
     If bolWritePlcB_05(iDeviceID, XPOWER1, &HFF) Then
       CurSendSucc = True
       Exit Do
     End If
  Loop
  If Not CurSendSucc Then
     TestResult.Text = "Handshake failed! Exit test!" & Chr(10) & TestResult.Text
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     WireTestOn = False
     Exit Sub
  End If
  cTime = Timer
  Do Until Timer - cTime > 1
   DoEvents
  Loop
  'read iXPOWER1
  WireInput.Text = "Now check iXPOWER1 signals." & Chr(10) & WireInput.Text
  ''''''''''''''''''''''''''''''''
      '====set color begin
  WireInput.SelStart = 10
  WireInput.SelLength = 8
  WireInput.SelColor = vbRed
  WireInput.SelBold = True
  WireInput.SelLength = 0
    '=====set color end
  
  cTime = Timer
  Do Until Timer - cTime > 1
   DoEvents
  Loop
   
  If bolReadPlcB_03(0, CountAddr, 9, LngVRetAryB) Then
  Else
    TestResult.Text = "Signal read error." & Chr(10) & TestResult.Text
    ''''''''''''''''''''''''''''''''''''
    CurSendSucc = False
    cTime = Timer
    Do Until Timer - cTime > 2
      If bolWritePlcB_05(iDeviceID, XPOWER1, &H0) Then
        CurSendSucc = True
        Exit Do
      End If
    Loop
    WireTestOn = False
    Exit Sub
  End If
   If Not (SignalBitRight(LngVRetAryB, iXPOWER1 - 16, 1) And SignalBitRight(LngVRetAryB, iXPOWER2 - 16, 0) And SignalBitRight(LngVRetAryB, iXLight1 - 16, 0) And SignalBitRight(LngVRetAryB, iXLight2 - 16, 0)) Then
     TestResult.Text = "XPOWER1 test error." & Chr(10) & TestResult.Text
     '''''''''''''''''''''''''''''''
     Open App.Path & "\ErrReport\" & TempFileName & "Err.txt" For Output As #1
     Print #1, "TEST XPOWER1           test signal:  iXpower1"
     Print #1, " Following signals are in error:"
     Close #1
     ShowErrorText 1
     cTime = Timer
     CurSendSucc = False
     Do Until Timer - cTime > 2
       If bolWritePlcB_05(iDeviceID, XPOWER1, &H0) Then
         Exit Do
       End If
     Loop