16.txt

介绍vb与PLCS7200通讯的程序

Option Explicit 
Dim intTime As Integer 
Private strSendText As String '发送文本数据 
Private bytSendByte() As Byte '发送二进制数据 
Private blnReceiveFlag As Boolean 
Private blnAutoSendFlag As Boolean 
Private intPort As Integer 
Private strSet As String 
Private intReceiveLen As Integer 
Private bytReceiveByte() As Byte 
Private strAscii As String '设置初值 
Private strHex As String 
Private intHexWidth As Integer 
Private intLine As Integer 
Private m As Integer 
Private strAddress As String 
'字符表示的十六进制数转化为相应的整数,错误则返回 -1 
Function ConvertHexChr(str As String) As Integer 
Dim test As Integer 
test = Asc(str) 
If test >= Asc("0") And test <= Asc("9") Then 
test = test - Asc("0") 
ElseIf test >= Asc("a") And test <= Asc("f") Then 
test = test - Asc("a") + 10 
ElseIf test >= Asc("A") And test <= Asc("F") Then 
test = test - Asc("A") + 10 
Else 
test = -1 '出错信息 
End If 
ConvertHexChr = test 
End Function 

'字符串表示的十六进制数据转化为相应的字节串,返回转化后的字节数 
Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer 
Dim HexData As Integer '十六进制(二进制)数据字节对应值 
Dim hstr As String * 1 '高位字符 
Dim lstr As String * 1 '低位字符 
Dim HighHexData As Integer '高位数值 
Dim LowHexData As Integer '低位数值 
Dim HexDataLen As Integer '字节数 
Dim StringLen As Integer '字符串长度 
Dim Account As Integer 
Dim n As Integer 
'计数 
'txtSend = "" '设初值 
HexDataLen = 0 
strHexToByteArray = 0 
StringLen = Len(strText) 
Account = StringLen \ 2 
ReDim bytByte(Account) 
For n = 1 To StringLen 
Do '清除空格 
hstr = Mid(strText, n, 1) 
n = n + 1 
If (n - 1) > StringLen Then 
HexDataLen = HexDataLen - 1 
Exit For 
End If 
Loop While hstr = " " 
Do 
lstr = Mid(strText, n, 1) 
n = n + 1 
If (n - 1) > StringLen Then 
HexDataLen = HexDataLen - 1 
Exit For 
End If 
Loop While lstr = " " 
n = n - 1 
If n > StringLen Then 
HexDataLen = HexDataLen - 1 
Exit For 
End If 
HighHexData = ConvertHexChr(hstr) 
LowHexData = ConvertHexChr(lstr) 

If HighHexData = -1 Or LowHexData = -1 Then '遇到非法字符中断转化 
HexDataLen = HexDataLen - 1 
Exit For 
Else 
HexData = HighHexData * 16 + LowHexData 
bytByte(HexDataLen) = HexData 
HexDataLen = HexDataLen + 1 
End If 
Next n 
If HexDataLen > 0 Then '修正最后一次循环改变的数值 
HexDataLen = HexDataLen - 1 
ReDim Preserve bytByte(HexDataLen) 
Else 
ReDim Preserve bytByte(0) 
End If 
If StringLen = 0 Then '如果是空串,则不会进入循环体 
strHexToByteArray = 0 
Else 
strHexToByteArray = HexDataLen + 1 
End If 
End Function 

Private Sub cmdManualSend_Click() 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Call ctrTimer_Timer 
If Not blnAutoSendFlag Then 
Me.MSComm.PortOpen = False 
End If 
End Sub 
Private Sub cmdAutoSend_Click() 
If blnAutoSendFlag Then 
Me.ctrTimer.Enabled = False 
If Not blnReceiveFlag Then 
Me.MSComm.PortOpen = False 
End If 
Me.cmdAutoSend.Caption = "自动发送" 
Else 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Me.ctrTimer.Interval = intTime 
Me.ctrTimer.Enabled = True 
Me.cmdAutoSend.Caption = "停止发送" 
End If 
blnAutoSendFlag = Not blnAutoSendFlag 
End Sub 

Private Sub cmdSave_Click() 
Open "C:\com.txt" For Output As #1 
Print #1, txtHex 
Close #1 
End Sub 

Private Sub ctrTimer_Timer() 
Dim longth As Integer 
strSendText = Me.txtSend.Text 
longth = strHexToByteArray(strSendText, bytSendByte()) 
If longth > 0 Then 
Me.MSComm.Output = bytSendByte 
End If 
End Sub 
'输入处理,处理接收到的字节流,并保存在全局变量 
Private Sub InputManage(bytInput() As Byte, intInputLenth As Integer) 
Dim n As Integer '定义变量及初始化 
ReDim Preserve bytReceiveByte(intReceiveLen + intInputLenth) 
For n = 1 To intInputLenth Step 1 
bytReceiveByte(intReceiveLen + n - 1) = bytInput(n - 1) 
Next n 
intReceiveLen = intReceiveLen + intInputLenth 
End Sub 

'为输出准备文本,保存在全局变量 
'总行数保存在intLine 
Public Sub GetDisplayText() 
Dim n As Integer 
Dim intValue As Integer 
Dim intHighHex As Integer 
Dim intLowHex As Integer 
Dim strSingleChr As String * 1 
Dim intAddress As Integer 
Dim intAddressArray(8) As Integer 
Dim intHighAddress As Integer 
strAscii = "" '设置初值 
strHex = "" 
strAddress = "" 
'获得16进制码和ASCII码的字符串 
For n = 1 To intReceiveLen 
intValue = bytReceiveByte(n - 1) 
If intValue < 32 Or intValue > 128 Then '处理非法字符 
strSingleChr = Chr(46) '对于不能显示的ASCII码, 
Else '用"."表示 
strSingleChr = Chr(intValue) 
End If 
strAscii = strAscii + strSingleChr 
intHighHex = intValue \ 16 
intLowHex = intValue - intHighHex * 16 
If intHighHex < 10 Then 
intHighHex = intHighHex + 48 
Else 
intHighHex = intHighHex + 55 
End If 
If intLowHex < 10 Then 
intLowHex = intLowHex + 48 
Else 
intLowHex = intLowHex + 55 
End If 
strHex = strHex + Chr$(intHighHex) + Chr$(intLowHex) + " " 
If (n Mod intHexWidth) = 0 Then 
strAscii = strAscii + Chr$(13) + Chr$(10) 
strHex = strHex + Chr$(13) + Chr$(10) 
Else 
End If 
Next n 
txtAsc = strAscii 'Ascii 
txtHex = strHex '16进制 
'获得地址字符串 
intLine = intReceiveLen \ intHexWidth 
If (intReceiveLen - intHexWidth * intLine) > 0 Then 
intLine = intLine + 1 
End If 
'设置换行 
For n = 1 To intLine 
intAddress = (n - 1) * intHexWidth 
intHighAddress = 8 
intAddressArray(0) = intAddress 
For m = 1 To intHighAddress 
intAddressArray(m) = intAddressArray(m - 1) \ 16 
Next m 
For m = 1 To intHighAddress 
intAddressArray(m - 1) = intAddressArray(m - 1) - intAddressArray(m) * 16 
Next m 
For m = 1 To intHighAddress 
If intAddressArray(intHighAddress - m) < 10 Then 
intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("0") 
Else 
intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("A") - 10 
End If 
strAddress = strAddress + Chr$(intAddressArray(intHighAddress - m)) 
Next m 
strAddress = strAddress + Chr$(13) + Chr$(10) 
Next n 
txtAdd = strAddress '地址 
End Sub 
Private Sub cmdReceive_Click() 
If blnReceiveFlag Then 
If Not blnReceiveFlag Then 
Me.MSComm.PortOpen = False 
End If 
Me.cmdReceive.Caption = "开始接收" 
Else 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Me.MSComm.InputLen = 0 
Me.MSComm.InputMode = 0 
Me.MSComm.InBufferCount = 0 
Me.MSComm.RThreshold = 1 
Me.cmdReceive.Caption = "停止接收" 
End If 
blnReceiveFlag = Not blnReceiveFlag 
End Sub 

Private Sub Form_Load() 
intHexWidth = 8 
txtAdd = "" 
txtHex = "" 
txtAsc = "" 
txtSend = "" 
txtAdd.Width = 1335 
txtHex.Width = 2535 
txtAsc.Width = 1215 
'设置默认发送接收关闭状态 
blnAutoSendFlag = False 
blnReceiveFlag = False 
'接收初始化 
intReceiveLen = 0 
'默认发送方式为16进制 
'intOutMode = 1 
'初始化串行口 
intPort = 1 
intTime = 1000 
'ctrTimer.Interval = intTime 
strSet = "9600,n,8,1" 
Me.MSComm.InBufferSize = 1024 
Me.MSComm.OutBufferSize = 512 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
Me.MSComm.PortOpen = False 
'ctrTimer.Enabled = True 
End Sub 

Private Sub cmdClear_Click() 
Dim bytTemp(0) As Byte 
ReDim bytReceiveByte(0) 
intReceiveLen = 0 
Call InputManage(bytTemp, 0) 
Call GetDisplayText 
Call disPlay 
End Sub 

Private Sub MsComm_OnComm() 
Dim bytInput() As Byte 
Dim intInputLen As Integer 
Select Case Me.MSComm.CommEvent 
Case comEvReceive 
If blnReceiveFlag Then 
If Not Me.MSComm.PortOpen Then 
Me.MSComm.CommPort = intPort 
Me.MSComm.Settings = strSet 
Me.MSComm.PortOpen = True 
End If 
'此处添加处理接收的代码 
Me.MSComm.InputMode = comInputModeBinary '二进制接收 
'Me.MSComm.InputMode = comInputModeText '二进制接收 
intInputLen = Me.MSComm.InBufferCount 
ReDim bytInput(intInputLen) 
bytInput = Me.MSComm.Input 
Call InputManage(bytInput, intInputLen) 
Call GetDisplayText 
'Call disPlay 
If Not blnReceiveFlag Then 
Me.MSComm.PortOpen = False 
End If 
End If 
End Select 
End Sub 

Private Sub disPlay() 
txtHex = "" 
txtAsc = "" 
txtAdd = "" 
End Sub



高精度电压表(24bit)  VB源程序

Dim PortValue As Integer    '端口号选择1-4

Dim value As Double         '当前一次取值

Dim value2 As Double        '要显示的值

Dim valueSum As Double        '和

Dim numCount As Double      '算平均值是的计数个数

Dim func As Integer         '功能号标志1-4

Dim valueFlag As Integer

Private Sub Check1_Click()

'自动刷新 被选中则 刷新按钮无效

If Check1.value Then

    Command1.Enabled = False

Else

    Command1.Enabled = True

    

    Command1.SetFocus

End If

End Sub

Private Sub Command1_Click()

    '显示

    Call display

End Sub

Private Sub Command2_Click()

    valueSum = 0 '清计数和

    numCount = 1 '清计数个数

    Label6.Caption = Str(numCount - 1) '显示复位

    value = 0

    value2 = 0

    valueFlag = 0

    Call display

End Sub

Private Sub Form_Activate()

    numCount = 1

    value = 0

    valueSum = 0

    PortValue = 1

    Text1.Visible = False

    Label6.Caption = "0"

    Option1(0).value = True

    Option2(0).value = True

    Command1.SetFocus

    Label1.Caption = Format(value2, "0.000,000")

    For i = 0 To 3

        If Option2(i).value = True Then

            func = i + 1

        End If

    Next i

    Check1.value = 1

    'Call ComPortOpen

End Sub

Public Sub ComPortOpen() '开串口

    With MSComm1

        .CommPort = PortValue              '使用COM1

        .Settings = "9600,N,8,1"       '设置通信口参数

        .InBufferSize = 40

        '设置MSComm1接收缓冲区为40字节

        '.OutBufferSize = 2

        '设置MSComm1发送缓冲区为2字节

        .InputMode = comInputModeBinary

        '设置接收数据模式为二进制形式

        .InputLen = 1

        '设置Input 一次从接收缓冲读取字节数为1

        '.SThreshold = 1

        '设置Output 一次从发送缓冲读取字节数为1

        .InBufferCount = 0  '清除接收缓冲区

        '.OutBufferCount = 0     '清除发送缓冲区

        'MaxW = -99

        '最大值赋初值

        'MinW = 99             '最小值赋初值

        'w = 0

        '数据个数计数器清零

        .RThreshold = 1

        On Error Resume Next

        '设置接收一个字节产生OnComm事件

        If .PortOpen = False Then

            '判断通信口是否打开

            .PortOpen = True       '打开通信口

            If Err Then        '错误处理

                msg = MsgBox(" 串口 COM" & PortValue & " 无效！ ", vbOKOnly, "警告")

                Exit Sub

            End If

        End If

    End With

    'MsgBox "端口已打开"