mdlmain.bas

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

    Write_Conn.OPEN "PROVIDER=MSDASQL;driver={SQL Server};server=(local);uid=" & NewUid & ";pwd=;database=" & NewDataBase & ";"
    GoTo Continue
NewSQL:
    If SetCurrentDirectory(datPaths & "\DataBase") = 0 Then
       MkDir datPaths & "\Database"
    End If
       On Error GoTo OpenAccess
       If MsgBox("数据库已损坏，重建数据库吗？", vbQuestion + vbYesNo, ErrorTitle) = vbYes Then
            Dim fso As New FileSystemObject
            Set fso = CreateObject("Scripting.FileSystemObject")
            TimeDelay 100
            fso.CopyFile App.Path & "\mdb\" & NewDataBase & ".mdf", datPaths & "\DataBase\"
            SetAttr (datPaths & "\DataBase\" & NewDataBase & ".mdf"), vbNormal
            SetAttr (datPaths & "\DataBase\" & NewDataBase & ".mdf"), vbArchive
            fso.CopyFile App.Path & "\mdb\" & NewDataBase & ".ldf", datPaths & "\DataBase\"
            SetAttr (datPaths & "\DataBase\" & NewDataBase & ".ldf"), vbNormal
            SetAttr (datPaths & "\DataBase\" & NewDataBase & ".ldf"), vbArchive
            Tempstr = "sp_attach_db @dbname = N'" & NewDataBase & " ',@filename1 = N'" & datPaths & "\Database\" & NewDataBase & ".mdf',@filename2 = N'" & datPaths & "\Database\" & NewDataBase & ".ldf'"
            Conn.OPEN "driver={sql server};server=(local);database=master;persist security info=false; userid=" & NewUid & ";password=" & NewPwd
            Conn.Execute Tempstr
            TimeDelay 5000
            MsgBox "数据库加载成功，请重新加载程序或是注销系统！"
            End
       Else
            GoTo OpenAccess
       End If
    GoTo Continue
OpenAccess:
    IsAcess = True
    On Error GoTo errhandle
    Conn.CursorLocation = adUseClient
    Conn.OPEN "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DCS.mdb;"
        
'    Read_Conn.CursorLocation = adUseClient
'    Read_Conn.OPEN "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DCS.mdb;"
    Write_Conn.CursorLocation = adUseClient
    Write_Conn.OPEN "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DCS.mdb;"
Continue:
    On Error Resume Next
    Set Cmd.ActiveConnection = Conn
'    Set Read_Cmd.ActiveConnection = Read_Conn
    Set Write_Cmd.ActiveConnection = Write_Conn
    
    '读取机器名判断Server/Client，控制计算数据
    DCSName = ReadInIFiles("DCS", "Name", "化肥厂", iniPaths + "system.ini")
    DCSVersion = ReadInIFiles("DCS", "Version", "2.0.1", iniPaths + "system.ini")
    hostname = LCase(ReadInIFiles("Host", "Name", "Server", iniPaths + "system.ini"))
    UserID = ReadInIFiles("Host", "UserID", "1", iniPaths + "system.ini")
    Gather_Time = Int(Val(ReadInIFiles("ADAM5510", "Gathertime", "250", iniPaths + "system.ini")))
    StoveNumber = Val(ReadInIFiles("Window", "StoveNumber", "12", iniPaths + "system.ini"))
    WindowNumber = Val(ReadInIFiles("Window", "WindowNumber", "2", iniPaths + "system.ini"))
    IsTran = ReadInIFiles("TRAN", "ISTRAN", "false", iniPaths + "system.ini")
    QIGUIhight = Val(ReadInIFiles("Window", "QIGUIhight", "10", iniPaths + "system.ini"))
    Flux_Time = Val(ReadInIFiles("Flux", "TIME", "3600", iniPaths + "system.ini"))
    ReDim Preserve Number(1 To WindowNumber)
    For i = 1 To WindowNumber
        Number(i) = Val(ReadInIFiles("Window", "Number" & i, "6", iniPaths + "system.ini"))
    Next
    For i = 0 To StoveNumber - 1
        ReDim Preserve Stove(i)
        ReDim Preserve safety_Stop(i)
        With Stove(i)
             .ip = ReadInIFiles("Stove" & i + 1, "IP", "0", iniPaths + "Stove.ini")
             .preCF_Control = Val(ReadInIFiles("Stove" & i + 1, "CF", "0", iniPaths + "Stove.ini"))
             .preSC_Control = Val(ReadInIFiles("Stove" & i + 1, "SC", "0", iniPaths + "Stove.ini"))
             .preSXWD_Control = Val(ReadInIFiles("Stove" & i + 1, "SXWD", "0", iniPaths + "Stove.ini"))
             .preXXWD_Control = Val(ReadInIFiles("Stove" & i + 1, "XXWD", "0", iniPaths + "Stove.ini"))
             .preQueue_Control = Val(ReadInIFiles("Stove" & i + 1, "Queue", "0", iniPaths + "Stove.ini"))
             .preCycleTime = Val(ReadInIFiles("Stove" & i + 1, "CycleTime", "0", iniPaths + "Stove.ini"))
             .preSJN_Control = Val(ReadInIFiles("Stove" & i + 1, "SJN", "0", iniPaths + "Stove.ini"))
             .CycleLJ = Val(ReadInIFiles("Stove" & i + 1, "CycleLJ", "0", iniPaths + "Stove.ini"))
         End With
    Next
    frmSplash.Show
    If hostname = "server" Then
        IsServer = True
    Else
        IsServer = False
    End If
    
    UserDataNumber = Val(ReadInIFiles("Window", "UserDataNumber", "5", iniPaths + "Stove.ini"))
    
    If StoveNumber > UBound(Stove) + 1 Then
        ReDim Preserve Stove(StoveNumber)
    Else
        StoveNumber = UBound(Stove) + 1
    End If
    ReDim blnRHS(StoveNumber)
    ReDim Speed(StoveNumber)
    ReDim ParaEdit(StoveNumber)
    paraNumber = Val(ReadInIFiles("Parameter", "ParaNumber", "7", iniPaths + "system.ini"))  '工艺参数数量
    lngLEDRow = Val(ReadInIFiles("Window", "LEDROW", 1, iniPaths + "system.ini"))       '公共数据显示列数
    '生成历史数据保存文件夹并记录系统启动时间
    If SetCurrentDirectory(datPaths & "\history") = 0 Then  '建立子目录
        MkDir datPaths & "\history"
    End If
    If SetCurrentDirectory(datPaths & "\history\Alarm") = 0 Then
        MkDir datPaths & "\history\Alarm"
    End If
    If SetCurrentDirectory(datPaths & "\history\qlhistory") = 0 Then
       MkDir datPaths & "\history\qlhistory"
    End If
    For i = 1 To StoveNumber
         If i < 10 Then
             If SetCurrentDirectory(datPaths & "\history\qlhistory\00" & i) = 0 Then
                MkDir datPaths & "\history\qlhistory\00" & i
             End If
         Else
             If SetCurrentDirectory(datPaths & "\history\qlhistory\0" & i) = 0 Then
                MkDir datPaths & "\history\qlhistory\0" & i
             End If
         End If
     Next i
    If SetCurrentDirectory(datPaths & "\history\Hhistory") = 0 Then
       MkDir datPaths & "\history\Hhistory"
    End If
    If SetCurrentDirectory(datPaths & "\history\WDhistory") = 0 Then
       MkDir datPaths & "\history\WDhistory"
    End If
    If SetCurrentDirectory(datPaths & "\history\YLhistory") = 0 Then
       MkDir datPaths & "\history\YLhistory"
    End If
    If SetCurrentDirectory(datPaths & "\history\LLhistory") = 0 Then
       MkDir datPaths & "\history\LLhistory"
    End If
    If SetCurrentDirectory(datPaths & "\history\YWhistory") = 0 Then
       MkDir datPaths & "\history\YWhistory"
    End If
    If SetCurrentDirectory(App.Path & "\Logevent") = 0 Then
       MkDir App.Path & "\Logevent"
    End If
    If SetCurrentDirectory(App.Path & "\dat") = 0 Then
        MkDir App.Path & "\dat"
        Dim Fs As Object, A As Object
        Set Fs = CreateObject("Scripting.FileSystemObject")
        Set A = Fs.CreateTextFile(App.Path & "\dat\Start.txt", True) '记录系统何时启动
        A.WriteLine Date & Time & "       SYSTEM STARTING........"
        A.Close
        Set A = Nothing
        Set Fs = Nothing
    Else
        Open App.Path & "\dat\Start.txt" For Append As #1
        Print #1, Date & Time & "     SYSTEM STARTING........"       '记录系统何时启动
        Close #1
    End If
    Call INI_Curve
    
    j = Val(ReadInIFiles("Flux", "Number", "0", iniPaths + "system.ini"))
    ReDim Preserve Flux(0 To j - 1)
    For i = 0 To j - 1
        Flux(i) = Val(ReadInIFiles("Flux", CStr(i), "0", iniPaths + "system.ini"))
    Next
    '加载阀检信息
    ReDim Fj_Count(0 To StoveNumber - 1)
    Fj_StopNum = Val(ReadInIFiles("StopStove", "Num", "0", iniPaths & "coilrd.ini"))
    Fj_StopTime = Val(ReadInIFiles("StopStove", "Time", "0", iniPaths & "coilrd.ini"))
    If ReadInIFiles("FJLS", "FJcount", "False", iniPaths + "system.ini") = "True" Then
        Fj_str = ReadInIFiles("FJLS", "str", "00000000000000", iniPaths & "system.ini")
        Fj_CountAll = ReadInIFiles("FJLS", "CountAll", "1", iniPaths & "system.ini")
    End If
    '加载非线性算法公式
    ZQYLclac = Val(ReadInIFiles("Calc", "ZQYL", "0.125", iniPaths + "system.ini"))
    LTZSclac = Val(ReadInIFiles("Calc", "LTZS", "8", iniPaths + "system.ini"))
    SXYLclac = Val(ReadInIFiles("Calc", "SXYL", "1", iniPaths + "system.ini"))
    XXYLclac = Val(ReadInIFiles("Calc", "XXYL", "1", iniPaths + "system.ini"))
    i = Val(ReadInIFiles("Calc", "Num", "0", iniPaths & "system.ini"))
    ReDim CalcStr(1 To i)
    If i >= 1 Then
        For j = 1 To i
            CalcStr(j) = ReadInIFiles("Calc", CStr(j), "0", iniPaths & "system.ini")
        Next
    End If
BL:
    frmMain.Show
    Exit Sub
errhandle:
    Err.Clear
    End
End Sub

Public Function INI_Curve()
Dim i As Long, j As Long, k As Long, H As Long, dataNum As Long
'加载系统趋势属性信息
    With Curve_Dl
        .Name = Trim(ReadInIFiles("Curve", "Name", "趋势属性", iniPaths & "Stove.ini"))
        .CurveNum = Val(ReadInIFiles("Curve", "CurveNum", "1", iniPaths & "Stove.ini"))
        ReDim Preserve .Showhide(0 To StoveNumber - 1)
        ReDim Preserve .DataAxisMax(0 To StoveNumber - 1)
        ReDim Preserve .DataAxisMin(0 To StoveNumber - 1)
        For i = 0 To StoveNumber - 1
            .Showhide(i) = ReadInIFiles("Curve", "ShowHide" & i, "111111111111111111", iniPaths & "Stove.ini")
            .DataAxisMax(i) = Val(ReadInIFiles("Curve", "DataAxisMax" & i, "1", iniPaths & "Stove.ini"))
            .DataAxisMin(i) = Val(ReadInIFiles("Curve", "DataAxisMin" & i, "0", iniPaths & "Stove.ini"))
        Next
        For j = 0 To .CurveNum - 1
            .CurveName(j) = ReadInIFiles("Curve", "CurveName" & j, "属性", iniPaths & "Stove.ini")
            .Color(j) = Val(ReadInIFiles("Curve", "Color" & j, "&HFF&", iniPaths & "Stove.ini"))
            .Mag(j) = Val(ReadInIFiles("Curve", "Mag" & j, "1", iniPaths & "Stove.ini"))
            .CurveUnit(j) = ReadInIFiles("Curve", "Unit" & j, "Kpa", iniPaths & "Stove.ini")
            .HighScale(j) = Val(ReadInIFiles("Curve", "HighScale" & j, "1111", iniPaths & "Stove.ini"))
        Next
    End With
    i = Val(ReadInIFiles("Curve", "WindowNumber", "1", iniPaths & "H.ini"))
    ReDim Preserve Curve_H(i - 1)
    ReDim Preserve blnMoveH(i - 1)
    dataNum = 0
    For k = 0 To i - 1
        With Curve_H(k)
            ReDim Preserve .DataAxisMax(k)
            ReDim Preserve .DataAxisMin(k)
            ReDim Preserve .Showhide(k)
            .Name = ReadInIFiles("Curve", "Name", "趋势属性", iniPaths & "H.ini")
            .CurveNum = Val(ReadInIFiles("Curve", "Number" & k, "1", iniPaths & "H.ini"))
            .DataAxisMax(k) = Val(ReadInIFiles("Curve", "DataAxisMax" & k, "1", iniPaths & "H.ini"))
            .DataAxisMin(k) = Val(ReadInIFiles("Curve", "DataAxisMin" & k, "0", iniPaths & "H.ini"))
            .Showhide(k) = ReadInIFiles("Curve", "ShowHide" & k, "111111111111111111", iniPaths & "H.ini")
            For j = 0 To .CurveNum - 1
                .CurveData(j) = Val(ReadInIFiles("Curve", "CurveData" & j + dataNum, "1", iniPaths & "H.ini"))
                .Color(j) = Val(ReadInIFiles("Curve", "Color" & j, "255", iniPaths & "H.ini"))
                .Mag(j) = Val(ReadInIFiles("Curve", "Mag" & j + dataNum, "1", iniPaths & "H.ini"))
                If j = 0 Then
                    .CurveName(j) = "回收"
                    .CurveUnit(j) = "S"
                Else
                    H = InStr(1, Signal(.CurveData(j)).Name, " ", 1)
                    .CurveName(j) = Mid(Signal(.CurveData(j)).Name, 1, H)
                    H = InStr(1, Signal(.CurveData(j)).Unit, " ", 1)
                    .CurveUnit(j) = Mid(Signal(.CurveData(j)).Unit, 1, H)
                End If
            Next
            dataNum = dataNum + Curve_H(k).CurveNum
        End With
    Next
    i = Val(ReadInIFiles("Curve", "WindowNumber", "1", iniPaths & "Flow.ini"))
    ReDim Preserve Curve_Flux(i - 1)
    ReDim Preserve blnMoveFlux(i - 1)
    dataNum = 0
    For k = 0 To i - 1
        With Curve_Flux(k)
            ReDim Preserve .DataAxisMax(k)
            ReDim Preserve .DataAxisMin(k)
            ReDim Preserve .Showhide(i - 1)
            .Name = ReadInIFiles("Curve", "Name", "趋势属性", iniPaths & "Flow.ini")
            .CurveNum = Val(ReadInIFiles("Curve", "Number" & k, "1", iniPaths & "Flow.ini"))
            .DataAxisMax(k) = Val(ReadInIFiles("Curve", "DataAxisMax" & k, "1", iniPaths & "Flow.ini"))
            .DataAxisMin(k) = Val(ReadInIFiles("Curve", "DataAxisMin" & k, "0", iniPaths & "Flow.ini"))
            .Showhide(k) = ReadInIFiles("Curve", "ShowHide" & k, "111111111111111111", iniPaths & "Flow.ini")
            For j = 0 To .CurveNum - 1
                .CurveData(j) = Val(ReadInIFiles("Curve", "CurveData" & j + dataNum, "1", iniPaths & "Flow.ini"))
                .Color(j) = Val(ReadInIFiles("Curve", "Color" & j, "255", iniPaths & "Flow.ini"))
                .Mag(j) = Val(ReadInIFiles("Curve", "Mag" & j + dataNum, "1", iniPaths & "Flow.ini"))
                H = InStr(1, Signal(.CurveData(j)).Name, " ", 1)
                .CurveName(j) = Mid(Signal(.CurveData(j)).Name, 1, H)
                H = InStr(1, Signal(.CurveData(j)).Unit, " ", 1)
                .CurveUnit(j) = Mid(Signal(.CurveData(j)).Unit, 1, H)
            Next
            dataNum = dataNum + Curve_Flux(k).CurveNum
        End With
    Next
    i = Val(ReadInIFiles("Curve", "WindowNumber", "1", iniPaths & "Temper.ini"))
    ReDim Preserve Curve_Temper(i - 1)
    ReDim Preserve blnMoveTemper(i - 1)
    dataNum = 0
    For k = 0 To i - 1
        With Curve_Temper(k)
            ReDim Preserve .DataAxisMax(k)
            ReDim Preserve .DataAxisMin(k)
            ReDim Preserve .Showhide(k)
            .Name = ReadInIFiles("Curve", "Name", "趋势属性", iniPaths & "Temper.ini")
            .CurveNum = Val(ReadInIFiles("Curve", "Number" & k, "1", iniPaths & "Temper.ini"))
            .DataAxisMax(k) = Val(ReadInIFiles("Curve", "DataAxisMax" & k, "1", iniPaths & "Temper.ini"))
            .DataAxisMin(k) = Val(ReadInIFiles("Curve", "DataAxisMin" & k, "0", iniPaths & "Temper.ini"))
            .Showhide(k) = ReadInIFiles("Curve", "ShowHide" & k, "111111111111111111", iniPaths & "Temper.ini")
            For j = 0 To .CurveNum - 1
                .CurveData(j) = Val(ReadInIFiles("Curve", "CurveData" & j + dataNum, "1", iniPaths & "Temper.ini"))
                .Color(j) = Val(ReadInIFiles("Curve", "Color" & j, "&HFF&", iniPaths & "Temper.ini"))
                .Mag(j) = Val(ReadInIFiles("Curve", "Mag" & j + dataNum, "1", iniPaths & "Temper.ini"))
                H = InStr(1, Signal(.CurveData(j)).Name, " ", 1)
                .CurveName(j) = Mid(Signal(.CurveData(j)).Name, 1, H)
                H = InStr(1, Signal(.CurveData(j)).Unit, " ", 1)
                .CurveUnit(j) = Mid(Signal(.CurveData(j)).Unit, 1, H)
            Next
            dataNum = dataNum + Curve_Temper(k).CurveNum
        End With
        If k > 0 And SetCurrentDirectory(datPaths & "\history\WDhistory" & k) = 0 Then
            MkDir datPaths & "\history\WDhistory" & k
        End If
    Next
    i = Val(ReadInIFiles("Curve", "WindowNumber", "1", iniPaths & "Press.ini"))
    ReDim Preserve Curve_Press(i - 1)
    ReDim Preserve blnMovePress(i - 1)
    dataNum = 0
    For k = 0 To i - 1
        With Curve_Press(k)
            ReDim Preserve .DataAxisMax(k)
            ReDim Preserve .DataAxisMin(k)
            ReDim Preserve .Showhide(k)
            .Name = ReadInIFiles("Curve", "Name", "趋势属性", iniPaths & "Press.ini")
            .CurveNum = Val(ReadInIFiles("Curve", "Number" & k, "1", iniPaths & "Press.ini"))
            .DataAxisMax(k) = Val(ReadInIFiles("Curve", "DataAxisMax" & k, "1", iniPaths & "Press.ini"))
            .DataAxisMin(k) = Val(ReadInIFiles("Curve", "DataAxisMin" & k, "0", iniPaths & "Press.ini"))
            .Showhide(k) = ReadInIFiles("Curve", "ShowHide" & k, "111111111111111111", iniPaths & "Press.ini")
            For j = 0 To .CurveNum - 1
                .CurveData(j) = Val(ReadInIFiles("Curve", "CurveData" & j + dataNum, "1", iniPaths & "Press.ini"))
                .Color(j) = Val(ReadInIFiles("Curve", "Color" & j, "&HFF&", iniPaths & "Press.ini"))
                .Mag(j) = Val(ReadInIFiles("Curve", "Mag" & j + dataNum, "1", iniPaths & "Press.ini"))
                H = InStr(1, Signal(.CurveData(j)).Name, " ", 1)
                .CurveName(j) = Mid(Signal(.CurveData(j)).Name, 1, H)
                H = InStr(1, Signal(.CurveData(j)).Unit, " ", 1)
                .CurveUnit(j) = Mid(Signal(.CurveData(j)).Unit, 1, H)
            Next
            dataNum = dataNum + Curve_Press(k).CurveNum
        End With
        If k > 0 And SetCurrentDirectory(datPaths & "\history\YLhistory" & k) = 0 Then
            MkDir datPaths & "\history\YLhistory" & k
        End If
    Next
    i = Val(ReadInIFiles("Curve", "WindowNumber", "1", iniPaths & "Other.ini"))
    ReDim Preserve Curve_Other(i - 1)
    ReDim Preserve blnMoveOther(i - 1)
    dataNum = 0
    For k = 0 To i - 1
        With Curve_Other(k)
            ReDim Preserve .DataAxisMax(k)
            ReDim Preserve .DataAxisMin(k)
            ReDim Preserve .Showhide(k)
            .Name = ReadInIFiles("Curve", "Name", "趋势属性", iniPaths & "Other.ini")
            .CurveNum = Val(ReadInIFiles("Curve", "Number" & k, "1", iniPaths & "Other.ini"))
            .DataAxisMax(k) = Val(ReadInIFiles("Curve", "DataAxisMax" & k, "1", iniPaths & "Other.ini"))
            .DataAxisMin(k) = Val(ReadInIFiles("Curve", "DataAxisMin" & k, "0", iniPaths & "Other.ini"))
            .Showhide(k) = ReadInIFiles("Curve", "ShowHide" & k, "111111111111111111", iniPaths & "Other.ini")
            For j = 0 To .CurveNum - 1
                .CurveData(j) = Val(ReadInIFiles("Curve", "CurveData" & j + dataNum, "1", iniPaths & "Other.ini"))
                .Color(j) = Val(ReadInIFiles("Curve", "Color" & j, "&HFF&", iniPaths & "Other.ini"))
                .Mag(j) = Val(ReadInIFiles("Curve", "Mag" & j + dataNum, "1", iniPaths & "Other.ini"))
                H = InStr(1, Signal(.CurveData(j)).Name, " ", 1)
                .CurveName(j) = Mid(Signal(.CurveData(j)).Name, 1, H)
                H = InStr(1, Signal(.CurveData(j)).Unit, " ", 1)
                .CurveUnit(j) = Mid(Signal(.CurveData(j)).Unit, 1, H)
            Next
            dataNum = dataNum + Curve_Other(k).CurveNum
            End With
        If k > 0 And SetCurrentDirectory(datPaths & "\history\YWhistory" & k) = 0 Then
            MkDir datPaths & "\history\YWhistory" & k
        End If
    Next
End Function
Public Function FormatV(ByVal Value As Double) As String
    Dim i As Double
    i = Abs(Value)