frmmain.frm

这是一个基于串口的数据转换程序,它可以把OPC DDE的数据转发至串口的客户端程序

VERSION 5.00
Begin VB.Form frmMain 
   Appearance      =   0  'Flat
   BackColor       =   &H80000009&
   Caption         =   "DDE To COM"
   ClientHeight    =   6705
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   6435
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6705
   ScaleMode       =   0  'User
   ScaleWidth      =   6435
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   2280
      Top             =   2400
   End
   Begin VB.Timer CommTimer 
      Enabled         =   0   'False
      Left            =   1710
      Top             =   1680
   End
   Begin VB.Timer ResetRTSTimer 
      Interval        =   20
      Left            =   3180
      Top             =   1830
   End
   Begin VB.Timer SetRTSTimer 
      Interval        =   100
      Left            =   2340
      Top             =   1680
   End
   Begin VB.TextBox GetDataText 
      Height          =   360
      Index           =   0
      Left            =   840
      TabIndex        =   0
      Top             =   480
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.TextBox SetDataText 
      Height          =   375
      Index           =   0
      Left            =   840
      TabIndex        =   1
      Top             =   1080
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.TextBox txtOutput 
      Enabled         =   0   'False
      Height          =   4695
      Left            =   0
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   0
      Width           =   3705
   End
   Begin VB.Menu munExit 
      Caption         =   "&Exit"
   End
   Begin VB.Menu munStartStop 
      Caption         =   "&Start"
   End
   Begin VB.Menu munAbout 
      Caption         =   "&About"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const MAXLINES = 25               '显示行数
Private Const MAXCOLS = 16

Private Const SYNBYTE As Byte = &H2A      '同步字符
Private Const ENDBYTE As Byte = &HD       '结束字符

Private Const READDATA As Byte = &H0      '读数据
Private Const WRITEDATA As Byte = &H80    '写数据

Private Const AUTOMATIC = 1               '自动
Private Const MANUAL = 2                  '手工
Private Const NONE = 0                    '无

Private Const CMDOK = &H0                 '正常
Private Const CMDERROR = 65535 '&HFFFF    '错误

Private OutputLine As Integer             '输出行数
Private wInputBuffer As Integer           '输入字符数
Private szInputBuffer() As Byte           '输入缓冲区
Private StartID As Integer                '起始ID
Private DataCycle As Integer              '
Private szOutBuffer() As Byte             '输出缓冲区
Private wOutBuffer As Integer             '输出字符数

Private bMonitor As Boolean
Private bDisplay As Boolean
Private bStartStop As Boolean

Private CommCounter As Long

'
'   "周期发送"定时器
'
Private Sub CommTimer_Timer()
    Dim Port As Integer
    Dim szInbuffer() As Byte
    Dim wInBuffer As Integer
    Dim temp1() As Byte
    Dim temp2() As Byte
    Dim ret%
    Dim tt As Long
    Dim bRec As Boolean
    Dim wLoop As Integer
    
    Dim wTemp As Integer
    Dim wTempBuffer As Integer
    Dim szTempBuffer(4096) As Byte
    
    CommTimer.Enabled = False
    Port = SysDefine.CommPort
    Call BuildCommand(szInbuffer, wInBuffer, READDATA, CMDERROR, 0, 0, 0, temp1, temp2, 0)
    Call HexToAsc(szInbuffer, szOutBuffer, wInBuffer, wOutBuffer)
    ret = sio_RTS(Port, 1)
    If ret = SIO_OK Then
        TimeDelay 100
        Call HandleOutput("[" + Format(CommCounter) + "]" + "Write " + Format(UBound(szOutBuffer) - LBound(szOutBuffer) + 1) + " Bytes >>>>")
        CommCounter = (CommCounter + 1) Mod &H80000000
        If bMonitor Then
            Call Display(szOutBuffer)
        End If
        Call sio_flush(SysDefine.CommPort, 1)
        Call sio_write(SysDefine.CommPort, szOutBuffer(0), UBound(szOutBuffer) + 1)
        TimeDelay 20
        ret = sio_RTS(Port, 0)
        If ret <> SIO_OK Then
            Debug.Print "RTS置低出错"
            Exit Sub
        End If
    Else
        Debug.Print "RTS置高出错"
        Exit Sub
    End If
        
    bRec = False
    tt = GetTickCount()
    Call sio_flush(SysDefine.CommPort, 0)
    Do
        DoEvents
        wTempBuffer = sio_read(Port, szTempBuffer(0), 4096)
        For wLoop = 0 To wTempBuffer - 1
            wTemp = szTempBuffer(wLoop)
            If wTemp = SYNBYTE Then
                wInputBuffer = 1
                ReDim szInputBuffer(0) As Byte
                szInputBuffer(0) = wTemp
            ElseIf wInputBuffer > 0 Then
                ReDim Preserve szInputBuffer(wInputBuffer)
                szInputBuffer(wInputBuffer) = wTemp
                wInputBuffer = wInputBuffer + 1
                If wTemp = ENDBYTE Then
                    Call HandleOutput("Read " + Format(UBound(szInputBuffer) - LBound(szInputBuffer) + 1) + " Bytes <<<<")
                    If bMonitor Then
                        Call Display(szInputBuffer)
                    End If
                    Call AscToHex(szInputBuffer, szInbuffer, wInputBuffer, wInBuffer)
                    Call AnalyzeCommand(szInbuffer, wInBuffer)
                    bRec = True
                End If
            End If
        Next wLoop
    Loop Until GetTickCount - tt > SysDefine.CheckTime Or GetTickCount < tt Or bRec
    If bRec Then Debug.Print "OK" Else Debug.Print "TimeOut"
    
    CommTimer.Enabled = bStartStop
End Sub

'
'   载入窗体
'

Private Sub Form_Load()
End Sub

'
'   输出文本框大小随窗体大小而变
'

Private Sub Form_Resize()
    txtOutput.Left = 0
    txtOutput.Top = 0
    txtOutput.Width = frmMain.ScaleWidth
    txtOutput.Height = frmMain.ScaleHeight
End Sub

'
'   关闭窗体前先关闭串口
'

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Call sio_RTS(SysDefine.CommPort, 0)
    sio_close (SysDefine.CommPort)
    Set frmMain = Nothing
    End
End Sub

Private Sub munAbout_Click()
    MsgBox "DDETOCOM V1.0,(C)深圳合广信息技术有限公司,2001"
End Sub

'
'   退出
'

Private Sub munExit_Click()
    Unload Me
End Sub

'
'   处理输出
'

Private Sub HandleOutput(szString As String)
    Static wDisplayLines As Integer

    If wDisplayLines >= MAXLINES Then
        txtOutput.Text = strrtok(txtOutput.Text, Chr(&HD) + Chr(&HA))
    Else
        wDisplayLines = wDisplayLines + 1
    End If
    txtOutput.Text = txtOutput + szString + Chr(&HD) + Chr(&HA)
End Sub

'
'   Asc --> Hex
'

Private Function AscToHex(szInbuffer() As Byte, _
                          szOutBuffer() As Byte, _
                          wInBuffer As Integer, _
                          wOutBuffer As Integer) _
                          As Boolean
    Dim wLoop As Integer
    
    On Error Resume Next
    If wInBuffer > 0 Then
        wOutBuffer = wInBuffer \ 2 + 1
        ReDim szOutBuffer(wOutBuffer - 1) As Byte
        szOutBuffer(0) = szInbuffer(0)
        If wOutBuffer > 2 Then
            For wLoop = 1 To wOutBuffer - 2 Step 1
                szOutBuffer(wLoop) = IIf(szInbuffer(wLoop * 2 - 1) > &H40, _
                                         szInbuffer(wLoop * 2 - 1) - &H41 + &HA, _
                                         szInbuffer(wLoop * 2 - 1) - &H30) * &H10 + _
                                     IIf(szInbuffer(wLoop * 2) > &H40, _
                                         szInbuffer(wLoop * 2) - &H41 + &HA, _
                                         szInbuffer(wLoop * 2) - &H30)
            Next wLoop
        End If
        szOutBuffer(wOutBuffer - 1) = szInbuffer(wInBuffer - 1)
    End If
    AscToHex = True
End Function

'
'   Hex --> Asc
'

Private Function HexToAsc(szInbuffer() As Byte, _
                          szOutBuffer() As Byte, _
                          wInBuffer As Integer, _
                          wOutBuffer As Integer) _
                          As Boolean
    Dim wLoop As Integer

    On Error Resume Next
    If wInBuffer > 0 Then
        wOutBuffer = (wInBuffer - 1) * 2
        ReDim szOutBuffer(wOutBuffer - 1) As Byte
        szOutBuffer(0) = szInbuffer(0)
        If wInBuffer > 2 Then
            For wLoop = 1 To wInBuffer - 2 Step 1
                szOutBuffer(wLoop * 2 - 1) = IIf(szInbuffer(wLoop) \ &H10 > &H9, _
                                                 szInbuffer(wLoop) \ &H10 - &HA + &H41, _
                                                 szInbuffer(wLoop) \ &H10 + &H30)
                szOutBuffer(wLoop * 2 - 0) = IIf(szInbuffer(wLoop) Mod &H10 > &H9, _
                                                 szInbuffer(wLoop) Mod &H10 - &HA + &H41, _
                                                 szInbuffer(wLoop) Mod &H10 + &H30)
            Next wLoop
        End If
        szOutBuffer(wOutBuffer - 1) = szInbuffer(wInBuffer - 1)
    End If
    HexToAsc = True
End Function

'
'   分析收到的数据,确定是以下的哪种情况:
'
'       1.建立采样命令
'       2.分析采样结果
'       3.建立控制命令
'       4.分析控制结果
'
'   并转入相应的子程序(此程序只有前两种情况)
'

Private Function AnalyzeCommand(szAnalyzeBuffer() As Byte, _
                                wAnalyzeBuffer As Integer) _
                                As Boolean
    Dim wCommandSize As Integer