mdlmain.bas

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

'
'   isdigital("1A")  返回值:49
'   isdigital("A1")  返回值:-1
'

Private Function isdigital(ByVal TestChar As String) As Integer
    Dim TempChar As Integer

    TempChar = Asc(TestChar)
    If TempChar >= Asc("0") And TempChar <= Asc("9") Then
        isdigital = TempChar - &H30
    Else
        isdigital = -1
    End If
End Function

'
'   根据组态文件填充结构Sysdefine和四个结构数组
'   pndReadDigitalCommandPoint()
'   pndReadAnalogCommandPoint()
'   pndWriteDigitalCommandPoint()
'   pndWriteAnalogCommandPoint()
'

Private Function InitConfig(ByVal lpszFileName As String) As Boolean
    Dim TextLine As String
    Dim TempString As String
    Dim Seperator As String
    Dim TempDataStruct As DataStruct
    Dim wStep As Integer
    Dim bReadWrite As Boolean
    Dim TempChar As Integer
    Dim TempTagger As Long
    Dim bReturn As Boolean
    Dim dfValue As Double
    Dim btFlag As Byte
    Dim wTemp As Integer

    Seperator = " =,:" + Chr$(9)
    On Error GoTo OpenFileErrorHandle
    Open lpszFileName For Input Access Read Shared As #1
    Do While Not EOF(1)
        bReturn = True
        Line Input #1, TextLine
        wTemp = strstr(TextLine, ";")
        If wTemp > 0 Then
            TempString = Left(TextLine, wTemp - 1)
        Else
            TempString = TextLine
        End If
        If TempString <> "" Then
            TempString = strtok(TempString, Seperator)
            If TempString <> "" Then
                If StrComp(TempString, "SAMPLE", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 0 Then
                        SysDefine.SampleTime = Val(TempString)
                    End If
                ElseIf StrComp(TempString, "CHECK", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 0 Then
                        SysDefine.CheckTime = Val(TempString)
                    End If
                ElseIf StrComp(TempString, "NUMBER", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 0 Then
                        SysDefine.Number = Val(TempString)
                    End If
                ElseIf StrComp(TempString, "LOCK", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 0 Then
                        SysDefine.bLockFlag = Val(TempString)
                    End If
                ElseIf StrComp(TempString, "APPLICATION", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 0 Then
                        SysDefine.Application = TempString
                    End If
                ElseIf StrComp(TempString, "TOTALWATCHDOG", vbTextCompare) = 0 Then
                    If SysDefine.CommType = COMMCLIENT Then
                        TempString = strtok("", Seperator)
                        If Len(TempString) > 0 Then
    '                        bReturn = STRtoTABLE(TempString, SysDefine.wTotalWatchDogTab, SysDefine.wTotalWatchDogID)
                            TempTagger = STRtoTABLE(TempString)
                            If TempTagger <> 0 Then
                                SysDefine.wTotalWatchDogTab = TempTagger / &H10000
                                SysDefine.wTotalWatchDogID = TempTagger Mod &H10000
                            Else
                                bReturn = False
                            End If
                            dfValue = 0#
                            bReturn = WriteMem(SysDefine.wTotalWatchDogTab, SysDefine.wTotalWatchDogID, dfValue, btFlag)
                        End If
                    End If
                ElseIf StrComp(TempString, "PORT", vbTextCompare) = 0 Or StrComp(TempString, "COM", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 3 Then
                        SysDefine.CommPort = Val(Right(TempString, Len(TempString) - 3))
                        TempString = strtok("", " =" + Chr$(9))
                        If Len(TempString) > 0 Then
                            SysDefine.Settings = TempString
                        End If
                    End If
                ElseIf StrComp(TempString, "FLASH", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 0 Then
                        SysDefine.FlashCycle = Val(TempString)
                    End If
                ElseIf StrComp(TempString, "TYPE", vbTextCompare) = 0 Then
                    TempString = strtok("", Seperator)
                    If Len(TempString) > 0 Then
                        If Asc(UCase(TempString)) = Asc("M") Or Asc(UCase(TempString)) = Asc("C") Then
                            SysDefine.CommType = COMMCLIENT
                        Else
                            SysDefine.CommType = COMMSERVER
                        End If
                    End If
                ElseIf isdigital(TempString) >= 0 Then
                    For wStep = 1 To 9 Step 1
                        If Len(TempString) <= 0 Then
                            Exit For
                        End If
                        Select Case wStep
                            Case 1
                                TempDataStruct.Cycle = Val(TempString)
                            Case 2
                                TempChar = Asc(UCase(TempString))
                                If TempChar = Asc("R") Then
                                    bReadWrite = False
                                Else
                                    bReadWrite = True
                                End If
                            Case 3
                                TempDataStruct.ID = Val(TempString)
                            Case 4
                                TempDataStruct.DDETopic = TempString
                            Case 5
                                TempDataStruct.DDEItem = TempString
                            Case 6
                                If SysDefine.CommType = COMMCLIENT Then
    '                                bReturn = STRtoTABLE(TempString, TempNode.wFirstTagTab, TempNode.wFirstTagID)
                                    TempTagger = STRtoTABLE(TempString)
                                    If TempTagger <> 0 Then
                                        TempDataStruct.TagTab = TempTagger / &H10000
                                        TempDataStruct.TagID = TempTagger Mod &H10000
                                    Else
                                        bReturn = False
                                    End If
                                End If
                            Case 7
                                TempDataStruct.DataType = Asc(UCase(TempString))
                            Case 8
                                TempDataStruct.Power = Val(TempString)
                            Case 9
                                TempDataStruct.DeadArea = Val(TempString)
                        End Select
                        TempString = strtok("", " =," + Chr$(9))
                    Next wStep
                    If (wStep >= 9) Then
                        TempDataStruct.Value = 0#
                        If bReadWrite Then
                            If TempDataStruct.DataType = Asc("D") Then
                                ReDim Preserve pndWriteDigitalCommandPoint(wWriteDigitalNodePoint) As DataStruct
                                pndWriteDigitalCommandPoint(wWriteDigitalNodePoint) = TempDataStruct
                                wWriteDigitalNodePoint = wWriteDigitalNodePoint + 1
                            Else
                                ReDim Preserve pndWriteAnalogCommandPoint(wWriteAnalogNodePoint) As DataStruct
                                pndWriteAnalogCommandPoint(wWriteAnalogNodePoint) = TempDataStruct
                                wWriteAnalogNodePoint = wWriteAnalogNodePoint + 1
                            End If
                        Else
                            If TempDataStruct.DataType = Asc("D") Then
                                ReDim Preserve pndReadDigitalCommandPoint(wReadDigitalNodePoint) As DataStruct
                                pndReadDigitalCommandPoint(wReadDigitalNodePoint) = TempDataStruct
                                wReadDigitalNodePoint = wReadDigitalNodePoint + 1
                            Else
                                ReDim Preserve pndReadAnalogCommandPoint(wReadAnalogNodePoint) As DataStruct
                                pndReadAnalogCommandPoint(wReadAnalogNodePoint) = TempDataStruct
                                wReadAnalogNodePoint = wReadAnalogNodePoint + 1
                            End If
                        End If
                    Else
                        bReturn = False
                        Exit Do
                    End If
                End If
            End If
        End If
    Loop
OpenFileErrorHandle:
    Close #1
    InitConfig = bReturn
End Function

'
'         初始化缺省
'
'   给结构Sysdefine赋缺省值
'

Private Sub InitDefault()
    SysDefine.Application = "EXCEL"
    SysDefine.bLockFlag = True
    SysDefine.CheckTime = 15000
    SysDefine.CommPort = 1
    SysDefine.CommType = COMMSERVER
    SysDefine.FlashCycle = 10
    SysDefine.Number = 200
    SysDefine.SampleTime = 1000
    SysDefine.Settings = "1200,N,8,1"
    SysDefine.wTotalWatchDogID = 0
    SysDefine.wTotalWatchDogTab = 0
End Sub

Public Sub TimeDelay(LTime As Long)
    Dim tmp As Long
    
    tmp = GetTickCount()
    Do
        DoEvents
    Loop Until GetTickCount - tmp > LTime Or GetTickCount < tmp
End Sub