求VB高手能把这编程一个程序 - -!
Begin VB.Form Form1Caption = "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--------------------编程问答-------------------- 要送分就多弄点,40分,太少了
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
顶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
--------------------编程问答-------------------- 太吓人了。。。。 --------------------编程问答--------------------
LZ:既然你我修改后没错误了,但是只能读取和写入一个地址
那就核查你的PLC说明书所规约的通信协议于指令的格式来对照你能成功读取和写入一个地址的代码修改其它代码并调试. --------------------编程问答-------------------- 我现在修改成可以读写任意位置的数据 可是怎样才能一次读写多个数据呢 麻烦各位给个头绪 --------------------编程问答--------------------
一次读写多个数据是不现实的.
你应该用定时器,定时逐个读取不同(地址)的数据.并将接收代码置于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 , 基础类