mdlmain.bas

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

Attribute VB_Name = "mdlMain"
'*************湖南仪峰公司新模块化DCS组件*************************
    '作者：      彭逢望
    '编写日期：  2004-6-15
    '修改日期：  2004-8-7
    '修改人：    彭逢望
'*****************************************************************
Option Explicit '常数声明
Public Const ErrorTitle = "湖南仪峰优化控制技术有限公司"
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function WSAGetLastError Lib "wsock32.DLL" () As Long
Private Declare Function WSAStartup Lib "wsock32.DLL" (ByVal wVersionRequired&, lpWSAData As WSAData) As Long
Private Declare Function WSACleanup Lib "wsock32.DLL" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function gethostbyname Lib "wsock32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)
Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
Private Type HOSTENT
   hName As Long
   hAliases As Long
   hAddrType As Integer
   hLength As Integer
   hAddrList As Long
End Type
Private Type WSAData
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To WSADescription_Len) As Byte
   szSystemStatus(0 To WSASYS_Status_Len) As Byte
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpszVendorInfo As Long
End Type

'用户信息(班信息)
Type UserInfo
    ID As Long
    Name As String * 16
    Monitor As String * 8
    priOperator As String * 8
    subOperator As String * 8
    password As String * 16
    Popedom As Long
End Type
'单炉信息
Type StoveInfo
    RunState As Long           '1运行状态 （2：无设备；0：停炉；1：运行）
    Counter As Long             '2时间
    CurrentStep As Long         '3步序
    Cycle As Long               '4循环数
    CycleLJ As Long
    RHS As Boolean              '热回收状态
    HS_Control As Long          '5回收
    GL_Control As Long          '6给料
    CF_Control As Long          '7吹风时间控制
    SC_Control As Long          '8上吹时间控制
    XC_Control As Long
    SXWD_Control As Long        '9上行温度控制
    XXWD_Control As Long        '10下行温度控制
    Queue_Control As Long       '11吹风排队
    SJN_Control As Long          '12加氮
    XJN_Control As Long
    CycleTime As Long           '13循环时间
    preCF_Control As Long       '上次吹风时间控制
    preSC_Control As Long       '上次上吹时间控制
    preSXWD_Control As Long     '上次上行温度控制
    preXXWD_Control As Long     '上次下行温度控制
    preQueue_Control As Long    '上次吹风排队
    preSJN_Control As Long      '上次上加氮
    preXJN_Control As Long
    preCycleTime As Long        '上次循环时间
    SXWD As Long                '14上行温度采样值
    XXWD As Long                '15下行温度采样值
    ZHWD As Long                '16左灰温度采样值
    YHWD As Long                '17右灰温度采样值
    JTWD As Long                '18夹套温度采样值
    ZQYL As Single              '19整齐压力采样值
    Speed As Long               '19整齐转速采样值
    LTWD As Long
    SXYL As Single
    XXYL As Single
    ip As String * 20           'IP地址
End Type

'采集点信息
Public Type SignalInfo
    Tag  As String * 16         '标签（仪表位号）
    Name As String * 20         '实际描述
    Unit As String * 8          '工程单位
    Type As Long                '信号类型

    LowValue  As Single         '信号上限
    HighValue As Single         '信号上限
     
    Value     As Single         '采样值
    CalValue As Single         '计算值
    
    LowScale  As Single         '量程下值
    HighScale As Single         '量程上值

    LowAlarm  As Single         '报警下值
    HighAlarm As Single         '报警上值
    Alarm     As Boolean        '是否报警

    Pid     As Boolean          '是否PID
    Pid_ID  As Long             '输出点索引

    Linear  As Long             '线性关系
    Remote  As Boolean          '是否远程监控
    
    Board   As Long             '母板索引号
    Slot    As Long             '槽号
    Channel As Long             '模块通道号
    
    UpdateFlag As Boolean       '采样更新标志
    Edited  As Boolean          '是否已经配置信息
End Type
Public Type ChannelType
     Name As String * 3         '对应点通道名
     Index As Long              '对应索引点
     Key As Long
     Edited As Boolean           '是否已经配置信息
End Type

Public Type SlotType
     Channel(7) As ChannelType
     Name As String * 8         '子槽名称
     Slot_Num As Long           '槽号索引
     Key As Long
End Type

Public Type Board
     Address As String * 16     '设备地址
     Port_Dip  As Long          '设备分配号（如5510 DIP 号）
     Slot(7) As SlotType
     Name As String * 12       '母槽名称
     Rtrn As Long              '整个槽采集命令返回长度
     Cmd As String * 5         '整个槽采集命令
     Key As Long
End Type
'PID调节点类型
Public Type PID_Information
    Name As String * 20     '调节点名称
    inID As Long            '对应输入信号的索引
    outID As Long           '对应输出信号的索引
    Address As String * 2  '地址
    Channel As Long         '通道
    KP As Single            '比例系数
    KI As Single            '积分系数
    KD As Single            '微分系数
    AM As Boolean           '手自动调节'Ture为自动
    AV As Single            '自动给定
    MV As Single            '手动给定
    PN As Boolean           '正反调节
    OPEN As Boolean
    BV As Single            '反馈值
    Place As Long           '显示位置
End Type
Public Type CurveProperty   '趋势曲线初始化定义
  Name As String * 12
  CurveNum As Long
  CurveName(0 To 17) As String * 15
  Color(0 To 17) As Long
  Showhide() As String * 18
  DataAxisMin() As Single
  DataAxisMax() As Single
  CurveData(0 To 17) As Long
  CurveUnit(0 To 17) As String * 5
  HighScale(0 To 17) As Single
  Mag(0 To 17) As Long
End Type

'×××××变量申明×××××'
Public Pid() As PID_Information        'PID调节
Public PID_index As Long               'PID调节信号的Index
Public strPIDCommand As String         'PID调节命令
Public strPIDSYNC As String            'PID同步参数
Public PID_Number As Long
'采集点信息
Public Type Valveinfor
    Name As String * 30
    Address As Long
    Channel As Long
    Value As Long
End Type
Public DSignal() As Valveinfor
'Public Valve As New Valve
Public RW_Tran As New RW_Tran
'趋势曲线初始化定义

Public Curve_Dl As CurveProperty    '单炉曲线数据条定义
Public Curve_H() As CurveProperty    '系统曲线数据条定义(氢，流量，温度，压力，其它)
Public Curve_Flux() As CurveProperty
Public Curve_Temper() As CurveProperty
Public Curve_Press() As CurveProperty
Public Curve_Other() As CurveProperty
'-----------------------------------变频器变量申明
'Public FRN_FRQ(15) As Integer 'FRENIC FREQUENCY,调用本程序时，请把本变量设定为全局变量，作为炉条机转速传递参数
'Public FRN_STOP As Integer
'Public Cmand$, SOH$, ENQ$, ETX$, SP$
'Public strSpeed As String      '发送到变频器的数据
'数据库类
'A类 采用ODBC连接数据库
Public Conn As New ADODB.Connection    '''''''全部改为局部变量
Public Cmd As New ADODB.Command
'Public rs As New ADODB.Recordset
'
'Public Read_Conn As New ADODB.Connection
'Public Read_Cmd As New ADODB.Command
'Public Read_rs As New ADODB.Recordset
'
Public Write_Conn As New ADODB.Connection
Public Write_Cmd As New ADODB.Command
'Public Write_rs As New ADODB.Recordset
Public IsAcess As Boolean

'文件、计算机名类
Public iniPaths As String            '信息文件保存路径
Public datPaths As String            '数据文件
Public HostCount As Boolean
Public nWinsocks As Long
Public nClientWinsocks As Long
Public ConnectState As Boolean
Public RemoteConnectState As Boolean
'Public SWgivedown As Boolean             '有无给料调节
Public SWstopstove As Boolean          '有无停炉开关
Public SWxiahui As Boolean             '有无下灰开关
Public SWshihuo As Boolean             '有无试火开关
Public SWstarstove As Boolean          '有无开炉开关
Public SWback As Boolean
Public SendPort As Long
'Public SystemIndex As Long
Public DCSName As String
Public DCSVersion As String
Public FTP_Run As Boolean
'用户信息类
Public Users() As UserInfo          '用户信息
Public UserID As Long               '当前用户ID
Public blnFirstLogin As Boolean     '是否
Public lngPopedom As Long
Public strPassword(3) As String
Public ParaEdit() As Boolean

'寻优微机类
Public StoveStart As Long
Public StoveNumber As Long          '炉群数量
Public WindowNumber As Long         '画面数量
Public Number() As Long              'A画面炉数
Public Stove() As StoveInfo         '单炉信息
Public blnLock As Boolean           '参数锁定标记
Public Stove_Index As Long
Public safety_Stop() As Boolean

Public paraNumber As Long
Public UserDataNumber As Long
Public blnGive As Boolean
Public blnMoveDl() As Boolean
Public blnMoveH() As Boolean
Public blnMoveFlux() As Boolean
Public blnMoveTemper() As Boolean
Public blnMovePress() As Boolean
Public blnMoveOther() As Boolean
Public blnRHS() As Boolean
Public Speed() As Long
Public Fj_Run As Boolean
Public Fj_str As String
Public Fj_Count() As Long
Public Fj_CountAll As Long
Public Fj_StopNum As Long
Public Fj_StopTime As Long
'采集信号类
Public Gather_Time As Long
Public DDEEnabled As Boolean
Public DDEdataIn() As Label                     'DDE输入数据
Public DDEdataOut() As Label                    'DDE输出数据
Public DDEConnectFlag As Boolean                'DDE连接标志
Public Flux_Time As Single
Public connectCount() As Long
Public ModuleOpen As Boolean
Public ModuleConnectState() As Boolean
Public MotherBoard() As Board
Public Signal() As SignalInfo       '采集点信息
Public CalcStr() As String          '非线性算法公式
Public LED_ID As Long
Public Warning_ID As Long
Public lngLEDRow As Long
Public RecNumber As Long
Public ControlLink As Control
Public IsServer As Boolean
Public isRead As Boolean
Public IsTran As Boolean
Public Flux() As Single            '蒸汽流量累计值
Public QIGUIhight As Long
Public ZQYLclac As Single
Public LTZSclac As Single
Public SXYLclac As Single
Public XXYLclac As Single

'入口函数
 Sub Main()
    Dim i As Long, j As Long, k As Long, H As Long
    Dim hostname As String           '主机名称
'    On Error Resume Next
    iniPaths = App.Path + "\ini\"
    '打开采集点配置信息文件
    ReDim Preserve MotherBoard(0)
    i = OpenMotherBoardMap(App.Path + "\MDB\Moudle.map")
    If i = 0 Then
        i = OpenMotherBoardMap(App.Path + "\bak\Moudle.map")
    End If
    If i = 0 Then MsgBox "信息文件破坏，无法打开!", vbOKOnly, ErrorTitle: End
    ReDim ModuleConnectState(UBound(MotherBoard))
    ReDim connectCount(UBound(MotherBoard))
    ReDim Signal(0)
    i = OpenSignalMap(App.Path + "\MDB\Point.map")
    If i = 0 Then
        i = OpenSignalMap(App.Path + "\bak\Point.map")
    End If
    If i = 0 Then MsgBox "信息文件破坏，无法打开!", vbOKOnly, ErrorTitle: End
    ReDim DSignal(0)
    i = OpenValveMap(App.Path + "\MDB\Valve.map")
    If i = 0 Then
        i = OpenValveMap(App.Path + "\bak\Valve.map")
    End If
    If i = 0 Then MsgBox "信息文件破坏，无法打开!", vbOKOnly, ErrorTitle: End
    '创建数据库目录
    If SetCurrentDirectory("D:\Program Files") = 0 Then
        MkDir "D:\Program Files"
    End If
    datPaths = "D:\Program Files"
    IsAcess = False
    Dim NewDataBase As String, NewUid As String, NewPwd As String, Tempstr As String
    NewDataBase = ReadInIFiles("DB", "Database", "Factory", iniPaths + "system.ini")
    NewUid = ReadInIFiles("DB", "User", "sa", iniPaths + "system.ini")
    On Error GoTo NewSQL
    Conn.OPEN "PROVIDER=MSDASQL;driver={SQL Server};server=(local);uid=" & NewUid & ";pwd=;database=" & NewDataBase & ";"
'    Read_Conn.OPEN "PROVIDER=MSDASQL;driver={SQL Server};server=(local);uid=" & NewUid & ";pwd=;database=" & NewDataBase & ";"