mdlpublic.bas

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

'''        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
''                frm五气分析仪标定.Show vbModal
''            Case 42
'                frm五气分析仪浓度监视.Show vbModal
''            Case 51
''                frm五气分析仪标定结果.Show vbModal
''            End Select
''        End If
''    End If
'    Exit Sub
'Err_1:
'    Call ShowErrorMsg(Err)
'    End
'End Sub

'************
'数据库操作
'************
Public Sub GetDataConnectionString()
    g_szSQLConnStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=GBVmas;Data Source=dds"

    'g_szSQLConnStr = "Provider=SQLOLEDB.1;Password=chinahy;Persist Security Info=True;User ID=sa;Initial Catalog=GBVmas;Data Source=HBJ-Y5YLMPWKX5B\SQLSERVER1"
    Dim m_clsDataConn As New clsDataConn
On Error GoTo Err_1
    If g_szSQLConnStr = "" Then
        g_szSQLConnStr = m_clsDataConn.GetConnectionString()
        If (Trim(g_szSQLConnStr) = "") Then
            Exit Sub
        End If
    End If
    Exit Sub
Err_1:
   Call ShowErrorMsg(Err)
End Sub

Public Sub GetLgDownDataConnectionString()
    'g_szLgDownSQLConnStr = "Provider=SQLOLEDB.1;Password=chinahy;Persist Security Info=True;User ID=sa;Initial Catalog=GBVmas;Data Source=HBJ-Y5YLMPWKX5B\SQLSERVER1"
    Dim m_clsDataConn As New clsDataConn
On Error GoTo Err_1
    If g_szLgDownSQLConnStr = "" Then
        g_szLgDownSQLConnStr = m_clsDataConn.GetLgDownConnectionString()
        If (Trim(g_szLgDownSQLConnStr) = "") Then
            Exit Sub
        End If
    End If
    Exit Sub
Err_1:
   Call ShowErrorMsg(Err)
End Sub

Public Function OpenCenterDataBase() As Boolean
 On Error GoTo Err_1
    Call GetDataConnectionString
    g_szSQLConnStr = Trim(g_szSQLConnStr)
    If Trim(g_szSQLConnStr) = "" Then
        OpenCenterDataBase = False
        Exit Function
    End If
    If Not (HyConn Is Nothing) Then
        If HyConn.State = adStateOpen Then
            OpenCenterDataBase = True
            Exit Function
        End If
        Set HyConn = Nothing
    End If
    Set HyConn = New ADODB.Connection
    Call HyConn.Open(g_szSQLConnStr)
    If HyConn.State <> adStateOpen Then
       MsgBox ("数据库不能连接打开")
       OpenCenterDataBase = False
       Exit Function
    Else
        Dim strSqlTest As String
        Dim rsTest As ADODB.Recordset
        Set rsTest = HyConn.Execute("select * from hyLimit")
        OpenCenterDataBase = True
        Exit Function
    End If
    OpenCenterDataBase = True
    Exit Function
Err_1:
    Call ShowErrorMsg(Err)
    OpenCenterDataBase = False
End Function

Public Function OpenLgDownDataBase() As Boolean
 On Error GoTo Err_1
    Call GetLgDownDataConnectionString
    g_szLgDownSQLConnStr = Trim(g_szLgDownSQLConnStr)
    If Trim(g_szLgDownSQLConnStr) = "" Then
        OpenLgDownDataBase = False
        Exit Function
    End If
    Set HyLgDownConn = New ADODB.Connection
    Call HyLgDownConn.Open(g_szLgDownSQLConnStr)
    If HyLgDownConn.State <> adStateOpen Then
       MsgBox ("数据库不能连接打开")
       OpenLgDownDataBase = False
       Exit Function
    Else
        OpenLgDownDataBase = True
        Exit Function
    End If
    OpenLgDownDataBase = True
    Exit Function
Err_1:
    Call ShowErrorMsg(Err)
    OpenLgDownDataBase = False
End Function

'更新LgDown数据库
Public Sub UpdateLgDownStartSequence(nStartId As Integer)
    HyLgDownConn.Execute ("delete 系统启动顺序")
    HyLgDownConn.Execute ("insert into 系统启动顺序 (StartSequenceId) Values(" & nStartId & ")")
End Sub

Public Sub 刷新设备对应的串口数据()
    Analyzer.AnalyzerHandle = Val(cls注册表.GetKeyValue(HKEY_CURRENT_USER, "DS", "AnalyzerHandle"))
    Analyzer.AnalyzerPort = cls注册表.GetKeyValue(HKEY_CURRENT_USER, "DS", "AnalyzerPort")
End Sub

Public Sub 刷新hyLimit数据()
    Dim rsTemp As ADODB.Recordset
    Set rsTemp = Database.取数据("select  TestType  from  HyLimit")
    If Not rsTemp.EOF Then
        rsTemp.MoveFirst
        If IsNull(rsTemp!testtype) = False Then
            If rsTemp!testtype = "1" Then
                SystemData.SetDeviceTestType (True)
            Else
                SystemData.SetDeviceTestType (False)
            End If
        Else
            SystemData.SetDeviceTestType (False)
        End If
    End If
    rsTemp.Close
    Set rsTemp = Nothing
End Sub

Public Sub 删除日常运行日志数据()
    If SystemData.getRunMode <> 0 Then
        Exit Sub
    End If
    Database.更新数据库 ("delete from 日常运行日志  where 内部唯一性检测序列号='" & SystemData.内部唯一性检测序列号 & "'")
End Sub

Public Sub ExeEasm()
   Shell (App.Path + "\Easm.exe")
End Sub

Public Function getFieldValue(varField As Variant) As String
    If IsNull(varField) = False Then
        getFieldValue = CStr(varField)
    Else
        getFieldValue = ""
    End If
End Function

Public Sub CloseCenterDataBase()
  'HyConn.Close
  Set HyConn = Nothing
End Sub

'**************************
'杂项
'**************************
Public Sub ShowErrorMsg(ByVal obj As ErrObject)
    If (obj Is Err) Then
        If Err.Number <> 0 Then
            MsgBox "Err Number:" + CStr(Err.Number) + vbCrLf + "Err Descritpion:" + Err.Description, vbInformation + vbOKOnly, "Error Prompt:"
        Else
            MsgBox "程序发生未知错误，请与软件开发商联系!", vbInformation + vbOKOnly, "提示“"
        End If
    End If
End Sub

Public Function checkValid(ValueTxt As String, LowValue As Single, HighValue As Single) As Boolean
    If IsNumeric(ValueTxt) = False Then
        checkValid = False
        Exit Function
    End If
    If Val(ValueTxt) < LowValue Or Val(ValueTxt) > HighValue Then
        checkValid = False
    End If
    checkValid = True
End Function

Public Sub 关闭Vmas()
    '关闭分析仪
    If SystemData.isDeviceTestType = True Then
    
    End If
End Sub

Public Sub 退出系统(Optional b已经初始化板卡 As Boolean = False)
    '关闭分析仪
    If (HYEmissionVFD Is Nothing) = False Then
        HYEmissionVFD.CloseVFDLastHandle (HYEmissionVFD.VFDHandle)
    End If
'    If b已经初始化板卡 = False Then
'        If SystemData.isDeviceTestType = True And (hyAdoio Is Nothing) = False Then
'            Call hyAdoio.EndMotorProcess
'            Call hyAdoio.CloseADIO
'            Call hyAdoio.CloseVmasSwitch
'            Call hyAdoio.Close_Board
'        End If
'    End If
    
    '记录退出系统时间
    Database.更新数据库 ("update turnslog set downdate= getdate(), who='" & UserCheck.当前进入系统用户 & "'where SessionId=" & SystemData.使用系统次数 & " ")
    Database.更新数据库 ("update EISuser set isRunningUser='N' ")
    Call CloseCenterDataBase
    Set hyAdoio = Nothing
    Set HYEmissionVFD = Nothing
    Set SystemData = Nothing
    Set Database = Nothing
    Set SystemFail = Nothing
    Call KillConnFile
    Call KillLgDownConnStrFile
    End
End Sub

Public Sub KillConnFile()
    On Error GoTo ErrHandle
    Kill App.Path + "\conn.ini"
    Exit Sub
ErrHandle:
End Sub

Public Sub KillLgDownConnStrFile()
    On Error GoTo ErrHandle
    Kill App.Path + "\sqlserverLgDown.ini"
    Exit Sub
ErrHandle:
End Sub

Public Function correctString(str As String) As String
   correctString = Trim(Replace(str, "'", "''"))
End Function

'1S
Public Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
    LargeIntToCurrency = LargeIntToCurrency * 10000
End Function

'0.1S
Public Function LargeIntToCurrency01(liInput As LARGE_INTEGER) As Currency
    CopyMemory LargeIntToCurrency01, liInput, LenB(liInput)
    LargeIntToCurrency01 = LargeIntToCurrency01 * 1000
End Function

'0.01S
Public Function LargeIntToCurrency001(liInput As LARGE_INTEGER) As Currency
    CopyMemory LargeIntToCurrency001, liInput, LenB(liInput)
    LargeIntToCurrency001 = LargeIntToCurrency001 * 100
End Function