Attribute VB_Name = "modSysSetting"
'Create by Whorter Wang in 2002-2-9
Option Explicit

''''''''''''''''''''''''''''''''''''''''''
Dim m_tagErrInfo As TYPE_ERRORINFO

'操作狀態(tài)枚舉
Enum ENUM_OPTYPE
    OPTYPE_QUERY = 0        '查詢狀態(tài)
    OPTYPE_INSERT = 1       '增加操作
    OPTYPE_MODIFY = 2       '修改操作
    OPTYPE_DELETE = 3       '刪除操作
    OPTYPE_AUDIT = 4        '審核操作
    OPTYPE_UNAUDIT = 5      '反審核操作
    OPTYPE_BLANK = 6        '作廢操作
    OPTYPE_UNBLANK = 7      '反作廢操作
End Enum

'審核、有效性狀態(tài)
Enum ENUM_DATASTATUS
    STATUS_CONFIRMED = 1        '已審核
    STATUS_UNCONFIRMED = 2      '未審核
    STATUS_ABANDONED = 3        '作廢
    STATUS_INUSE = 4            '有效
End Enum

'業(yè)務(wù)單據(jù)狀態(tài)
Enum ENUM_BUSINESS_STATUS
    STATUS_INITIAL = 1          '初始
    STATUS_PERFORMING = 2       '履行中
    STATUS_STOPED = 3           '異常終止
    STATUS_FINISHED = 4         '完成
    STATUS_PRODUCT_OUT = 5      '貨已發(fā)完
    STATUS_MONEY_IN = 6         '款已收完
    STATUS_PRODUCT_IN = 7       '貨已收完
    STATUS_MONEY_OUT = 8        '款已付完
End Enum

Private Type TYPE_USERDB
    strUserName As String
    strUserPassword As String
    strUserDatabase As String
    strUserDatasource As String
End Type
Public g_MyUserDB As TYPE_USERDB

'***********************************************************************************Added by Whorter Wang
Private Type TPBaseDept
    NameC As String
    DeptID As Integer
End Type
Private Type TPBaseEmp
    NameC As String
    Code1 As String
    DeptID As Integer
    DeptType As Byte
End Type
Private Type TPBaseCust
    Code1 As String
    NameC As String
End Type
Public g_tBUDept() As TPBaseDept
Public g_tBUEmp() As TPBaseEmp
Public g_tBUCust() As TPBaseCust

'**********************************************************************Added by Whorter Wang
'btChoice 用來(lái)決定更新那些基礎(chǔ)信息，缺省為全部更新
Public Function InitBaseUseInfo(Optional ByVal btChoice As Byte) As Boolean
    On Error GoTo ERROR_EXIT
    
    Dim col2 As New yxerpcom.CDepartmentCol, i As Long
    Dim col3 As New yxerpcom.CEmployeeCol, col4 As New yxerpcom.CBaseOther1Col
    Dim col5 As New yxerpcom.CCustomerCol
    
    If btChoice = 0 Or btChoice = 15 Then
        Set col2.IBaseCollection_ActiveConnection = dbMyDB
        If Not col2.IBaseCollection_Query("SELECT * FROM Department WHERE nouse_yesno=0") Then
            MsgBox "常用部門信息檢索錯(cuò)誤！", vbOKOnly + vbExclamation, "錯(cuò)誤"
            GoTo ERROR_EXIT
        End If
        If col2.Count > 0 Then
            ReDim g_tBUDept(col2.Count - 1)
            For i = 1 To col2.Count
                g_tBUDept(i - 1).DeptID = col2(i).dp_id
                g_tBUDept(i - 1).NameC = col2(i).dp_name
            Next i
        Else
            ReDim g_tBUDept(0)
        End If
    End If
    
    If btChoice = 0 Or btChoice = 20 Then
        Set col3.IBaseCollection_ActiveConnection = dbMyDB
        If Not col3.IBaseCollection_Query("SELECT * FROM Employee WHERE nouse_yesno=0") Then
            MsgBox "在職員工信息檢索錯(cuò)誤！", vbOKOnly + vbExclamation, "錯(cuò)誤"
            GoTo ERROR_EXIT
        End If
        If col3.Count > 0 Then
            ReDim g_tBUEmp(col3.Count - 1)
            For i = 1 To col3.Count
                g_tBUEmp(i - 1).Code1 = col3(i).ep_code
                g_tBUEmp(i - 1).NameC = col3(i).name_c
                g_tBUEmp(i - 1).DeptID = col3(i).Department.dp_id
                g_tBUEmp(i - 1).DeptType = col3(i).Department.dp_type
            Next i
        Else
            ReDim g_tBUEmp(0)
        End If
    End If
    
    If btChoice = 0 Or btChoice = 30 Then
        Set col5.IBaseCollection_ActiveConnection = dbMyDB
        col5.StructType = 1
        If Not col5.IBaseCollection_Query("SELECT * FROM Company WHERE nouse_yesno=0 AND cp_type=1") Then
            MsgBox "有效客戶數(shù)據(jù)檢索錯(cuò)誤！", vbOKOnly + vbExclamation, "錯(cuò)誤"
            GoTo ERROR_EXIT
        End If
        If col5.Count > 0 Then
            ReDim g_tBUCust(col5.Count - 1)
            For i = 1 To col5.Count
                g_tBUCust(i - 1).Code1 = col5(i).cp_code_1
                g_tBUCust(i - 1).NameC = col5(i).name_c
            Next i
        Else
            ReDim g_tBUCust(0)
        End If
    End If
    InitBaseUseInfo = True
ERROR_EXIT:
    Set col2 = Nothing
    Set col3 = Nothing
    Set col4 = Nothing
    Set col5 = Nothing
End Function

Public Function GetDeptID(ByVal strName As String) As Integer
    Dim i As Integer, bTwice As Boolean
ONCE_AGAIN:
    For i = 0 To UBound(g_tBUDept)
        If g_tBUDept(i).NameC = strName Then
            GetDeptID = g_tBUDept(i).DeptID
            Exit Function
        End If
    Next i
    If Not bTwice Then
        InitBaseUseInfo 15
        bTwice = True
        GoTo ONCE_AGAIN
    End If
    GetDeptID = 0
'    MsgBox "所選部門已不存在，請(qǐng)選擇其他部門！", vbOKOnly, "消息"
End Function

Public Function GetDeptName(ByVal intID As Integer) As String
    Dim i As Integer, bTwice As Boolean
ONCE_AGAIN:
    For i = 0 To UBound(g_tBUDept)
        If g_tBUDept(i).DeptID = intID Then
            GetDeptName = g_tBUDept(i).NameC
            Exit Function
        End If
    Next i
    If Not bTwice Then
        InitBaseUseInfo 15
        bTwice = True
        GoTo ONCE_AGAIN
    End If
    GetDeptName = ""
'    MsgBox "所選部門已不存在，請(qǐng)選擇其他部門！", vbOKOnly, "消息"
End Function

Public Function GetItemNameC(ByVal lMaID As Long) As String
    On Error GoTo ERROR_EXIT
    Dim oItem As New yxerpcom.CyxItem, str1 As String
    
    str1 = "SELECT * FROM Item WHERE pid=" & lMaID
    
    Set oItem.IBaseClass_ActiveConnection = dbMyDB
    If Not oItem.IBaseClass_Query(str1) Then
        MsgBox "物料信息檢索錯(cuò)誤！", vbOKOnly + vbExclamation, "錯(cuò)誤"
        GoTo ERROR_EXIT
    End If
    GetItemNameC = oItem.item_name_c
    Set oItem = Nothing
    Exit Function
ERROR_EXIT:
    Set oItem = Nothing
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modSysSetting"
    m_tagErrInfo.strErrFunc = "GetItemNameC"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
End Function

Public Function GetItemCode(ByVal lngID As Long) As String
    On Error GoTo ERROR_EXIT
    Dim oItem As New yxerpcom.CyxItem, str1 As String
    
    str1 = "SELECT * FROM Item WHERE pid=" & CStr(lngID)
    Set oItem.IBaseClass_ActiveConnection = dbMyDB
    If Not oItem.IBaseClass_Query(str1) Then
        MsgBox "物料信息檢索錯(cuò)誤！", vbOKOnly + vbExclamation, "錯(cuò)誤"
        GoTo ERROR_EXIT
    End If
    GetItemCode = oItem.item_code
    Set oItem = Nothing
    Exit Function
ERROR_EXIT:
    Set oItem = Nothing
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modSysSetting"
    m_tagErrInfo.strErrFunc = "GetItemCode"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
End Function

Public Function GetEmpCode(ByVal strName As String) As String
    Dim i As Long, bTwice As Boolean
ONCE_AGAIN:
    For i = 0 To UBound(g_tBUEmp)
        If g_tBUEmp(i).NameC = strName Then
            GetEmpCode = g_tBUEmp(i).Code1
            Exit Function
        End If
    Next i
    If Not bTwice Then
        InitBaseUseInfo 20
        bTwice = True
        GoTo ONCE_AGAIN
    End If
    GetEmpCode = ""
End Function

Public Function GetEmpName(ByVal strCode As String) As String
    Dim i As Long, bTwice As Boolean
ONCE_AGAIN:
    For i = 0 To UBound(g_tBUEmp)
        If g_tBUEmp(i).Code1 = strCode Then
            GetEmpName = g_tBUEmp(i).NameC
            Exit Function
        End If
    Next i
    If Not bTwice Then
        InitBaseUseInfo 20
        bTwice = True
        GoTo ONCE_AGAIN
    End If
    GetEmpName = ""
End Function

Public Function GetEmpDeptType(ByVal strCode As String) As Byte
    Dim i As Long, bTwice As Boolean
ONCE_AGAIN:
    For i = 0 To UBound(g_tBUEmp)
        If g_tBUEmp(i).Code1 = strCode Then
            GetEmpDeptType = g_tBUEmp(i).DeptType
            Exit Function
        End If
    Next i
    If Not bTwice Then
        InitBaseUseInfo 20
        bTwice = True
        GoTo ONCE_AGAIN
    End If
    GetEmpDeptType = 0
End Function

Public Function GetStyleByProduct(ByVal strProduct As String) As String
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    
    Set cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    cmd.CommandText = "SELECT material_type FROM VIEW_ProductB WHERE material_code_1='" & strProduct & "'"
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.RecordCount <> 1 Then
        MsgBox "產(chǎn)品信息檢索錯(cuò)誤！", vbOKOnly + vbExclamation, "錯(cuò)誤"
        GoTo ERROR_EXIT
    End If
    GetStyleByProduct = Trim$(rs!material_type)
    Set rs = Nothing
    Set cmd = Nothing
    Exit Function
ERROR_EXIT:
    Set rs = Nothing
    Set cmd = Nothing
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modSysSetting"
    m_tagErrInfo.strErrFunc = "GetStyleByProduct"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
End Function

Public Function GetUnitID(ByVal strUnit As String) As Long
    On Error Resume Next
    Dim obj As New yxerpcom.CyxUnit
    
    Set obj.IBaseClass_ActiveConnection = dbMyDB
    If Not obj.IBaseClass_Query("SELECT * FROM yxBS_Unit WHERE name_c='" & strUnit & "'") Then
        Set obj = Nothing
        Exit Function
    End If
    GetUnitID = obj.unit_id
    Set obj = Nothing
End Function

Public Function GetColorID(ByVal strCode As String) As Long
    On Error GoTo ERROR_EXIT
    Dim oColor As New yxerpcom.CBaseOther1, str1 As String
    
    str1 = "SELECT * FROM BaseOther1 WHERE bof_type=1 AND bof_code='" & strCode & "'"
    Set oColor.IBaseClass_ActiveConnection = dbMyDB
    If Not oColor.IBaseClass_Query(str1) Then
        MsgBox "色號(hào)信息檢索錯(cuò)誤！", vbOKOnly + vbExclamation, "錯(cuò)誤"
        GoTo ERROR_EXIT
    End If
    GetColorID = oColor.bof_id
    Set oColor = Nothing
    Exit Function
ERROR_EXIT:
    Set oColor = Nothing
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modSysSetting"
    m_tagErrInfo.strErrFunc = "GetMaterialCode1"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
End Function

Public Function GetCustCode(ByVal strName As String) As String
    Dim i As Long, bTwice As Boolean
ONCE_AGAIN:
    For i = 0 To UBound(g_tBUCust)
        If g_tBUCust(i).NameC = strName Then
            GetCustCode = g_tBUCust(i).Code1
            Exit Function
        End If
    Next i
    If Not bTwice Then
        InitBaseUseInfo 30
        bTwice = True
        GoTo ONCE_AGAIN
    End If
    GetCustCode = ""
End Function

'**********************************************************************
' 根據(jù)輸入的樹(shù)節(jié)點(diǎn)的KEY值求節(jié)點(diǎn)的物料代碼，用于BOM表的展開(kāi)遍歷過(guò)程
' key 節(jié)點(diǎn)的記法如下： Index + 是否為葉結(jié)點(diǎn) + 物料的表ID
' key 節(jié)點(diǎn)的記法例如："1+N+15"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetTreeCode(ByRef b_Leaf As Boolean, ByRef s_Material As String, _
        ByVal s_Key As String) As Boolean
    On Error GoTo ERROR_EXIT
    Dim str As String, i As Integer, j As Integer, strSQL As String
    Dim oItem As yxerpcom.CyxItem
    
    '是否為葉子
    str = s_Key
    i = InStr(1, str, "+N+", vbBinaryCompare)
    j = InStr(1, str, "+Y+", vbBinaryCompare)
    If i > 0 Then
        b_Leaf = False
        str = Mid$(s_Key, i + 3)
    ElseIf j > 0 Then
        b_Leaf = True
        str = Mid$(s_Key, j + 3)
    Else
        GoTo ERROR_EXIT
    End If
    '求物料Code
    strSQL = "SELECT * FROM yxBS_Item WHERE pid = " & str
    Set oItem = New yxerpcom.CyxItem
    Set oItem.IBaseClass_ActiveConnection = dbMyDB
    If oItem.IBaseClass_Query(strSQL) = False Then
        GoTo ERROR_EXIT
    End If
    
    s_Material = oItem.item_code
    Set oItem = Nothing
    GetTreeCode = True
    Exit Function
ERROR_EXIT:
    If Not oItem Is Nothing Then Set oItem = Nothing
    b_Leaf = False
    s_Material = ""
    GetTreeCode = False
    Debug.Print "ERROR: GetTreeCode!"
End Function

Public Function GetOrderTreeCode(ByRef b_Leaf As Boolean, ByRef s_Material As String, _
        ByRef s_Product As String, ByVal s_Key As String) As Boolean
    On Error GoTo ERROR_EXIT
    Dim str As String, i As Integer, j As Integer, strSQL As String
    Dim oItem As yxerpcom.CyxItem
    
    '是否為葉子
    str = s_Key
    i = InStr(1, str, "+N+", vbBinaryCompare)
    j = InStr(1, str, "+Y+", vbBinaryCompare)
    If i > 0 Then
        b_Leaf = False
        str = Mid$(s_Key, i + 3)
    ElseIf j > 0 Then
        b_Leaf = True
        str = Mid$(s_Key, j + 3)
    Else
        GoTo ERROR_EXIT
    End If
    '求物料Code
    strSQL = "SELECT * FROM yxBS_Item WHERE pid = " & str
    Set oItem = New yxerpcom.CyxItem
    Set oItem.IBaseClass_ActiveConnection = dbMyDB
    If oItem.IBaseClass_Query(strSQL) = False Then
        GoTo ERROR_EXIT
    End If
    s_Material = oItem.item_code
    Set oItem = Nothing
    '求產(chǎn)品Code
    i = InStr(1, s_Key, "+", vbBinaryCompare)
    str = Mid$(s_Key, 1, i - 1)
    s_Product = str
    
    GetOrderTreeCode = True
    Exit Function
ERROR_EXIT:
    If Not oItem Is Nothing Then Set oItem = Nothing
    b_Leaf = False
    s_Material = ""
    GetOrderTreeCode = False
    Debug.Print "ERROR: GetOrderTreeCode!"
End Function