read_frm.frm

VB和西门子s300plc串口通讯程序 能实现读写功能

Dim s1 As String

Dim RealGet(30) As Single


For i = 0 To (AMOUNT - 1)
    s = i + DATANO
    s = s + ":  "
    
    If ((DataFieldIdx = 3) Or (DataFieldIdx = 4)) Then
        Select Case ViewTypeIdx
        Case 0
            s1 = Hex(value_word(i))
        Case 1
            s1 = value_word(i)
        Case 2
            j = 1
            s1 = ""
            While (j < 65536)
                k = j And value_word(i)
                If (k <> 0) Then
                    s1 = s1 + "1"
                    Else
                    s1 = s1 + "0"
                End If
                j = j * 2
            Wend
        End Select
        s = s + s1
        ListView.AddItem (s)
    ElseIf (DataFieldIdx = 5) Then
        If (DataTypeIdx = 1) Then
            'Dim sub1 As String, sub2 As String
            'sub1 = Right(Hex(value_word(i)), 2)
            'sub2 = Left(Hex(value_word(i)), Len(Hex(value_word(i))) - 2)
            'value_word(i) = "&h" + sub1 + sub2
            Call swab_buffer(value_word(i), 2)
            Select Case ViewTypeIdx
            Case 0
                s1 = Hex(value_word(i))
            Case 1
                s1 = value_word(i)
            Case 2
                j = 1
                s1 = ""
                While (j < 65536)
                    k = j And value_word(i)
                    If (k <> 0) Then
                        s1 = s1 + "1"
                        Else
                        s1 = s1 + "0"
                    End If
                    j = j * 2
                Wend
            End Select
            s = s + s1
            ListView.AddItem (s)
        Else
            ViewType(0).Enabled = False
            ViewType(1).Enabled = False
            ViewType(2).Enabled = False
            Dim ss(3) As String
            If (i Mod 2 = 1) Then
                ss(0) = CStr(Hex(value_word(i)))
                ss(1) = CStr(Hex(value_word(i - 1)))
                For j = 0 To 1
                    If (Len(ss(j)) = 1) Then
                        ss(j) = "000" + ss(j)
                    ElseIf (Len(ss(j)) = 2) Then
                        ss(j) = "00" + ss(j)
                    ElseIf (Len(ss(j)) = 3) Then
                        ss(j) = "0" + ss(j)
                    End If
                Next j
                ss(2) = ss(0) + ss(1)
                RealBuf(i \ 2) = "&h" + ss(2)
                Call gp_to_float(RealBuf(i \ 2), RealGet(i \ 2))
                s1 = RealGet(i \ 2)
                s = s + s1
                ListView.AddItem (s)
            End If
        End If
    Else
        Select Case ViewTypeIdx
        Case 0
            s1 = Hex(value_byte(i))
        Case 1
            s1 = value_byte(i)
        Case 2
            j = 1
            s1 = ""
            While (j < 256)
                k = j And value_byte(i)
                If (k <> 0) Then
                    s1 = s1 + "1"
                    Else
                    s1 = s1 + "0"
                End If
                j = j * 2
            Wend
        
        End Select
        s = s + s1
        ListView.AddItem (s)
    End If
Next i

End Sub



Private Sub DATAADR_Change(Index As Integer)
DATANO = DATAADR(1).Text

End Sub

Private Sub DATAAMT_Change(Index As Integer)
AMOUNT = DATAAMT(2).Text
End Sub

Private Sub DataType_Click(Index As Integer)
DataTypeIdx = Index
If (Index = 2) Then
    ViewType(0).Enabled = False
    ViewType(1).Enabled = False
    ViewType(2).Enabled = False
Else
    ViewType(0).Enabled = True
    ViewType(1).Enabled = True
    ViewType(2).Enabled = True
End If

End Sub

Private Sub DBID_Change(Index As Integer)
BLOCKNO = DBID(0).Text
End Sub

Private Sub Form_Activate()
STATIONADR(0).Text = plcadr(VerbIdx).ADR
SEGMENTID(1).Text = plcadr(VerbIdx).SEGMENTID
RACKNO(2).Text = plcadr(VerbIdx).RACKNO
SLOTNO(3).Text = plcadr(VerbIdx).SLOTNO

DataField(0).value = True
DataFieldIdx = 0
DataType(1).value = True
DataTypeIdx = 1
ViewType(0).value = True
ViewTypeIdx = 0
'DataTypeInfo = "读取的输入数据的首地址和字节个数"
'READPAR(0).Visible = False
'DBID(0).Visible = False
'READPAR(1).Caption = "字节地址"
'READPAR(2).Caption = "字节个数"

'***************************for test***********************
res = error_message(0, "Error.eng")
'***************************for test************************

res = new_ss(VerbIdx + 1)

If (res = 0) Then
    AGSTATUS.Text = "ok"
    Else
    ErrorText = "                                                                          "
    res = error_message(res, ErrorText)
    AGSTATUS.Text = ErrorText
End If


End Sub

Private Sub IDCANCEL_Click()
Me.Visible = False
End Sub

Private Sub IDREAD_Click()
Dim i, j, k As Long
Dim s As String
Dim s1 As String

If (AMOUNT > 512) Then AMOUNT = 512

res = new_ss(VerbIdx + 1)
If (res = 0) Then
Select Case DataFieldIdx
    Case 0
        res = e_field_read(DATANO, AMOUNT, value_byte(0))
    Case 1
        res = a_field_read(DATANO, AMOUNT, value_byte(0))
    Case 2
        res = m_field_read(DATANO, AMOUNT, value_byte(0))
    Case 3
        res = t_field_read(DATANO, AMOUNT, value_word(0))
        Call swab_buffer(value_word(0), 2) '2指交换的字节的个数
    Case 4
        res = z_field_read(DATANO, AMOUNT, value_word(0))
        Call swab_buffer(value_word(0), 2)
    Case 5
        res = db_read(BLOCKNO, DATANO, AMOUNT, value_word(0))
        
        'Call swab_buffer(value_word(0), 2)
End Select
End If

If (res = 0) Then
    ListView.Clear
    Call ShowValue
End If

If (res <> 0) Then
   MsgBox "failure in reading!"
End If

End Sub

Private Sub DataField_Click(Index As Integer)
'Dim DataTypeInfo As String
DataFieldIdx = Index
Select Case Index
    Case 0
        'DataTypeInfo = "请选择要读取数据的位置/数量/类型"
        READPAR(0).Visible = False
        DBID(0).Visible = False
        DataType(1).Visible = False
        DataType(2).Visible = False
        'READPAR(1).Caption = "字节首地址"
        'READPAR(2).Caption = "字节个数"
    Case 1
        'DataTypeInfo = "请选择要读取数据的位置/数量/类型"
        READPAR(0).Visible = False
        DBID(0).Visible = False
        DataType(1).Visible = False
        DataType(2).Visible = False
        'READPAR(1).Caption = "字节首地址"
        'READPAR(2).Caption = "字节个数"
    Case 2
        'DataTypeInfo = "请选择要读取数据的位置/数量/类型"
        READPAR(0).Visible = False
        DBID(0).Visible = False
        DataType(1).Visible = False
        DataType(2).Visible = False
        'READPAR(1).Caption = "字节首地址"
        'READPAR(2).Caption = "字节个数"
    Case 3
        'DataTypeInfo = "定时器号和字个数"
        READPAR(0).Visible = False
        DBID(0).Visible = False
        DataType(1).Visible = False
        DataType(2).Visible = False
        'READPAR(1).Caption = "字首地址"
        'READPAR(2).Caption = "字个数"
    Case 4
        'DataTypeInfo = "计数器号和字个数"
        READPAR(0).Visible = False
        DBID(0).Visible = False
        DataType(1).Visible = False
        DataType(2).Visible = False
        'READPAR(1).Caption = "字首地址"
        'READPAR(2).Caption = "字个数"
    Case 5
        READPAR(0).Visible = True
        DBID(0).Visible = True
        DataType(1).Visible = True
        DataType(2).Visible = True
        'DataTypeInfo = "读取的DB块的块号/位置/数量/类型"
        'READPAR(1).Caption = "字首地址"
        'READPAR(2).Caption = "字个数"
End Select

'Frame2.Caption = "请输入" + DataTypeInfo
End Sub

Private Sub ViewType_Click(Index As Integer)
ViewTypeIdx = Index
Dim i As Integer, j As Integer
j = ListView.ListCount - 1
    Select Case ViewTypeIdx
        Case 0
            For i = 0 To j
                ListView.List(i) = Left(ListView.List(i), 4) + Hex(value_word(i))
            Next i
        Case 1
            For i = 0 To j
                ListView.List(i) = Left(ListView.List(i), 4) + CStr(value_word(i))
            Next i
        Case 2
        For i = 0 To j
            Dim jj As Long, ss1 As String, kk As Long
            jj = 1
            ss1 = ""
            While (jj < 65536)
                kk = jj And value_word(i)
                If (kk <> 0) Then
                    ss1 = ss1 + "1"
                    Else
                    ss1 = ss1 + "0"
                End If
                jj = jj * 2
            Wend
            ListView.List(i) = Left(ListView.List(i), 4) + ss1
        Next i
    End Select
End Sub