当前位置:编程学习 > VB >>

求VB高手能把这编程一个程序 - -!

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 Sub



Private 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

--------------------编程问答-------------------- 这个太简单了吧?别被人当成倒分 --------------------编程问答-------------------- 这难道不是VB程序?还想怎么样? --------------------编程问答-------------------- 将内容贴到一个文本文件中,然后将后缀名改为frm,最后双击这个frm文件即可。 --------------------编程问答-------------------- LZ:你新建一个VB的EXE工程,在工程(P)菜单下选部件项,在Microsoft Comm Control 6.0 (Sp6)前选钩并确定,然后在窗体上添加该控件,并添加6个按钮控件和1个Timer控件(命名为Timer2)到窗体.
将Dim tim As Integer开始的行及以下所有代码复制到VB该窗体的代码编辑窗口,然后运行并一一纠错.
--------------------编程问答-------------------- 楼上的各位没明白:楼主想变成一个EXE

编程一个程序=变成一个程序 --------------------编程问答-------------------- 从 http://hi.baidu.com/siskinzs/blog/item/bfb4b64564c0f841510ffeab.html 这里粘来的?

要想变魔术变一个程序出来,lz你得安装Visual Basic这个神奇的工具软件。 --------------------编程问答-------------------- 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
--------------------编程问答-------------------- 要送分就多弄点,40分,太少了

顶3楼,不过要吧
COMM初始化

这样的注释去掉吧? --------------------编程问答--------------------
引用 8 楼 spt_petrolor 的回复:
要送分就多弄点,40分,太少了

顶3楼,不过要吧
COMM初始化

这样的注释去掉吧?

lz不错了,没见还有好多20,10分的 --------------------编程问答-------------------- 我修改后没错误了   但是只能读取和写入一个地址  希望各位大大帮我修改下   
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 String



Public 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 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

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



Private 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 Sub



Private 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 Sub



Private 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 Sub

Private 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 Sub

Private Sub Form_Load()
Dim tim As Date
tim = 0
Call INIT_comm
End Sub

--------------------编程问答--------------------
引用 10 楼 xuankehe 的回复:
我修改后没错误了   但是只能读取和写入一个地址  希望各位大大帮我修改下   
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 ……
太吓人了。。。。 --------------------编程问答--------------------
引用 10 楼 xuankehe 的回复:
我修改后没错误了 但是只能读取和写入一个地址 希望各位大大帮我修改下  


LZ:既然你我修改后没错误了,但是只能读取和写入一个地址
那就核查你的PLC说明书所规约的通信协议于指令的格式来对照你能成功读取和写入一个地址的代码修改其它代码并调试. --------------------编程问答--------------------
引用 12 楼 zdingyun 的回复:
引用 10 楼 xuankehe 的回复:
我修改后没错误了 但是只能读取和写入一个地址 希望各位大大帮我修改下



LZ:既然你我修改后没错误了,但是只能读取和写入一个地址
那就核查你的PLC说明书所规约的通信协议于指令的格式来对照你能成功读取和写入一个地址的代码修改其它代码并调试.
我现在修改成可以读写任意位置的数据   可是怎样才能一次读写多个数据呢  麻烦各位给个头绪 --------------------编程问答--------------------
引用 13 楼 xuankehe 的回复:
我现在修改成可以读写任意位置的数据 可是怎样才能一次读写多个数据呢 麻烦各位给个头绪

一次读写多个数据是不现实的.
你应该用定时器,定时逐个读取不同(地址)的数据.并将接收代码置于MsComm控件的OnComm事件中,按PLC规约的数据帧判断与处理数据. --------------------编程问答-------------------- 不是啊,你的这一个是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


再后面的就是代码区,就是代码窗口里的代码。 --------------------编程问答-------------------- 只有按照我上面的操作做后,你的这些代码才真正的变成了一个窗体文件,楼上的有些修改将你原有的窗体属性都删掉了
补充:VB ,  基础类
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,