modbaseinfo.bas

排队分诊管理系统源代码！该代码使用VB6开发环境

    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.State <> adStateOpen Then GoTo ERROR_EXIT
    If rs.RecordCount <= 0 Then
        MsgBox "数据库中城市信息没有数据记录，请联系系统管理员。", _
                vbOKOnly Or vbCritical, "数据库没有记录"
    End If
    If rs.RecordCount > 0 And Not rs.EOF Then
        ReDim g_CitySet(rs.RecordCount - 1)
        For i = 0 To rs.RecordCount - 1
            tagCityInfo.city_code = CLng(rs!city_code)
            tagCityInfo.state_code = CLng(rs!state_code)
            tagCityInfo.city_name = Trim(rs!city)
            g_CitySet(i) = tagCityInfo
            rs.MoveNext
        Next
        g_HasCity = True
    End If
    If rs.State = adStateOpen Then rs.Close
    ' (6) 初始化客户级别信息集合
    cmd.CommandText = "select * from CustomerClass order by cust_class_code"
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.State <> adStateOpen Then GoTo ERROR_EXIT
    If rs.RecordCount <= 0 Then
        MsgBox "数据库中客户级别信息没有数据记录，请联系系统管理员。", _
                vbOKOnly Or vbCritical, "数据库没有记录"
    End If
    If rs.RecordCount > 0 And Not rs.EOF Then
        ReDim g_CustomerClassSet(rs.RecordCount - 1)
        For i = 0 To rs.RecordCount - 1
            g_CustomerClassSet(i).cust_class_code = CLng(rs!cust_class_code)
            g_CustomerClassSet(i).cust_class = Trim(rs!cust_class)
            rs.MoveNext
        Next
        g_HasCustomerClass = True
    End If
    If rs.State = adStateOpen Then rs.Close
    ' (7) 初始化客户类型信息集合
    cmd.CommandText = "select * from CustomerTypes order by cust_type_code"
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.State <> adStateOpen Then GoTo ERROR_EXIT
    If rs.RecordCount <= 0 Then
        MsgBox "数据库中客户类型信息没有数据记录，请联系系统管理员。", _
                vbOKOnly Or vbCritical, "数据库没有记录"
    End If
    If rs.RecordCount > 0 And Not rs.EOF Then
        ReDim g_CustomerTypeSet(rs.RecordCount - 1)
        For i = 0 To rs.RecordCount - 1
            g_CustomerTypeSet(i).cust_type_code = CLng(rs!cust_type_code)
            g_CustomerTypeSet(i).cust_type = Trim(rs!cust_type)
            rs.MoveNext
        Next
        g_HasCustomerType = True
    End If
    If rs.State = adStateOpen Then rs.Close
EXIT_TRUE:
    If rs.State = adStateOpen Then rs.Close
    fModuleInited = True
    InitBaseInfoModule = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modBaseInfo"
    m_tagErrInfo.strErrFunc = "InitBaseInfoModule"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "初始化基本信息模块失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    If rs.State = adStateOpen Then rs.Close
    fModuleInited = False
    InitBaseInfoModule = False
End Function

'**************************************************************************
' 产品类型信息相关函数和过程
'**************************************************************************
'''''''''''''''''''''''''''''''''''''''''''''''
' 获得产品类型名称
Public Function GetProductStyleName(ByVal lPruductStyleID As Long) As String
    On Error GoTo ERROR_EXIT
    Dim i As Long
    
    If Not InitBaseInfoModule Then GoTo ERROR_EXIT    '初始化失败
    If lPruductStyleID <= 0 Then GoTo ERROR_EXIT
    
    If Not g_HasProductStyle Then GoTo ERROR_EXIT
    For i = LBound(g_ProductStyleSet) To UBound(g_ProductStyleSet)
        If g_ProductStyleSet(i).style_id = lPruductStyleID Then
            GetProductStyleName = g_ProductStyleSet(i).style_name
            Exit Function
        End If
    Next i

ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modBaseInfo"
    m_tagErrInfo.strErrFunc = "GetProductStyleName"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "获得产品类型名称失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    GetProductStyleName = ""
End Function

'''''''''''''''''''''''''''''''''''''''''''''''
' 获得产品类型编号
Public Function GetProductStyleID(ByVal strPruductStyleName As String) As Long
    On Error GoTo ERROR_EXIT
    Dim i As Long
    
    If Not g_HasProductStyle Then GoTo ERROR_EXIT
    If Not InitBaseInfoModule Then GoTo ERROR_EXIT    '初始化失败
    If strPruductStyleName = "" Then GoTo ERROR_EXIT
    For i = LBound(g_ProductStyleSet) To UBound(g_ProductStyleSet)
        If g_ProductStyleSet(i).style_name = strPruductStyleName Then
            GetProductStyleID = g_ProductStyleSet(i).style_id
            Exit Function
        End If
    Next i

ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modBaseInfo"
    m_tagErrInfo.strErrFunc = "GetProductStyleID"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "获得产品类型编号失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    GetProductStyleID = -1
End Function

'''''''''''''''''''''''''''''''''''''''''''''''
' 获得某个产品类型编号的所有子产品类型信息集合
' PARAMETERS:
'       lProductStyle       产品类型编号
'       ProductSubStyleSet  所有子产品类型信息集合
Public Function GetProductSubStyleOfProductStyle( _
            ByVal lProductStyle As Long, _
            ByRef ProductSubStyleSet() As TYPE_PRODUCT_SUB_STYLE) As Boolean
    On Error GoTo ERROR_EXIT
    Dim i  As Long
    Dim lIndex As Long
    
    If Not InitBaseInfoModule Then GoTo ERROR_EXIT    '初始化失败
    If lProductStyle <= 0 Then GoTo ERROR_EXIT
    '清空原有数据
    lIndex = LBound(ProductSubStyleSet)
    
    If Not g_HasProductSubStyle Then GoTo ERROR_EXIT
    '检索并设置结果集合
    For i = LBound(g_ProductSubStyleSet) To UBound(g_ProductSubStyleSet)
        If g_ProductSubStyleSet(i).style_id = lProductStyle Then
            ReDim Preserve ProductSubStyleSet(lIndex)
            ProductSubStyleSet(lIndex) = g_ProductSubStyleSet(i)
            lIndex = lIndex + 1
        End If
    Next
    
    GetProductSubStyleOfProductStyle = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modBaseInfo"
    m_tagErrInfo.strErrFunc = "GetProductSubStyleOfProductStyle"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "获得某个产品类型编号的所有子产品类型信息集合失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    GetProductSubStyleOfProductStyle = False
End Function

'**************************************************************************
' 产品子类型信息相关函数和过程
'**************************************************************************
'''''''''''''''''''''''''''''''''''''''''''''''
' 获得产品子类型名称
Public Function GetProductSubStyleName(ByVal lPruductSubStyleID As Long) As String
    On Error GoTo ERROR_EXIT
    Dim i As Long
    
    If Not InitBaseInfoModule Then GoTo ERROR_EXIT    '初始化失败
    If lPruductSubStyleID <= 0 Then GoTo ERROR_EXIT
    
    If Not g_HasProductSubStyle Then GoTo ERROR_EXIT
    For i = LBound(g_ProductSubStyleSet) To UBound(g_ProductSubStyleSet)
        If g_ProductSubStyleSet(i).sub_style_id = lPruductSubStyleID Then
            GetProductSubStyleName = g_ProductSubStyleSet(i).sub_style_name
            Exit Function
        End If
    Next i

ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modBaseInfo"
    m_tagErrInfo.strErrFunc = "GetProductSubStyleName"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "获得产品子类型名称失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    GetProductSubStyleName = ""
End Function

'''''''''''''''''''''''''''''''''''''''''''''''
' 获得产品子类型编号
Public Function GetProductSubStyleID(ByVal strPruductStyleName As String) As Long
    On Error GoTo ERROR_EXIT
    Dim i As Long
    
    If Not InitBaseInfoModule Then GoTo ERROR_EXIT    '初始化失败
    If strPruductStyleName = "" Then GoTo ERROR_EXIT
    If Not g_HasProductSubStyle Then GoTo ERROR_EXIT
    
    For i = LBound(g_ProductSubStyleSet) To UBound(g_ProductSubStyleSet)
        If g_ProductSubStyleSet(i).sub_style_name = strPruductStyleName Then
            GetProductSubStyleID = g_ProductSubStyleSet(i).sub_style_id
            Exit Function
        End If
    Next

ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modBaseInfo"
    m_tagErrInfo.strErrFunc = "GetProductSubStyleID"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "获得产品子类型编号。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    GetProductSubStyleID = -1
End Function

'**************************************************************************
' 片区信息相关函数和过程
'**************************************************************************
'''''''''''''''''''''''''''''''''''''''''''''''
' 获得片区名称
Public Function GetTerritoryName(ByVal id As Long) As String
    On Error GoTo ERROR_EXIT
    Dim i As Long
    
    If Not InitBaseInfoModule Then GoTo ERROR_EXIT    '初始化失败
    If id <= 0 Then GoTo ERROR_EXIT
    If Not g_HasTerritory Then GoTo ERROR_EXIT
    
    For i = LBound(g_TerritorySet) To UBound(g_TerritorySet)
        If g_TerritorySet(i).territory_code = id Then
            GetTerritoryName = g_TerritorySet(i).territory_name
            Exit Function
        End If
    Next

ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modBaseInfo"
    m_tagErrInfo.strErrFunc = "GetTerritoryName"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "获得片区名称失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    GetTerritoryName = ""
End Function

'''''''''''''''''''''''''''''''''''''''''''''''
' 获得片区编号
Public Function GetTerritoryID(ByVal strName As String) As Long
    On Error GoTo ERROR_EXIT
    Dim i As Long
    
    If Not InitBaseInfoModule Then GoTo ERROR_EXIT    '初始化失败
    If Not g_HasTerritory Then GoTo ERROR_EXIT
    If strName = "" Then GoTo ERROR_EXIT
    For i = LBound(g_TerritorySet) To UBound(g_TerritorySet)
        If g_TerritorySet(i).territory_name = strName Then
            GetTerritoryID = g_TerritorySet(i).territory_code
            Exit Function
        End If
    Next