transducer.frm

一个用于测试ABB变频器通讯的小工具

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Transducer 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ABB变频器测试"
   ClientHeight    =   6660
   ClientLeft      =   4890
   ClientTop       =   780
   ClientWidth     =   6135
   Icon            =   "Transducer.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6660
   ScaleWidth      =   6135
   Begin VB.TextBox txtMax 
      Height          =   330
      Left            =   3675
      TabIndex        =   17
      Text            =   "0"
      Top             =   6120
      Width           =   705
   End
   Begin VB.TextBox txtMin 
      Height          =   330
      Left            =   2520
      TabIndex        =   16
      Text            =   "0"
      Top             =   6135
      Width           =   705
   End
   Begin VB.CommandButton cmdGetAll 
      Caption         =   "全采"
      Height          =   510
      Left            =   525
      TabIndex        =   15
      Top             =   6000
      Width           =   1110
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "清除"
      Height          =   495
      Left            =   270
      TabIndex        =   14
      Top             =   5190
      Width           =   975
   End
   Begin VB.CommandButton cmdBin2dec 
      Caption         =   ">"
      Height          =   375
      Left            =   3510
      TabIndex        =   13
      Top             =   5190
      Width           =   255
   End
   Begin VB.CommandButton cmdDec2bin 
      Caption         =   "<"
      Height          =   375
      Left            =   3150
      TabIndex        =   12
      Top             =   5190
      Width           =   255
   End
   Begin VB.TextBox txtDec 
      Height          =   270
      Left            =   3870
      TabIndex        =   9
      Text            =   "0"
      Top             =   5310
      Width           =   735
   End
   Begin VB.TextBox txtBin 
      Height          =   270
      Left            =   1590
      TabIndex        =   8
      Text            =   "0"
      Top             =   5310
      Width           =   1455
   End
   Begin VB.CommandButton cmdWrite 
      Caption         =   "写入"
      Height          =   495
      Left            =   5070
      TabIndex        =   7
      Top             =   5190
      Width           =   855
   End
   Begin VB.ComboBox cbRegStart 
      Height          =   300
      Left            =   3150
      TabIndex        =   6
      Top             =   4710
      Width           =   1455
   End
   Begin VB.CommandButton cmdRead 
      Caption         =   "读取"
      Height          =   495
      Left            =   5070
      TabIndex        =   4
      Top             =   4590
      Width           =   855
   End
   Begin VB.ComboBox cbAddress 
      Height          =   300
      Left            =   1590
      TabIndex        =   2
      Top             =   4710
      Width           =   1455
   End
   Begin VB.ListBox List1 
      Height          =   4200
      Left            =   120
      TabIndex        =   1
      Top             =   60
      Width           =   5835
   End
   Begin VB.CommandButton cmdComSet 
      Caption         =   "设置"
      Height          =   495
      Left            =   270
      TabIndex        =   0
      Top             =   4590
      Width           =   975
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   4950
      Top             =   6015
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      InputMode       =   1
   End
   Begin VB.Label Label6 
      Caption         =   "地址："
      Height          =   270
      Left            =   1845
      TabIndex        =   19
      Top             =   6150
      Width           =   615
   End
   Begin VB.Label Label5 
      Caption         =   "到"
      Height          =   285
      Left            =   3300
      TabIndex        =   18
      Top             =   6180
      Width           =   315
   End
   Begin VB.Label Label4 
      Caption         =   "十进制："
      Height          =   255
      Left            =   3870
      TabIndex        =   11
      Top             =   5070
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "二进制："
      Height          =   255
      Left            =   1590
      TabIndex        =   10
      Top             =   5070
      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "REG起始地址："
      Height          =   255
      Left            =   3150
      TabIndex        =   5
      Top             =   4470
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "DIP地址："
      Height          =   255
      Left            =   1590
      TabIndex        =   3
      Top             =   4470
      Width           =   975
   End
End
Attribute VB_Name = "Transducer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdBin2dec_Click()
txtDec.Text = Bin2Dec(Trim(txtBin.Text))
End Sub

Private Sub cmdClear_Click()
List1.Clear
End Sub

Private Sub cmdComSet_Click()
On Error GoTo Errhandle
OpenFlag = False
frmCOMset.Show 1
If OpenFlag Then
   If MSComm1.PortOpen = True Then
     MSComm1.PortOpen = False
   End If
   OpenFlag = False
   MSComm1.Settings = strSetting
   MSComm1.CommPort = MscomPort
   MSComm1.RThreshold = 0
   MSComm1.OutBufferCount = 0
   MSComm1.InBufferCount = 0
   MSComm1.PortOpen = True
   cmdRead.Enabled = True
End If
Exit Sub
Errhandle:
 MsgBox Err.Description, vbOKOnly + vbCritical, "警告"
 Err.Clear
End Sub

Private Sub cmdDec2bin_Click()
txtBin.Text = Dec2Bin(Trim(txtDec.Text))
End Sub

Private Sub cmdGetAll_Click()
Dim i As Long
For i = Val(txtMin) To Val(txtMax)
  cbRegStart.ListIndex = i
  cmdRead_Click
Next
End Sub

Private Sub cmdRead_Click()
      Dim dd As Single
      Dim tmpstr As String
      Dim i As Long, j As Long
      Dim CRC() As Byte
      Dim d() As Byte '待传输数据
      Dim rcflg As Boolean
      ReDim d(5) As Byte
      If cbRegStart.ListIndex < 0 Then
        Exit Sub
      End If
      d(0) = cbAddress.ListIndex + 1
      d(1) = 3
      d(2) = Int((cbRegStart.ListIndex) / 256)
      d(3) = (cbRegStart.ListIndex) Mod 256
      d(4) = 0
      d(5) = 1
      CRC = CRC16_1(d)
      'CRC(0)为高位
      'CRC(1)为低位
      ReDim Preserve d(7)
      d(6) = CRC(1)
      d(7) = CRC(0)
      ReDim ReceiveByte(0 To 6)
      If MSComm1.PortOpen = True Then
         MSComm1.InBufferCount = 0
         MSComm1.Output = d
         dd = Timer + 0.15
         Do
'            Sleep (10)
'            DoEvents
            TimeDelay (10)
            If MSComm1.InBufferCount >= 7 Then
             ReceiveByte = MSComm1.Input
             rcflg = True
            End If
         Loop Until rcflg = True Or Timer > dd
         If rcflg Then
           i = ReceiveByte(1)
           j = d(1)
           If i = j Then
               tmpstr = Dec2Bin(CLng(ReceiveByte(4)))
               While (Len(tmpstr) < 8)
                tmpstr = "0" & tmpstr
               Wend
               tmpstr = Dec2Bin(CLng(ReceiveByte(3))) & tmpstr
               List1.AddItem cbRegStart.ListIndex + 1 & "_" & tmpstr & "-" & Bin2Dec(tmpstr)
           End If
         Else
               List1.AddItem "Read failed!"
         End If
      End If

End Sub

Private Sub cmdWrite_Click()
      Dim dd As Single
      Dim tmpstr As String
      Dim CRC() As Byte
      Dim d() As Byte '待传输数据
      Dim rcflg As Boolean
      ReDim d(5) As Byte
      If cbRegStart.ListIndex < 0 Then
        Exit Sub
      End If
      d(0) = cbAddress.ListIndex + 1
      d(1) = 6
      d(2) = Int((cbRegStart.ListIndex) / 256)
      d(3) = (cbRegStart.ListIndex) Mod 256
      d(4) = Int(Val(txtDec) / 256)
      d(5) = Val(txtDec) Mod 256
      CRC = CRC16_1(d)
      'CRC(0)为高位
      'CRC(1)为低位
      ReDim Preserve d(7)
      d(6) = CRC(1)
      d(7) = CRC(0)
      ReDim ReceiveByte(0 To 6)
      If MSComm1.PortOpen = True Then
         MSComm1.InBufferCount = 0
         MSComm1.Output = d
         dd = Timer + 0.2
         Do
'            Sleep (10)
'            DoEvents
            TimeDelay (10)
            If MSComm1.InBufferCount >= 7 Then
             ReceiveByte = MSComm1.Input
             rcflg = True
            End If
         Loop Until rcflg = True Or Timer > dd
         If rcflg Then
           If ReceiveByte(1) = d(1) Then
               tmpstr = Dec2Bin(CLng(ReceiveByte(4)))
               While (Len(tmpstr) < 8)
                tmpstr = "0" & tmpstr
               Wend
               tmpstr = Dec2Bin(CLng(ReceiveByte(3))) & tmpstr
               List1.AddItem tmpstr & "-" & Bin2Dec(tmpstr)
               Call SaveSet
           Else
               List1.AddItem "Writed failed!"
           End If
         End If
      End If
End Sub

Private Sub SaveSet()
      Dim dd As Single
      Dim tmpstr As String
      Dim CRC() As Byte
      Dim d() As Byte '待传输数据
      Dim rcflg As Boolean
      ReDim d(5) As Byte
      d(0) = cbAddress.ListIndex + 1
      d(1) = 6
      d(2) = Int(1606 / 256)
      d(3) = 1606 Mod 256
      d(4) = 0
      d(5) = 1
      CRC = CRC16_1(d)
      'CRC(0)为高位
      'CRC(1)为低位
      ReDim Preserve d(7)
      d(6) = CRC(1)
      d(7) = CRC(0)
      ReDim ReceiveByte(0 To 6)
      If MSComm1.PortOpen = True Then
         MSComm1.InBufferCount = 0
         MSComm1.Output = d
         dd = Timer + 0.2
         Do
            TimeDelay (10)
            If MSComm1.InBufferCount >= 7 Then
             ReceiveByte = MSComm1.Input
             rcflg = True
            End If
         Loop Until rcflg = True Or Timer > dd
         If rcflg Then
           If ReceiveByte(1) = d(1) Then
               List1.AddItem "Save para successed!" 'tmpstr & "-" & Bin2Dec(tmpstr)
           Else
               List1.AddItem "Save para failed!"
           End If
         End If
      End If
End Sub
Private Sub Form_Load()
Dim i As Long
For i = 1 To 14
 cbAddress.AddItem i
Next
For i = 0 To 9907
  cbRegStart.AddItem i + 1
Next
cbRegStart.ListIndex = 0
cbAddress.ListIndex = 0
'ADDTransducer1.ReadRegSingle( = True
End Sub
'
Private Sub MSComm1_OnComm()
Dim i As Long
i = 1
End Sub