mdlmain.bas

基于化工行业造气岗位的自动化监控系统

        .LinkExecute msg
        i = .LinkTimeout
        .LinkTimeout = 1
        .LinkMode = 0
        .LinkTimeout = i
    End With
    LinkAndSendMessage = 1
    Exit Function
HandleErr:
    Err.Clear
    frmMain.txtSend.LinkTimeout = 1
    frmMain.txtSend.LinkMode = 0
    frmMain.txtSend.LinkTimeout = i
    LinkAndSendMessage = 0
End Function
'函数名：ReadInIFiles
'参  数：String Mainkey     主键字符
'        String Subkey      子键字符
'        String DefaultKey  默认值
'        String FileName    文件路径
'返回值：String
'描  述：从信息配置文件中读数据
Public Function ReadInIFiles(Mainkey As String, Subkey As String, DefaultKey As String, FileName As String) As String
    Dim Success As Long
    Dim ReadBack As String
    Const Falseread = "信息文件不存在或被破坏!"
    ReadBack = String(150, 0)
    Success = GetPrivateProfileString(Mainkey, Subkey, DefaultKey, ReadBack, 150, FileName)
    ReadInIFiles = Left(ReadBack, Success)
    If Success = 0 Then
       MsgBox Falseread, vbCritical, ErrorTitle
       ReadInIFiles = DefaultKey
    End If
End Function

Public Function SynchroMsg(ByVal strmsg As String)
On Error Resume Next
    With frmMain.WskSynchro
        .RemoteHost = "192.168.0.255"
        .RemotePort = SynchroPort
        .SendData strmsg
    End With
End Function
Public Function stoveMsg(ByVal stoveIP As String, ByRef bytData() As Byte)
On Error Resume Next
    With frmMain.wskMCU
        .RemoteHost = stoveIP
        .RemotePort = 1234
        .SendData bytData
    End With
'    Debug.Print stoveIP & "--" & bytData(0) & " " & bytData(1) & " " & bytData(2) & " " & bytData(3) & " " & bytData(4) & " " & bytData(5) & " " & bytData(6) & " " & bytData(7) & " " & bytData(8) & " " & bytData(9) & " " & bytData(10) & " " & bytData(11) & " " & bytData(12)
End Function

Public Function BroadMsg(ByVal strmsg As String)
Dim i As Long
On Error Resume Next
    With frmMain.wskSend
        For i = 0 To UBound(CountIP)
            .RemoteHost = CountIP(i)
            .RemotePort = SendPort
            .SendData strmsg
        Next
    End With
End Function
Public Function RemoteMsg(ByVal strmsg As String)
On Error Resume Next
    With frmMain.wskRemote
        .RemoteHost = "192.168.0.255"
        .RemotePort = RemotePort
        .SendData strmsg
    End With
End Function

Public Sub dbAutoManage() '数据库维护
'    Dim myRecordset As Recordset
'    On Error GoTo eLog
'    Dim i%
'    For i = 0 To db.TableDefs.Count - 1
'        If db.TableDefs(i).RecordCount > 5000 Then '
'            Set myRecordset = db.OpenRecordset(db.TableDefs(i).Name)
'            While myRecordset.RecordCount > 5000
'                myRecordset.MoveFirst
'                myRecordset.Delete
'            Wend
'            myRecordset.MoveLast
'            myRecordset.Close
'            Set myRecordset = Nothing
'        End If
'    Next
    Exit Sub
eLog:
    Err.Clear
End Sub

Sub TimeDelay(DT As Long)
Dim T As Long
T = GetTickCount()
Do
   Sleep (10)
  DoEvents
Loop Until GetTickCount - T >= DT
End Sub

Public Function CheckRange(ByRef Value As Variant, ByVal Max As Variant, ByVal Min As Variant) As Variant
   On Error GoTo L
   If Value > Max Then
      Value = Max
   ElseIf Value < Min Then
      Value = Min
   End If
   CheckRange = Value
   Exit Function
L:
   Debug.Print Err.Description
   Err.Clear
End Function

Public Sub ParseStringToNumber(StringToParse As String, Single_Array() As Single, Optional Delimiter As String = "/")
    'StringToParse  要求分解的字符串
    'Single_Array() 分解后存放数据的数组
    'Delimiter      分隔符
    Dim L As Long
    Dim lngStartPos As Long
    Dim lngNextPos  As Long
    Dim strTemp     As String
    On Error Resume Next
    '初始化起始位置
    lngStartPos = 1
    Do
        '搜索指定的分隔符
        ReDim Preserve Single_Array(L)
        lngNextPos = InStr(lngStartPos, StringToParse, Delimiter)
        If lngNextPos = 0 Then
            ' For when we get to the end of the file
            strTemp = Val(Mid$(StringToParse, lngStartPos, Len(StringToParse) - lngNextPos + 1))
        Else
            strTemp = Val(Mid$(StringToParse, lngStartPos, lngNextPos - lngStartPos + 1))
        End If
        '对存放数据的变量赋值
        Single_Array(L) = Val(strTemp)
        
        lngStartPos = lngNextPos + 1
        L = L + 1
    Loop Until lngNextPos = 0
End Sub

Public Sub ParseStringToStr(StringToParse As String, ByRef Str_Array() As String, Optional Delimiter As String = "@")
    'StringToParse  要求分解的字符串
    'Str_Array()    分解后存放字符的数组
    'Delimiter      分隔符
    Dim L As Long
    Dim lngStartPos As Long
    Dim lngNextPos  As Long
    Dim strTemp     As String
    On Error Resume Next
    '初始化起始位置
    lngStartPos = 1
    Do
        ReDim Preserve Str_Array(L)
        lngNextPos = InStr(lngStartPos, StringToParse, Delimiter)
        If lngNextPos = 0 Then
            strTemp = Mid$(StringToParse, lngStartPos, Len(StringToParse) - lngNextPos + 1)
        Else
            strTemp = Mid$(StringToParse, lngStartPos, lngNextPos - lngStartPos)
        End If
        Str_Array(L) = strTemp
        lngStartPos = lngNextPos + 1
        L = L + 1
    Loop Until lngNextPos = 0
End Sub
'私有函数申明
'函数名：OpenSignalMap
'参  数：String FileName
'返回值：Long 0-打开失败  1-打开成功
'描  述：打开信号点配置文件并导出配置表中的数据保存到类型为采集点信号类型的数组变量
Private Function OpenSignalMap(ByVal FileName As String) As Long
    Dim FileHandle As Long
    Dim RecordNums As Long
    Dim i As Long
    On Error GoTo ErrHandle
    If FileName <> "" Then
        FileHandle = FreeFile
        Open FileName For Random As #FileHandle Len = Len(Signal(0))
        RecordNums = LOF(FileHandle) / Len(Signal(0))
        ReDim Preserve Signal(0 To RecordNums - 1)
        For i = 0 To RecordNums - 1 Step 1
            Get #FileHandle, i + 1, Signal(i)
            Signal(i).Name = Replace(Signal(i).Name, Chr(0), "")
            Signal(i).Unit = Replace(Signal(i).Unit, Chr(0), "")
'            Debug.Print Signal(i).Name & "=" & MotherBoard(Signal(i).Board).Port_Dip & "-" & Signal(i).Slot & "-" & Signal(i).Channel
            If Signal(i).Pid Then
                PID_Number = PID_Number + 1
                ReDim Preserve Pid(PID_Number - 1)
                Pid(PID_Number - 1).inID = i
                Pid(PID_Number - 1).outID = Signal(i).Pid_ID
                Pid(PID_Number - 1).Address = Format(MotherBoard(Signal(i).Board).Port_Dip, "00")
                If Signal(i).Slot = 0 Then
                    Pid(PID_Number - 1).Channel = Signal(i).Channel + 4
                Else
                    Pid(PID_Number - 1).Channel = Signal(i).Channel
                End If
            End If
        Next i
        Close #FileHandle
        If RecordNums = 0 Then
            OpenSignalMap = 0
        Else
            OpenSignalMap = 1
        End If
    Else
        OpenSignalMap = 0
    End If
    Exit Function
ErrHandle:
    Err.Clear
    OpenSignalMap = 0
End Function

Public Function OpenValveMap(ByVal FileName As String) As Long
'    Dim FileHandle As Long
'    Dim RecordNums As Long
'    Dim i As Long
'    On Error GoTo ErrHandle
'    If FileName <> "" Then
'        FileHandle = FreeFile
'        Open FileName For Random As #FileHandle Len = Len(DSignal(0))
'        RecordNums = LOF(FileHandle) / Len(DSignal(0))
'        ReDim Preserve DSignal(0 To RecordNums - 1)
'        For i = 0 To RecordNums - 1 Step 1
'            Get #FileHandle, i + 1, DSignal(i)
'            DSignal(i).Name = Replace(DSignal(i).Name, Chr(0), "")
''            Debug.Print i & "+" & DSignal(i).Name & "+" & DSignal(i).Address & "+" & DSignal(i).Channel & "+" & DSignal(i).Value
'        Next i
'        Close #FileHandle
'        If RecordNums = 0 Then
'            OpenValveMap = 0
'        Else
'            OpenValveMap = 1
'        End If
'    Else
'        OpenValveMap = 0
'    End If
'    Exit Function
'ErrHandle:
'    Err.Clear
'    OpenValveMap = 0
End Function

Private Function OpenMotherBoardMap(FileName As String) As Long
    Dim FileHandle As Long
    Dim RecordNums As Long
    Dim i As Long
    On Error GoTo ErrHandle
    If FileName <> "" Then
        FileHandle = FreeFile
        Open FileName For Random As #FileHandle Len = Len(MotherBoard(0))
        RecordNums = LOF(FileHandle) / Len(MotherBoard(0))
        ReDim Preserve MotherBoard(0 To RecordNums - 1)
        For i = 1 To RecordNums Step 1
            Get #FileHandle, i, MotherBoard(i - 1)
            MotherBoard(i - 1).Name = Replace(MotherBoard(i - 1).Name, Chr(0), "")
'            Debug.Print MotherBoard(i - 1).Name & "+" & MotherBoard(i - 1).Address & "+" & MotherBoard(i - 1).Slot(0).Name & "+" & MotherBoard(i - 1).Slot(1).Name
        Next i
        Close #FileHandle
        If RecordNums = 0 Then
            OpenMotherBoardMap = 0
        Else
            OpenMotherBoardMap = 1
        End If
    Else
        OpenMotherBoardMap = 0
    End If
    Exit Function
ErrHandle:
    Err.Clear
    OpenMotherBoardMap = 0
End Function
Public Function Dec2Bin(InputData As Long) As String
Dim BinOut As String
Dim i As Integer
Dim NewVal As Double
Dim BinTemp As String
Dim BinTemp1 As String
BinOut = ""
NewVal = InputData

DoAgain:
NewVal = (NewVal / 2)

If InStr(1, CStr(NewVal), ".") Then
  BinOut = BinOut + "1"
  NewVal = Format(NewVal, "#0")
  NewVal = (NewVal - 1)
  If NewVal < 1 Then
     GoTo DoneIt
  End If
Else
  BinOut = BinOut + "0"
   If NewVal < 1 Then
     GoTo DoneIt
   End If
End If
GoTo DoAgain
DoneIt:
BinTemp = ""
For i = Len(BinOut) To 1 Step -1
 BinTemp1 = Mid(BinOut, i, 1)
 BinTemp = BinTemp + BinTemp1
Next i

BinOut = BinTemp
Dec2Bin = BinOut
eds:
End Function
'函数名称：  calc
'函数：Calc
'用途：计算函数，计算表达式的值
'输入：以字符串形式输入表达式，其中表达式可带其他信号点并以"[索引]"表达某信号点的值
'输出：以字符串形式输出表达式计算结果
'例子：
's=Calc("0.02*[10]-[13]^3") 等价于　s=0.02*signal(10)-signal(13)*signal(13)*signal(13)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Calc(ByVal express As String) As String
  Dim i As Long, j As Long, k As Long
  Dim tmp As String, ss As String
  On Error GoTo ErrHandle
  tmp = express
  Do
    i = InStr(1, tmp, "[")
    If (i > 0) Then
      j = InStr(i, tmp, "]")
      If j = 0 Then
        GoTo ErrHandle
      End If
      ss = Mid$(tmp, i, j - i + 1)
      k = Val(Mid$(tmp, i + 1, j - i - 1))
      tmp = Replace$(tmp, ss, CStr(Signal(k).CalValue))
    End If
  Loop Until (i = 0)
  Calc = CalcExpress(tmp)
  Exit Function
ErrHandle:
  Calc = "err:" & Err.Description
  Err.Clear
End Function