mdlmain.bas

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

Attribute VB_Name = "mdlMain"
Option Explicit

'通过ID读MACAM变量
'通过ID写MACAM变量
'将字符串转换为ID

 Public Declare Function ReadMem Lib "Rtable.dll" Alias "ReadMemA" (ByVal TagTab As Integer, ByVal TagID As Integer, TagFlag As Double, TagFlag As Byte) As Boolean
 Public Declare Function WriteMem Lib "Rtable.dll" Alias "WriteMemA" (ByVal TagTab As Integer, ByVal TagID As Integer, TagValue As Double, TagFlag As Byte) As Boolean
 Public Declare Function STRtoTABLE Lib "Rtable.dll" Alias "STRtoTABLEA" (ByVal Tagger As String) As Long
'Public Declare Function ReadMem Lib "Rtable98.dll" Alias "ReadMemA" (ByVal TagTab As Long, ByVal TagID As Long, TagFlag As Double, TagFlag As Byte) As Boolean
'Public Declare Function WriteMem Lib "Rtable98.dll" Alias "WriteMemA" (ByVal TagTab As Long, ByVal TagID As Long, TagValue As Double, TagFlag As Byte) As Boolean
'Public Declare Function STRtoTABLE Lib "tagdef98.dll" Alias "STRtoTABLEA" (ByVal Tagger As String, TagTab As Long, TagID As Long) As Boolean
 Public Declare Function GetTickCount Lib "kernel32" () As Long
 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'CLIENT (MASTER): 通过电台请求远端数据,将数据写入MACAM
'SERVER (SLAVE) : 响应请求,通过DDE采集数据,通过电台发送

Public Const COMMCLIENT As Boolean = True
Public Const COMMSERVER As Boolean = False

Type SysInfo
    SampleTime As Long           '基准周期
    CheckTime As Long            '超时等待
    Number As Integer            '包大小
    wTotalWatchDogTab As Integer '看门狗Tab
    wTotalWatchDogID As Integer  '看门狗ID
    bLockFlag As Boolean         '锁标志
    Application As String        'DDE源
    CommPort As Integer          '串口
    Settings As String           '串口设置
    FlashCycle As Integer        '
    CommType As Boolean          '通信方类型
End Type

Type DataStruct
    Cycle As Byte                '周期
    Command As Boolean           '读/写
    ID As Long                   'Item对应的ID
    DDETopic As String           'DDE Topic
    DDEItem As String            'DDE Item
    TagTab As Integer            'TagTab
    TagID As Integer             'TagID
    DataType As Byte             '数据类型
    Power As Byte                '精度
    DeadArea As Byte             '死区
    Value As Double              '值
End Type

Public SysDefine As SysInfo
Public pndReadDigitalCommandPoint() As DataStruct
Public pndReadAnalogCommandPoint() As DataStruct
Public pndWriteDigitalCommandPoint() As DataStruct
Public pndWriteAnalogCommandPoint() As DataStruct
Public wReadDigitalNodePoint As Integer
Public wReadAnalogNodePoint As Integer
Public wWriteDigitalNodePoint As Integer
Public wWriteAnalogNodePoint As Integer

'
'   程序入口:[DDETOCOM.XLS]Sheet1
'
'   读组态文件,分析
'   显示窗口
'

Public Sub Main()
    Dim szConfigFileName As String
    Dim bReturn As Boolean

    szConfigFileName = Trim$(Command)
    If szConfigFileName = "" Then
        szConfigFileName = App.Path + "\DDETOCOM.TXT"
    End If
    Call InitDefault
    bReturn = InitConfig(szConfigFileName)
    If bReturn = False Then
        bReturn = MsgBox("Config file error", vbOKOnly, "ERROR")
        End
    Else
        frmMain.Show
        frmMain.InitDDE
    End If
End Sub

'
'
'

Public Function strrtok(ByVal string1 As String, _
                        ByVal string2 As String) _
                        As String
    
    Static SaveString As String
    Dim StringLocation As Long
 
    If string1 <> "" Then
        SaveString = string1
    End If
    
    StringLocation = strstr(SaveString, string2)
    
    If StringLocation > 0 Then
        strrtok = Left$(SaveString, StringLocation - 1)
        Do
            SaveString = Right$(SaveString, Len(SaveString) - StringLocation)
            StringLocation = strstr(SaveString, string2)
        Loop While StringLocation = 1
    End If
    If SaveString <> "" Then
        strrtok = SaveString
    Else
        strrtok = Null
    End If
End Function

'
'
'

Public Function strltok(ByVal string1 As String, _
                        ByVal string2 As String) _
                        As String
                        
    Static SaveString As String
    Dim StringLocation As Long

    If string1 <> "" Then
        SaveString = string1
    End If
    StringLocation = strstr(SaveString, string2)
    If StringLocation > 0 Then
        Do
            SaveString = Right$(SaveString, Len(SaveString) - StringLocation)
            StringLocation = strstr(SaveString, string2)
        Loop While StringLocation = 1
    ElseIf SaveString <> "" Then
        strltok = SaveString
    Else
        strltok = Null
    End If
    strltok = SaveString
End Function

'
'
'

Public Function strtok(ByVal string1 As String, _
                       ByVal string2 As String) _
                       As String
                       
    Static SaveString As String
    Dim StringLocation As Long

    If string1 <> "" Then
        SaveString = string1
        StringLocation = strstr(SaveString, string2)
        Do While StringLocation = 1
            SaveString = Right(SaveString, Len(SaveString) - StringLocation)
            StringLocation = strstr(SaveString, string2)
        Loop
    Else
        StringLocation = strstr(SaveString, string2)
    End If
    
    If StringLocation > 0 Then
        strtok = Left$(SaveString, StringLocation - 1)
        Do
            SaveString = Right(SaveString, Len(SaveString) - StringLocation)
            StringLocation = strstr(SaveString, string2)
        Loop While StringLocation = 1
    ElseIf SaveString <> "" Then
        strtok = SaveString
    Else
        strtok = Null
    End If
End Function

'
'   参数: 若string1="SAMPLE=1000",
'           string2=" =,:" & chr(9),
'           string2包含5个分隔符
'   返回:   string1中最靠左的分隔符(此处为=)的位置(此处为7)
'

Public Function strstr(ByVal string1 As String, _
                       ByVal string2 As String) _
                       As Long
                       
    Dim StringSize As Long
    Dim StringLocation As Long
    Dim CharLocation As Long

    StringLocation = Len(string1)
    For StringSize = 1 To Len(string2) Step 1
        CharLocation = InStr(1, string1, Mid$(string2, StringSize, 1), vbTextCompare)
        If CharLocation > 0 Then
            StringLocation = Minimize(StringLocation, CharLocation)
        End If
    Next StringSize
    If StringLocation = Len(string1) Then
        strstr = 0
    Else
        strstr = StringLocation
    End If
End Function

'
'   求二者中较小者
'

Private Function Minimize(ByVal Number1 As Variant, _
                          ByVal Number2 As Variant)
                          
    If Number1 >= Number2 Then
        Minimize = Number2
    Else
        Minimize = Number1
    End If
End Function