frmmain.frm

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

    szOutputBuffer(1) = Command
    szOutputBuffer(2) = AckCode \ &H100
    szOutputBuffer(3) = AckCode Mod &H100
    szOutputBuffer(4) = DINumber \ &H100
    szOutputBuffer(5) = DINumber Mod &H100
    szOutputBuffer(6) = StartID \ &H100
    szOutputBuffer(7) = StartID Mod &H100
    szOutputBuffer(8) = AINumber \ &H100
    szOutputBuffer(9) = AINumber Mod &H100
    szOutputBuffer(10) = TotalSize \ &H100
    szOutputBuffer(11) = TotalSize Mod &H100
    For wLoop = 1 To 11 Step 1
        wCheckSum = (wCheckSum + szOutputBuffer(wLoop)) Mod &H10000
    Next
    
    wSize = 12
    
    'DINumber * 3 改为 DINumber * 3 - 1
    For wLoop = 0 To DINumber * 3 - 1 Step 1
        szOutputBuffer(wSize) = DIBuffer(wLoop)
        wCheckSum = (wCheckSum + szOutputBuffer(wSize)) Mod &H10000
        wSize = wSize + 1
    Next wLoop
        
    'DINumber * 3 改为 DINumber * 3 - 1
    For wLoop = 0 To TotalSize - DINumber * 3 - 1 Step 1
        szOutputBuffer(wSize) = AIBuffer(wLoop)
        wCheckSum = (wCheckSum + szOutputBuffer(wSize)) Mod &H10000
        wSize = wSize + 1
    Next wLoop
    szOutputBuffer(wSize + 0) = (wCheckSum \ &H100)
    szOutputBuffer(wSize + 1) = (wCheckSum Mod &H100)
    szOutputBuffer(wSize + 2) = ENDBYTE
    wOutputBuffer = wSize + 3
    BuildCommand = True
End Function

'
'   置第bLocation位为1,其它位不变
'
Private Function SetBits(bValue As Byte, bLocation As Byte) As Byte
    SetBits = bValue Or (2 ^ bLocation)
End Function

'
'   置第bLocation位为0,其它位不变
'
Private Function ResetBits(bValue As Byte, bLocation As Byte) As Byte
    Dim byTmp As Byte
'    ResetBits = bValue And (2 ^ bLocation)
    byTmp = bValue And (2 ^ bLocation)
    If byTmp <> 0 Then
        ResetBits = bValue And (Not 2 ^ bLocation)
    End If
End Function

'
'
'
Private Function GetBits(bValue As Byte, bLocation As Byte) As Boolean
    GetBits = ((bValue And (2 * bLocation)) <> 0)
End Function

'
'
'
Private Sub munStartStop_Click()

    bStartStop = Not bStartStop
    CommTimer.Enabled = bStartStop
    If bStartStop Then
        munStartStop.Caption = "&Stop"
    Else
        munStartStop.Caption = "&Start"
    End If
End Sub

'
'
Private Sub Display(szDisplayBuffer() As Byte)
    Dim iLoop As Integer
    Dim iCounter As Integer
    Dim sTemp As String
    
    iCounter = 0
    sTemp = ""
    For iLoop = LBound(szDisplayBuffer) To UBound(szDisplayBuffer)
        If bDisplay And szDisplayBuffer(iLoop) >= &H20 And szDisplayBuffer(iLoop) < &H80 Then
            sTemp = sTemp + Chr(szDisplayBuffer(iLoop))
        Else
            If Len(Hex(szDisplayBuffer(iLoop))) = 1 Then
                sTemp = sTemp + "[0" + Hex(szDisplayBuffer(iLoop)) + "]"
            Else
                sTemp = sTemp + "[" + Hex(szDisplayBuffer(iLoop)) + "]"
            End If
        End If
        iCounter = (iCounter + 1) Mod MAXCOLS
        If iCounter = 0 Then
            HandleOutput (sTemp)
            sTemp = ""
        End If
    Next iLoop
    If iCounter <> 0 Then
        HandleOutput (sTemp)
        sTemp = ""
    End If
End Sub

Private Function SetPort() As Boolean
    Dim Port As Long
    Dim mode As Long
    Dim Hw As Long, Sw As Long
    Dim ret As Long
    Dim tout As Long
    Dim sTmp As String
    
    Dim baud As String
    Dim parity As String
    Dim data_bit As Integer
    Dim stop_bit As Integer
    
    Port = SysDefine.CommPort
    sTmp = SysDefine.Settings
    baud = Left(sTmp, InStr(sTmp, ",") - 1): sTmp = Right(sTmp, Len(sTmp) - InStr(sTmp, ","))
    parity = Left(sTmp, 1): sTmp = Right(sTmp, Len(sTmp) - 2)
    data_bit = Val(sTmp): sTmp = Right(sTmp, 1)
    stop_bit = Val(sTmp)
    
    Select Case UCase(parity)
        Case "N"
            mode = P_NONE
        Case "O"
            mode = P_ODD
        Case "E"
            mode = P_EVEN
        Case "M"
            mode = P_MRK
        Case "S"
            mode = P_SPC
        Case Else
            mode = P_NONE
    End Select
    Select Case data_bit
        Case 5
            mode = mode Or BIT_5
        Case 6
            mode = mode Or BIT_6
        Case 7
            mode = mode Or BIT_7
        Case 8
            mode = mode Or BIT_8
        Case Else
            mode = mode Or BIT_8
    End Select
    Select Case stop_bit
        Case 1
            mode = mode Or STOP_1
        Case 2
            mode = mode Or STOP_2
        Case Else
            mode = mode Or STOP_1
    End Select
    SetPort = False
    Select Case baud
        Case "50"
            ret = sio_ioctl(Port, B50, mode)
        Case "75"
            ret = sio_ioctl(Port, B75, mode)
        Case "110"
            ret = sio_ioctl(Port, B110, mode)
        Case "134"
            ret = sio_ioctl(Port, B134, mode)
        Case "150"
            ret = sio_ioctl(Port, B150, mode)
        Case "300"
            ret = sio_ioctl(Port, B300, mode)
        Case "600"
            ret = sio_ioctl(Port, B600, mode)
        Case "1200"
            ret = sio_ioctl(Port, B1200, mode)
        Case "1800"
            ret = sio_ioctl(Port, B1800, mode)
        Case "2400"
            ret = sio_ioctl(Port, B2400, mode)
        Case "4800"
            ret = sio_ioctl(Port, B4800, mode)
        Case "7200"
            ret = sio_ioctl(Port, B7200, mode)
        Case "9600"
            ret = sio_ioctl(Port, B9600, mode)
        Case "19200"
            ret = sio_ioctl(Port, B19200, mode)
        Case "38400"
            ret = sio_ioctl(Port, B38400, mode)
        Case "57600"
            ret = sio_ioctl(Port, B57600, mode)
        Case "115200"
            ret = sio_ioctl(Port, B115200, mode)
        Case "230400"
            ret = sio_ioctl(Port, B230400, mode)
        Case "460800"
            ret = sio_ioctl(Port, B460800, mode)
        Case "921600"
            ret = sio_ioctl(Port, B921600, mode)
        Case Else
            ret = sio_ioctl(Port, B1200, mode)
    End Select
    If ret <> SIO_OK Then
        HandleOutput ("设定时发生错误")
        Exit Function
    End If
    Hw = 0
    Sw = 0
    ret = sio_flowctrl(Port, Hw Or Sw)
    If ret <> SIO_OK Then
        HandleOutput ("流量设定时发生错误")
        Exit Function
    End If
    SetPort = True
End Function

Private Sub Timer1_Timer()
    Dim szInbuffer() As Byte
    Dim wInBuffer As Integer
    Dim wLoop As Integer
    Dim wTemp As Integer
    Dim wTempBuffer As Integer
    Dim szTempBuffer(4096) As Byte
    
    Timer1.Enabled = False
    Do
        DoEvents
        wTempBuffer = sio_read(SysDefine.CommPort, 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 sio_flush(SysDefine.CommPort, 0)
                    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)
                End If
            End If
        Next wLoop
    Loop
End Sub

Public Sub InitDDE()
    Dim wLoop As Integer

    txtOutput.Text = "Init DDE..." & vbCrLf & vbCrLf
    bMonitor = True
    bDisplay = True
    DataCycle = 0
    If SysDefine.CommType = COMMSERVER Then
        DoEvents
        frmMain.Caption = "DDETOCOM  --  Server"
        munStartStop.Enabled = False
        If wReadDigitalNodePoint > 0 Then
            For wLoop = 0 To wReadDigitalNodePoint - 1 Step 1
                On Error GoTo DDEDigitalError
                If wLoop > GetDataText.UBound - GetDataText.LBound Then
                    Load GetDataText(wLoop)
                End If
                GetDataText(wLoop).Visible = False
                GetDataText(wLoop).LinkMode = NONE
                GetDataText(wLoop).LinkTimeout = 50
                GetDataText(wLoop).LinkTopic = SysDefine.Application + "|" + pndReadDigitalCommandPoint(wLoop).DDETopic
                GetDataText(wLoop).LinkItem = pndReadDigitalCommandPoint(wLoop).DDEItem
                GetDataText(wLoop).LinkMode = AUTOMATIC
            Next wLoop
        End If
        If wReadAnalogNodePoint > 0 Then
            For wLoop = wReadDigitalNodePoint To wReadAnalogNodePoint + wReadDigitalNodePoint - 1 Step 1
                On Error GoTo DDEAnalogError
                If wLoop > GetDataText.UBound - GetDataText.LBound Then
                    Load GetDataText(wLoop)
                End If
                GetDataText(wLoop).Visible = False
                GetDataText(wLoop).LinkMode = NONE
                GetDataText(wLoop).LinkTimeout = 50
                GetDataText(wLoop).LinkTopic = SysDefine.Application + "|" + pndReadAnalogCommandPoint(wLoop - wReadDigitalNodePoint).DDETopic
                GetDataText(wLoop).LinkItem = pndReadAnalogCommandPoint(wLoop - wReadDigitalNodePoint).DDEItem
                GetDataText(wLoop).LinkMode = AUTOMATIC
            Next wLoop
        End If
        Timer1.Enabled = True
    Else
        frmMain.Caption = "DDETOCOM  --  Client"
        CommTimer.Interval = SysDefine.SampleTime
        CommTimer.Enabled = True
        Call munStartStop_Click
    End If
    
    Dim ret%
    ret = sio_open(SysDefine.CommPort)
    Call sio_RTS(SysDefine.CommPort, 0)
    If ret <> SIO_OK Or (Not SetPort) Then
        GoTo COMError
    End If
    txtOutput.Text = ""
    Exit Sub
ErrorHandler:
    If Err = 282 Then
        DoEvents
        Resume
    End If
DDEDigitalError:
    Call HandleOutput(SysDefine.Application + "|" + pndReadDigitalCommandPoint(wLoop).DDETopic + " " + pndReadDigitalCommandPoint(wLoop).DDEItem + " Error")
    Exit Sub
DDEAnalogError:
    Call HandleOutput(SysDefine.Application + "|" + pndReadAnalogCommandPoint(wLoop).DDETopic + " " + pndReadAnalogCommandPoint(wLoop).DDEItem + " Error")
    Exit Sub
COMError:
    Call HandleOutput("Open COM" + Format(SysDefine.CommPort) + " Error")
    sio_close (SysDefine.CommPort)
    Exit Sub
End Sub