mdlpublic.bas

FLA-502控制、标定、分析用

Attribute VB_Name = "mdlPublic"
Option Explicit
'********************************
'请不要加全局变量
'********************************


'********************************
'- 其它Win Api
'********************************
Public Const HWND_TOP = 0
Public Const EWX_SHUTDOWN = 1
Public Const CB_SHOWDROPDOWN = &H14F
Public Const EM_LIMITTEXT = &HC5
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
'*******************************


'*******************************
'- 串口Win Api
'*******************************
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
Public Const PURGE_TXCLEAR = &H4     '  Kill the transmit queue if there.
Public Const PURGE_TXABORT = &H1     '  Kill the pending/current writes to the comm port.
Public Const PURGE_RXCLEAR = &H8     '  Kill the typeahead buffer if there.
Public Const PURGE_RXABORT = &H2     '  Kill the pending/current reads to the comm port.
Public Enum vb操作命令
    vb温度 = &H27&
    vb油温 = &H29&
    vb湿度 = &H30&
    vb压力 = &H31&
End Enum



Public Type OVERLAPPED
    INTERNAL As Long
    InternalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type
Public Type dcb
    DCBlength As Long
    BaudRate As Long
    fBitFields As Long 'See Comments in Win32API.Txt
    wReserved As Integer
    XonLim As Integer
    XoffLim As Integer
    ByteSize As Byte
    Parity As Byte
    StopBits As Byte
    XonChar As Byte
    XoffChar As Byte
    ErrorChar As Byte
    EofChar As Byte
    EvtChar As Byte
    wReserved1 As Integer 'Reserved; Do Not Use
End Type
Public Type COMMTIMEOUTS
    ReadIntervalTimeout As Long
    ReadTotalTimeoutMultiplier As Long
    ReadTotalTimeoutConstant As Long
    WriteTotalTimeoutMultiplier As Long
    WriteTotalTimeoutConstant As Long
End Type
Public Type COMSTAT
    fBitFields As Long 'See Comment in Win32API.Txt
    cbInQue As Long
    cbOutQue As Long
End Type
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
    lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, hTemplateFile As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    lpOverlapped As Any) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    lpOverlapped As Any) As Long
Public Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Public Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As dcb) As Long
Public Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As dcb) As Long
Public Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As dcb) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Public Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
'********************************




'********************************
'- 注册表Win Api
'********************************
' Reg Data Types...
Public Const REG_SZ = 1                        ' Unicode空终结字符串
Public Const REG_EXPAND_SZ = 2                 ' Unicode空终结字符串
Public Const REG_DWORD = 4                     ' 32-bit 数字
'注册表创建类型值...
Public Const REG_OPTION_NON_VOLATILE = 0       ' 当系统重新启动时，关键字被保留
'注册表关键字安全选项...
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Public Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Public Const KEY_EXECUTE = KEY_READ
Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
'注册表关键字根类型...
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
'返回值...
Public Const ERROR_NONE = 0
Public Const ERROR_BADKEY = 2
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_SUCCESS = 0
'********************************


'********************************
'时间Win Api
'********************************
Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type
Public liFrequency As LARGE_INTEGER
Public liNow As LARGE_INTEGER
Public liLast As LARGE_INTEGER
Public Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Public Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'*********************************


'*********************************
'串口操作枚举
'*********************************
Public Enum vb串口操作类型
    vb串口返回成功 = -2
    vb串口返回失败 = -1
    vb串口返回失败但已接收到字节 = -4
End Enum
'********************************


'********************************
'用户验证枚举
'********************************
Public Enum vb用户类型
    vb检测员 = 1
    vb管理员 = 2
    vb环保局 = 3
    vb供应商 = 4
    vb非法用户 = 5
End Enum
'********************************


'********************************
'电子环境测试仪(气象站)失败枚举
'********************************
Public Enum vb电子环境测试仪失败类型
    vb测试仪通讯失败 = 1
    vb温度传感器自检失败 = 2
    vb压力传感器自检失败 = 3
    vb湿度传感器自检失败 = 4
End Enum
'*******************************


'*******************************
'测功机自检结果枚举
'*******************************
Public Enum enum_Self_Detect             '自检的结果定义
    [Self_Detect_自检成功] = 1
    [Self_Detect_自检失败] = 2
    [Self_Detect_自检跳过] = 3
    [Self_Detect_系统退出] = 4
End Enum
Public Type tag_Self_Detect              '自检结果描述结构
    m_nResult As enum_Self_Detect
    m_szDescription As String
End Type
Public m_sSelf_Detect As tag_Self_Detect '自检结果标志
'********************************



'********************************
'数据库
'********************************
'(注:需要更新的LgDown数据)
'********************************
'更新附加损失扭矩和功率
'更新检测设备信息
'更新烟度计标定时间
'更新界面启动顺序
'********************************
Public g_szSQLConnStr As String
Public g_szLgDownSQLConnStr As String
Public HyConn As ADODB.Connection
Public HyLgDownConn As ADODB.Connection
'********************************



'********************************
'系统对象
'********************************
'Public hyAdoio As New clsADOIN823                       '板卡对象
'Public HyData As New clsSystemLog                       'Log对象
Public SystemData  As New clsSystemData                 '系统数据
Public Database As New clsDatabase                      '数据库
'Public SystemFail As New clsSystemFailure               '标定失败
'Public Control As New clsControl                        '控件
'Public Math As New clsMath                              '数学计算
'Public TimeObject As New clsTime                        '时间
Public TestDevice As New clsTestDevice                  '检测设备信息
'Public DeviceCheck As New clsDeviceCheck                '设备标定信息
'Public Station As New clsStation                        '检测站信息
'Public UserCheck As New clsUserCheck                    '用户检查
'Public TestVehile As New clsTestvehicle                 '测试车辆信息
Public SysPara As New clsSysPara    '环保局参数
'Public HYEmissionVFD As New clsEmissionVFD              '变频器
Public ComObject As New clsComObject                    '串口对象
Public Analyzer As New clsAnalyzer                '分析仪
'Public rpmEngineer As New clsRpmEngineer                '发动机转速计
'Public GasLimit As New clsGasLimit                      '排放类型
'********************************

Sub Main()
    Dim rs As ADODB.Recordset
    On Error GoTo Err_1
'    If App.PrevInstance = True Then
'        MsgBox "系统已经运行，请确认!如果已运行，请注销或重启计算机再运行此系统", vbInformation + vbOKOnly, "提示"
'        Exit Sub
'    End If
    'If OpenCenterDataBase() = False Or OpenLgDownDataBase() = False Then
    If OpenCenterDataBase() = False Then
        MsgBox "先设置好数据库连接，再重新运行此系统,如果还不能运行，请检查数据库服务器是否已启动", vbInformation + vbOKOnly, "提示"
        Load frmDataLogin
        frmDataLogin.Show vbModal
        Exit Sub
    Else
     '   frm数据系统验证.Show
        Set rs = HyConn.Execute("select * from A_系统启动顺序")
        If Not (rs.EOF = True And rs.BOF = True) Then
            rs.MoveFirst
            Select Case Val(rs!StartSequenceId)
            Case 41