modstartbase.bas

ERP管理系统源代码erp 管理系统源代码

    
    CheckString = False
End Function

'**********************************************
'   CheckInt              检查整数
' 检查条件： Min <= TextBox的数值 <= Max
' VB 的  Long 和 SQL 的 INT 类型的取值范围为[-2147483648,2147483647]
Public Function CheckInt( _
    Optional nInt = "", _
    Optional Min = -2147483648#, _
    Optional Max = 2147483647 _
) As Boolean
    On Error GoTo ERROR_EXIT
    If Not IsNumeric(nInt) Or Not IsNumeric(Max) Or Not IsNumeric(Min) Then
        GoTo ERROR_EXIT
    End If
    
    If CLng(nInt) > CSng(Max) Or CLng(nInt) < CSng(Min) Then
        GoTo ERROR_EXIT
    End If
    
    CheckInt = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modStartup"
    m_tagErrInfo.strErrFunc = "CheckInt"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    CheckInt = False
End Function

'-----------------------------------------------------------
'   CheckLng              检查整数
' 检查条件： Min <= TextBox的数值 <= Max
' VB 的  Long 和 SQL 的 INT 类型的取值范围为[-2147483648,2147483647]
'-----------------------------------------------------------
Public Function CheckLng(Optional nInt = "", _
    Optional Min = -2147483648#, Optional Max = 2147483647) As Boolean
    On Error GoTo ERROR_EXIT
    If Not IsNumeric(nInt) Or Not IsNumeric(Max) Or Not IsNumeric(Min) Then
        GoTo ERROR_EXIT
    End If
    
    If CLng(nInt) > CSng(Max) Or CLng(nInt) < CSng(Min) Then
        GoTo ERROR_EXIT
    End If
    
    CheckLng = True
    Exit Function
ERROR_EXIT:
    CheckLng = False
End Function

'********************************************
' CheckSng              检查单精度数值
' VB 的  Single 和 SQL 的 DECIMAL 类型的取值范围为[-3.402823E+38,3.402823E+38]
Public Function CheckSng( _
    Optional sValue = "", _
    Optional Min = -3.402823E+38, _
    Optional Max = 3.402823E+38 _
    ) As Boolean
    On Error GoTo ERROR_EXIT
    If Not IsNumeric(sValue) Or Not IsNumeric(Max) Or Not IsNumeric(Min) Then
        GoTo ERROR_EXIT
    End If
    
    If CSng(sValue) > CSng(Max) Or CSng(sValue) < CSng(Min) Then
        GoTo ERROR_EXIT
    End If
    
    CheckSng = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modStartup"
    m_tagErrInfo.strErrFunc = "CheckSng"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    CheckSng = False
End Function

'   获得登陆用户名
Public Function GetUserName() As String
    On Error Resume Next
    GetUserName = m_strUserName
End Function

'************************************************
' 获得员工的中、英文名
' PARAMETERS :
'   [IN]    ByVal strEmploteeID     As String      --  员工 id
'   [OUT]   ByRef strNameC          As String      --  员工的中文名
'   [OUT]   ByRef strNameE          As String      --  员工的英文名
'   [RET]   GetEmployeeName         As Boolean     --  操作成功与否
Public Function GetEmployeeName _
(ByVal strEmploteeID As String, ByRef strNameC As String, Optional ByRef strNameE As String) As Boolean
    On Error GoTo ERROR_EXIT
    Dim objEmployee As yxerpcom.CEmployee
    
    Set objEmployee = New yxerpcom.CEmployee
    Set objEmployee.IBaseClass_ActiveConnection = dbMyDB
    objEmployee.IBaseClass_Query "SELECT * FROM Employee WHERE ep_code = '" & strEmploteeID & "''"
    strNameC = objEmployee.FullName
    
    If Not objEmployee Is Nothing Then Set objEmployee = Nothing
    GetEmployeeName = True
    Exit Function

ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modStartup"
    m_tagErrInfo.strErrFunc = "GetEmployeeName"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "获得员工的中、英文名失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    If Not objEmployee Is Nothing Then Set objEmployee = Nothing
    strNameC = ""
    strNameE = ""
    GetEmployeeName = False
End Function

Public Sub dbDataConnectSet(UserName As String, UserPass As String, _
                    UserDBName As String, UserDBSource As String)
    g_MyUserDB.strUserName = UserName
    g_MyUserDB.strUserPassword = UserPass
    g_MyUserDB.strUserDatabase = UserDBName
    g_MyUserDB.strUserDatasource = UserDBSource
End Sub

Public Function OpenDB() As Boolean
    On Error GoTo ERROR_EXIT
    
    bolDBStatus = True

    Set dbMyDB = New ADODB.Connection
    dbMyDB.ConnectionString = _
        "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + g_MyUserDB.strUserName + _
        ";Password=" + g_MyUserDB.strUserPassword + ";Initial Catalog=" + g_MyUserDB.strUserDatabase + _
        ";Data Source=" + g_MyUserDB.strUserDatasource
    dbMyDB.Open
    
    Set dbShapeDB = New ADODB.Connection
    dbShapeDB.ConnectionString = "Provider=MSDataShape;" & _
        "Data Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + g_MyUserDB.strUserName + _
        ";Password=" + g_MyUserDB.strUserPassword + ";Initial Catalog=" + g_MyUserDB.strUserDatabase + _
        ";Data Source=" + g_MyUserDB.strUserDatasource
    dbShapeDB.Open
    
    OpenDB = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modStartup"
    m_tagErrInfo.strErrFunc = "OpenDB"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "数据库主程序打开失败!"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    Close
    MsgBox "数据库主程序打开失败!"
    OpenDB = False
End Function

Public Function CloseDB() As Boolean
    On Error GoTo ERROR_EXIT
    
    dbMyDB.Close
    Set dbMyDB = Nothing
    dbShapeDB.Close
    Set dbShapeDB = Nothing
    
    bolDBStatus = False
    CloseDB = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modStartup"
    m_tagErrInfo.strErrFunc = "CloseDB"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "数据库主程序关闭失败!"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    Close
    MsgBox "数据库主程序关闭失败，数据可能丢失!"
    CloseDB = False
    
End Function

'***********************************************************************************************************
' 获得本地机器名
' Added by Jack Xu 2001.11.2
Public Function GetCurComputerName() As String
    On Error GoTo ERROR_EXIT
    Dim fOK As Boolean
    Dim strName As String
    Dim nSize As Long
    
    fOK = False
    If m_strComputerName = "" Then
        nSize = 255
        strName = Space(nSize)
        fOK = GetComputerName(strName, nSize)
        If Not fOK Then GoTo ERROR_EXIT
        strName = RemoveNullChar(Trim(strName))
        m_strComputerName = strName
    Else
        fOK = True
    End If
    
    If fOK Then
        GetCurComputerName = Trim(m_strComputerName)
        Exit Function
    End If
    
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modStartup"
    m_tagErrInfo.strErrFunc = "GetCurComputerName"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    GetCurComputerName = ""
End Function

'**********************************
' 去掉字符中的空字符及以后的字符
Public Function RemoveNullChar(ByVal str As String) As String
    Dim i As Integer
    Dim strTemp As String
    
    strTemp = str
    i = InStr(strTemp, vbNullChar)
    If i > 0 Then strTemp = Left(strTemp, i - 1)
    RemoveNullChar = strTemp
End Function

'-----------------------------------------------------------
' SUB: AddDirSep
' Add a trailing directory path separator (back slash) to the
' end of a pathname unless one already exists
'
' IN/OUT: [strPathName] - path to add separator to
'-----------------------------------------------------------
'
Public Sub AddDirSep(strPathName As String)
    If Right(Trim(strPathName), Len("\")) <> "\" Then
        strPathName = RTrim$(strPathName) & "\"
    End If
End Sub

'******************************************
' 打开某个 FORM 子窗体
Public Sub OpenForm(ByRef frm As Form, Optional strFormName As String)
    On Error Resume Next
    'If Not frm.Visible Then AddStatus frm.Caption, frm.Name
'    If g_nUser_Id <> 0 And strFormName <> "" Then
'        Dim i As Integer
'        For i = LBound(m_xpfVertMenu) To UBound(m_xpfVertMenu)
'            If LCase(Trim(strFormName)) = LCase(Trim(m_xpfVertMenu(i))) Then         '该窗体不能打开
'                MsgBox "您没有权限打开该窗体!", vbOKOnly Or vbCritical, "操作提示"
'                Exit Sub
'            End If
'        Next
'    End If
'    Load frm
'    If frm Is Nothing Then Exit Sub
    mdiERP.MousePointer = 11
    frm.Show
    frm.SetFocus
    mdiERP.MousePointer = 0
End Sub