Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4095
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4275
   LinkTopic       =   "Form1"
   ScaleHeight     =   4095
   ScaleWidth      =   4275
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command6 
      Caption         =   "运行状态"
      Height          =   495
      Left            =   720
      TabIndex        =   7
      Top             =   480
      Width           =   1215
   End
   Begin VB.CommandButton Command5 
      Caption         =   "编程状态"
      Height          =   495
      Left            =   2280
      TabIndex        =   6
      Top             =   480
      Width           =   1455
   End
   Begin VB.TextBox Text3 
      Height          =   495
      Left            =   2280
      TabIndex        =   5
      Text            =   "Text3"
      Top             =   3000
      Width           =   1455
   End
   Begin VB.CommandButton Command4 
      Caption         =   "写入DM0"
      Height          =   495
      Left            =   600
      TabIndex        =   4
      Top             =   3000
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      Height          =   495
      Left            =   2280
      TabIndex        =   3
      Text            =   "Text2"
      Top             =   2160
      Width           =   1455
   End
   Begin VB.CommandButton Command3 
      Caption         =   "读出DM0"
      Height          =   495
      Left            =   600
      TabIndex        =   2
      Top             =   2160
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "监视状态"
      Height          =   495
      Left            =   600
      TabIndex        =   1
      Top             =   1320
      Width           =   1335
   End
   Begin VB.Timer Timer2 
      Interval        =   1000
      Left            =   1080
      Top             =   4680
   End
   Begin VB.CommandButton Command1 
      Caption         =   "01000置位"
      Height          =   495
      Left            =   2280
      TabIndex        =   0
      Top             =   1320
      Width           =   1455
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   240
      Top             =   4560
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tim As Integer
01000强制置位
Private Sub Command1_Click()
Dim outstring As String
    MSComm1.InBufferCount = 0
    outstring = "@" + "00" + "KS" + "CIO" + Chr$(32) + "001000"
    fcdd$ = XORR(outstring)
    outstring = outstring + fcdd$ + "*" + Chr$(13)
    MSComm1.Output = outstring
    
    Time_out = tim
     Do
       If tim > (Time_out + 1) Then
         ERROR_COM = True
       Else
         ERROR_COM = False
       End If
       DoEvents
     Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
      Instring = MSComm1.Input
      endcode = Mid(Instring, 6, 2)
      Call ErrMessage(endcode)   
End Sub
转换到监视状态
Private Sub Command2_Click()
Dim outstring As String
 MSComm1.InBufferCount = 0
    outstring = "@" + "00" + "SC" + "02"
    fcdd$ = XORR(outstring)
    outstring = outstring + fcdd$ + "*" + Chr$(13)
    MSComm1.Output = outstring
    
    Time_out = tim
     Do
       If tim > (Time_out + 1) Then
         ERROR_COM = True
       Else
         ERROR_COM = False
       End If
       DoEvents
     Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
      Instring = MSComm1.Input
      endcode = Mid(Instring, 6, 2)
      Call ErrMessage(endcode)
End Sub
读出DM0
Private Sub Command3_Click()
Dim outstring As String
  MSComm1.InBufferCount = 0 'clear off  inbuffer
    outstring = "@" + "00" + "RD" + "0000" + "0001"
    fcdd$ = XORR(outstring)
    outstring = outstring + fcdd$ + "*" + Chr$(13)
    MSComm1.Output = outstring
    Time_out = tim
    
   '判断通讯错误
    Do
      If tim > (Time_out + 1) Then
        ERROR_COM = True
      Else
        ERROR_COM = False
      End If
        DoEvents
    Loop Until ((MSComm1.InBufferCount >= 11 + 4 * Lengh) Or (ERROR_COM = True))
    
    Instring = MSComm1.Input
    order1 = Mid(Instring, 6, 2)  '结束码
    Call ErrMessage(order1)
      Text2.Text = Mid(Instring, 8, 4)    '取出数据位    
End Sub
写入DM0
Private Sub Command4_Click()
Dim outstring As String
    MSComm1.InBufferCount = 0
    outstring = "@" + "00" + "WD" + "0000" + Text3.Text
    fcdd$ = XORR(outstring)
    outstring = outstring + fcdd$ + "*" + Chr$(13)
    MSComm1.Output = outstring
    
    Time_out = tim
     Do
       If tim > (Time_out + 1) Then
         ERROR_COM = True
       Else
         ERROR_COM = False
       End If
       DoEvents
     Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
      Instring = MSComm1.Input
      endcode = Mid(Instring, 6, 2)
      Call ErrMessage(endcode)
      
End Sub
转换到编辑状态
Private Sub Command5_Click()
Dim outstring As String
 MSComm1.InBufferCount = 0
    outstring = "@" + "00" + "SC" + "00"
    fcdd$ = XORR(outstring)
    outstring = outstring + fcdd$ + "*" + Chr$(13)
    MSComm1.Output = outstring
    
    Time_out = tim
     Do
       If tim > (Time_out + 1) Then
         ERROR_COM = True
       Else
         ERROR_COM = False
       End If
       DoEvents
     Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
      Instring = MSComm1.Input
      endcode = Mid(Instring, 6, 2)
      Call ErrMessage(endcode)
End Sub
转换到运行状态
Private Sub Command6_Click()
Dim outstring As String
 MSComm1.InBufferCount = 0
    outstring = "@" + "00" + "SC" + "03"
    fcdd$ = XORR(outstring)
    outstring = outstring + fcdd$ + "*" + Chr$(13)
    MSComm1.Output = outstring
    
    Time_out = tim
     Do
       If tim > (Time_out + 1) Then
         ERROR_COM = True
       Else
         ERROR_COM = False
       End If
       DoEvents
     Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
      Instring = MSComm1.Input
      endcode = Mid(Instring, 6, 2)
      Call ErrMessage(endcode)
End Sub
Private Sub Form_Load()         '初始化
tim = 0
  Call INIT_comm
End Sub
COMM初始化
Public Sub INIT_comm()
  'Buffer to hold input string
  Dim Instring, outstring As String
    MSComm1.CommPort = 1   'Use COM1.
    MSComm1.Settings = "9600,e,7,2"  '9600 baud, e parity, 7 data, and 2 stop bit.
    MSComm1.InputLen = 0   'Tell the control to read entire buffer when Input
    MSComm1.PortOpen = True   'Open the port.
End SubPrivate Sub Timer2_Timer()
tim = tim + 1
End Sub
通讯错误检测
Public Function ErrMessage(ByVal X As String)
  Select Case X
    Case "13"
      MsgBox "校验错误"
    Case "14"
      MsgBox "格式错误"
    Case "15"
      MsgBox "入口码错误"
    Case "18"
      MsgBox "帧长度错误"
    Case "A3"
      MsgBox "传送数据时因FCS错误引起终止"
    Case "A8"
      MsgBox "传送数据时因长度错误引起在终止"
  End Select
End Function
FCS计算
Function XORR(ByVal STRI As String) As String   '校验码的异或处理
 Dim I, J, K As Integer
 J = Len(STRI)
 K = 0
 For I = 1 To J
  K = Asc(Mid$(STRI, I, 1)) Xor K
 Next I
 fcdd$ = Hex$(K)
 If Len(fcdd$) = 1 Then
  XORR = "0" & fcdd$
 Else
  XORR = fcdd$
 End If
End Function

解决方案 »

  1.   

    将内容贴到一个文本文件中,然后将后缀名改为frm,最后双击这个frm文件即可。
      

  2.   

    LZ:你新建一个VB的EXE工程,在工程(P)菜单下选部件项,在Microsoft Comm Control 6.0 (Sp6)前选钩并确定,然后在窗体上添加该控件,并添加6个按钮控件和1个Timer控件(命名为Timer2)到窗体.
    将Dim tim As Integer开始的行及以下所有代码复制到VB该窗体的代码编辑窗口,然后运行并一一纠错.
      

  3.   

    楼上的各位没明白:楼主想变成一个EXE编程一个程序=变成一个程序
      

  4.   

    从 http://hi.baidu.com/siskinzs/blog/item/bfb4b64564c0f841510ffeab.html 这里粘来的?要想变魔术变一个程序出来,lz你得安装Visual Basic这个神奇的工具软件。
      

  5.   

    LZ:你新建一个VB的EXE工程,在工程(P)菜单下选部件项,在Microsoft Comm Control 6.0 (Sp6)前选钩并确定,然后在窗体上添加该控件,并添加1个按钮控件.
    以下所有代码复制到VB该窗体的代码编辑窗口,完全可以运行且学习你想掌握的VB通信程序.Option Explicit
        Dim tim As Integer
        Dim fcdd$
        Dim Time_out As String
        Dim ERROR_COM As Boolean
        Dim Instring As String
        Dim endcode As String
    '1000 强制置位
    Private Sub Command1_Click()
        Dim outstring As String
        MSComm1.InBufferCount = 0
        outstring = "@" + "00" + "KS" + "CIO" + Chr$(32) + "001000"
        fcdd$ = XORR(outstring)
        outstring = outstring + fcdd$ + "*" + Chr$(13)
        MSComm1.Output = outstring
          
        Time_out = tim
        Do
        If tim > (Time_out + 1) Then
        ERROR_COM = True
        Else
        ERROR_COM = False
        End If
        DoEvents
        Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
        Instring = MSComm1.Input
        endcode = Mid(Instring, 6, 2)
        Call ErrMessage(endcode)
    End Sub
    'COMM初始化
    Public Sub INIT_comm()
        'Buffer to hold input string
        Dim Instring, outstring As String
        MSComm1.CommPort = 1 'Use COM1.
        MSComm1.Settings = "9600,e,7,2" '9600 baud, e parity, 7 data, and 2 stop bit.
        MSComm1.InputLen = 0 'Tell the control to read entire buffer when Input
        MSComm1.PortOpen = True 'Open the port.
    End Sub
    '通讯错误检测
    Public Function ErrMessage(ByVal X As String)
        Select Case X
            Case "13"
                MsgBox "校验错误"
            Case "14"
                MsgBox "格式错误"
            Case "15"
                MsgBox "入口码错误"
            Case "18"
                MsgBox "帧长度错误"
            Case "A3"
                MsgBox "传送数据时因FCS错误引起终止"
            Case "A8"
                MsgBox "传送数据时因长度错误引起在终止"
        End Select
    End Function'FCS计算
    Function XORR(ByVal STRI As String) As String '校验码的异或处理
        Dim I, J, K As Integer
        J = Len(STRI)
        K = 0
        For I = 1 To J
            K = Asc(Mid$(STRI, I, 1)) Xor K
        Next I
        fcdd$ = Hex$(K)
        If Len(fcdd$) = 1 Then
            XORR = "0" & fcdd$
        Else
            XORR = fcdd$
        End If
    End Function
      

  6.   

    要送分就多弄点,40分,太少了顶3楼,不过要吧
    COMM初始化这样的注释去掉吧?
      

  7.   

    我修改后没错误了   但是只能读取和写入一个地址  希望各位大大帮我修改下   
    Option Explicit
    Dim tim As Integer
    Dim fcs$
    Dim Time_out As String
    Dim ERROR_COM As Boolean
    Dim Instring As String
    Dim endcode As String
    Dim Lengh As Integer
    Dim order1 As StringPublic Sub INIT_comm()
      'Buffer to hold input string
      Dim Instring, outstring As String
        MSComm1.CommPort = 1
        
        '使用COM1.
        MSComm1.Settings = "9600,e,7,2"
        
            
            '9600波特率, e 偶校验, 7 位,  2 停止位.
        MSComm1.InputLen = 0
        
        '读取整个缓存的数据
                                                                                                                                                                    MSComm1.PortOpen = True  '打开端口.
    End SubPublic Function ErrMessage(ByVal X As String)
      Select Case X
        Case "13"
          MsgBox "校验错误"
        Case "14"
          MsgBox "格式错误"
        Case "15"
          MsgBox "入口码错误"
        Case "18"
          MsgBox "帧长度错误"
        Case "A3"
          MsgBox "传送数据时因FCS错误引起终止"
        Case "A8"
          MsgBox "传送数据时因长度错误引起在终止"
      End Select
    End FunctionFunction XORR(ByVal STRI As String) As String  '校验码的异或处理
    Dim I, J, K As Integer
    J = Len(STRI)
    K = 0
    For I = 1 To J
      K = Asc(Mid$(STRI, I, 1)) Xor K
    Next I
    fcdd$ = Hex$(K)
    If Len(fcdd$) = 1 Then
      XORR = "0" & fcdd$
    Else
      XORR = fcdd$
    End If
    End FunctionPrivate Sub Command2_Click()
    Dim outstring As String
    MSComm1.InBufferCount = 0
        outstring = "@" + "00" + "SC" + "02"
        fcs$ = XORR(outstring)
        outstring = outstring + fcs$ + "*" + Chr$(13)
        MSComm1.Output = outstring
        
        Time_out = tim
        Do
          If tim > (Time_out + 1) Then
            ERROR_COM = True
          Else
            ERROR_COM = False
          End If
          DoEvents
        Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
          Instring = MSComm1.Input
          endcode = Mid(Instring, 6, 2)
          Call ErrMessage(endcode)
    End SubPrivate Sub Command3_Click()
    Dim outstring As String
      MSComm1.InBufferCount = 0 'clear off  inbuffer
        outstring = "@" + "00" + "RD" + "0000" + "0001"
        fcs$ = XORR(outstring)
        outstring = outstring + fcs$ + "*" + Chr$(13)
        MSComm1.Output = outstring
        Time_out = tim
        
      '判断通讯错误
        Do
          If tim > (Time_out + 1) Then
            ERROR_COM = True
          Else
            ERROR_COM = False
          End If
            DoEvents
        Loop Until ((MSComm1.InBufferCount >= 11 + 4 * Lengh) Or (ERROR_COM = True))
        
        Instring = MSComm1.Input
        order1 = Mid(Instring, 6, 2)  '结束码
        Call ErrMessage(order1)
          Text2.Text = Mid(Instring, 8, 4)
          
          '取出数据位
    End Sub
    Private Sub Command4_Click()
    Dim outstring As String
        MSComm1.InBufferCount = 0
        outstring = "@" + "00" + "WD" + "0000" + Text3.Text
        fcs$ = XORR(outstring)
        outstring = outstring + fcs$ + "*" + Chr$(13)
        MSComm1.Output = outstring
        
        Time_out = tim
        Do
          If tim > (Time_out + 1) Then
            ERROR_COM = True
          Else
            ERROR_COM = False
          End If
          DoEvents
        Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
          Instring = MSComm1.Input
          endcode = Mid(Instring, 6, 2)
          Call ErrMessage(endcode)
          
    End SubPrivate Sub Command5_Click()
    Dim outstring As String
    MSComm1.InBufferCount = 0
        outstring = "@" + "00" + "SC" + "00"
        fcs$ = XORR(outstring)
        outstring = outstring + fcs$ + "*" + Chr$(13)
        MSComm1.Output = outstring
        
        Time_out = tim
        Do
          If tim > (Time_out + 1) Then
            ERROR_COM = True
          Else
            ERROR_COM = False
          End If
          DoEvents
        Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
          Instring = MSComm1.Input
          endcode = Mid(Instring, 6, 2)
          Call ErrMessage(endcode)
    End SubPrivate Sub Command运行6_Click()
    Dim outstring As String
    MSComm1.InBufferCount = 0
        outstring = "@" + "00" + "SC" + "03"
        fcs$ = XORR(outstring)
        outstring = outstring + fcs$ + "*" + Chr$(13)
        MSComm1.Output = outstring
        Time_out = tim
        Do
          If tim > (Time_out + 1) Then
            ERROR_COM = True
          Else
            ERROR_COM = False
          End If
          DoEvents
        Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
          Instring = MSComm1.Input
          endcode = Mid(Instring, 6, 2)
          Call ErrMessage(endcode)
    End SubPrivate Sub Form_Load()
    Dim tim As Date
    tim = 0
    Call INIT_comm
    End Sub
      

  8.   


    LZ:既然你我修改后没错误了,但是只能读取和写入一个地址
    那就核查你的PLC说明书所规约的通信协议于指令的格式来对照你能成功读取和写入一个地址的代码修改其它代码并调试.
      

  9.   

    一次读写多个数据是不现实的.
    你应该用定时器,定时逐个读取不同(地址)的数据.并将接收代码置于MsComm控件的OnComm事件中,按PLC规约的数据帧判断与处理数据.
      

  10.   

    不是啊,你的这一个是frm文件的内在结构。你新建一个文本文件,将你上述的复制下去,然后将拓展名改成frm,最后用VB开就可以了。
    教你怎么看吧:
    你开头第一句:
    Begin VB.Form Form1
    就是“一个标准的Frm文件,窗口名称是Form1”的意思。
    然后是窗体属性设置:  Caption = "Form1"
      ClientHeight = 4095
      ClientLeft = 60
      ClientTop = 345
      ClientWidth = 4275
      LinkTopic = "Form1"
      ScaleHeight = 4095
      ScaleWidth = 4275
      StartUpPosition = 3 '窗口缺省紧接着是控件设置:Begin VB.CommandButton Command6  
      Caption = "运行状态"
      Height = 495
      Left = 720
      TabIndex = 7
      Top = 480
      Width = 1215
    End
    ……这里声明的是一个按钮控件,名称是Command6,标题是“运行状态”然后的是系统设置(未知其用途):Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    再后面的就是代码区,就是代码窗口里的代码。