Attribute VB_Name = "Data"
Option Explicit

Const detail_basket_name = 0
Const detail_basket_expiration = 1
Const detail_basket_amount = 2
Const detail_basket_count = 3
Const detail_basket_pamount = 4
Const detail_basket_pcount = 5
Const detail_basket_uamount = 6
Const detail_basket_ucount = 7
Const detail_basket_zcount = 8
Const detail_basket_dimension = 8

Const data_category_id = 0
Const data_category_str = 1
Const data_category_dimension = 1

Private m_xml           As XMLDocument
Private m_categories    As Object
Private m_baskets       As Object
Private m_items         As Object
Private m_recipients    As Object
Private m_units         As Object

Private m_bDirty        As Boolean

Public Function BasketItemXMLAdd(dwBID As Long, dwID As Long) As Object
    Dim bnode As Object, bsnode As Object, inode As Object, attr As Object
    Dim i As Long, seq As Long
    Dim astr As String
    
    Set BasketItemXMLAdd = Nothing
    
    astr = "I[@ID=""" & dwID & """]"
    Set inode = m_items.selectSingleNode(astr)
    
    astr = "B[@ID=""" & dwBID & """]"
    Set bsnode = m_baskets.selectSingleNode(astr)
    If (Not bsnode Is Nothing) Then
        Set attr = bsnode.Attributes.getNamedItem("NS")
        If (Not attr Is Nothing) Then
            seq = String2Number(attr.Text, 1000000)
            attr.Text = CStr(seq + 1)
        Else
            seq = 1000000
        End If
        Set bnode = SchemaGet("BI")
        Set bnode = bnode.cloneNode(True)
        If (Not (bnode Is Nothing And inode Is Nothing)) Then
            Set attr = bnode.Attributes.getNamedItem("ID")
            If (Not attr Is Nothing) Then attr.Text = CStr(dwID)
            Set attr = bnode.Attributes.getNamedItem("SEQ")
            If (Not attr Is Nothing) Then attr.Text = CStr(seq)
            Set attr = bnode.Attributes.getNamedItem("P")
            If (Not attr Is Nothing) Then attr.Text = "0.0"
            Set attr = bnode.Attributes.getNamedItem("Q")
            If (Not attr Is Nothing) Then attr.Text = "1"
            Set attr = bnode.Attributes.getNamedItem("S")
            If (Not attr Is Nothing) Then attr.Text = "U"
            Set attr = inode.Attributes.getNamedItem("T")
            If (Not attr Is Nothing) Then astr = attr.Text
            Set attr = bnode.Attributes.getNamedItem("T")
            If (Not attr Is Nothing) Then attr.Text = astr
            Call bsnode.appendChild(bnode)
            m_bDirty = True
        End If
    End If
    
    Set BasketItemXMLAdd = bnode
    Set bnode = Nothing
    Set bsnode = Nothing
    Set inode = Nothing
    Exit Function
End Function
Public Function BasketItemXMLDel(dwBID As Long, dwSEQ As Long) As Long
    Dim bnode As Object, node As Object
    Dim i As Long, seq As Long
    Dim astr As String
    
    astr = "B[@ID=""" & dwBID & """]"
    Set bnode = m_baskets.selectSingleNode(astr)
    If (Not bnode Is Nothing) Then
        astr = "BI[@SEQ=""" & dwSEQ & """]"
        Set node = bnode.selectSingleNode(astr)
        If (Not node Is Nothing) Then Set node = bnode.removeChild(node)
    End If
    
    Set bnode = Nothing
    Set node = Nothing
    Exit Function
End Function


Public Sub CategoryFill(ctrl As Control)
    Dim node As Object, attr As Object
    Dim dwID As Long
    
    ctrl.Clear
    For Each node In m_categories.childNodes
        Set attr = node.Attributes.getNamedItem("ID")
        dwID = String2Number(attr.Text, 0)
        Set attr = node.Attributes.getNamedItem("T")
        ctrl.AddItem attr.Text
        ctrl.ItemData(ctrl.NewIndex) = dwID
    Next node
    Exit Sub
End Sub
Public Sub CategoryDataGet(data)
    Dim node As Object, attr As Object
    Dim dwID As Long
    Dim ct As Long, i As Long
    ct = m_categories.childNodes.length
    ReDim data(ct - 1, data_category_dimension)
    i = 0
    For Each node In m_categories.childNodes
        Set attr = node.Attributes.getNamedItem("ID")
        dwID = String2Number(attr.Text, 0)
        Set attr = node.Attributes.getNamedItem("T")
        data(i, data_category_id) = dwID
        data(i, data_category_str) = attr.Text
        i = i + 1
    Next node
    Exit Sub
End Sub

Public Sub BasketFill(ctrl As Control)
    Dim node As Object, attr As Object
    Dim dwID As Long
    ctrl.Clear
    For Each node In m_baskets.childNodes
        Set attr = node.Attributes.getNamedItem("ID")
        dwID = String2Number(attr.Text, 0)
        Set attr = node.Attributes.getNamedItem("T")
        ctrl.AddItem attr.Text
        ctrl.ItemData(ctrl.NewIndex) = dwID
    Next node
    Exit Sub
End Sub


Private Function CategoryNodeGet(dwCID As Long) As Object
    Dim astr As String
    If (dwCID > 0) Then
        astr = "C[@ID=""" & dwCID & """]"
        Set CategoryNodeGet = m_categories.selectSingleNode(astr)
    Else
        Set CategoryNodeGet = Nothing
    End If
    Exit Function
End Function

Private Function CategoryNameGet(dwCID As Long) As String
    Dim astr As String
    Dim node As Object
    If (dwCID > 0) Then
        astr = "C[@ID=""" & dwCID & """]/@T"
        Set node = m_categories.selectSingleNode(astr)
        If (Not node Is Nothing) Then
            CategoryNameGet = node.Text
        End If
        Set node = Nothing
    Else
        Set CategoryNameGet = ""
    End If
    Exit Function
End Function

Public Sub DataEnd()
    Call DataSave
    Set m_categories = Nothing
    Set m_baskets = Nothing
    Set m_items = Nothing
    Set m_recipients = Nothing
    Set m_units = Nothing
    Set m_xml = Nothing
    Exit Sub
End Sub


Public Sub DataInit()
    Dim astr As String
    Dim node As Object, root As Object
        
    Set m_xml = CreateObject("Microsoft.XMLDOM")
    astr = LoadXMLString(g_docPath & g_fileData)
    Call m_xml.loadXML(astr)
    
    Set root = m_xml.documentElement
    astr = "Categories"
    Set m_categories = root.selectSingleNode(astr)
    astr = "Baskets"
    Set m_baskets = root.selectSingleNode(astr)
    astr = "Items"
    Set m_items = root.selectSingleNode(astr)
    astr = "Recipients"
    Set m_recipients = root.selectSingleNode(astr)
    astr = "Units"
    Set m_units = root.selectSingleNode(astr)
    
    m_bDirty = False
    Exit Sub
End Sub

Public Sub DataSave()
    If (m_bDirty) Then Call SaveXMLString(g_docPath & g_fileData, m_xml)
    m_bDirty = False
    Exit Sub
End Sub


Public Sub CategoryOfItemFill(dwID As Long, ctrl As Control)
    Dim astr As String
    Dim nodes As Object, node As Object
    Dim dwCID As Long, i As Long, ct As Long
    ctrl.Clear
    If (dwID > 0) Then
        astr = "I[@ID=""" & dwID & """]" & "/IC/@ID"
        Set nodes = m_items.selectNodes(astr)
        ct = nodes.length
        
        For i = 0 To ct - 1
            Set node = nodes(i)
            dwCID = String2Number(node.Text, -1)
            astr = CategoryNameGet(dwCID)
            If (astr <> "") Then
                ctrl.AddItem astr
                ctrl.ItemData(ctrl.NewIndex) = dwCID
            End If
            Set node = Nothing
        Next i
        Set nodes = Nothing
    End If
    Exit Sub
End Sub

Public Function ItemXMLAdd(strT As String, dwCID As Long) As Long
    Dim astr As String
    Dim node As Object, cnode As Object, attr As Object
    Dim dwID As Long, i As Long, ct As Long
    
    astr = "I[@T=""" & strT & """]"
    Set node = m_items.selectSingleNode(astr)
    If (node Is Nothing) Then
        dwID = -1
        Set attr = m_items.Attributes.getNamedItem("NextID")
        If (Not attr Is Nothing) Then dwID = String2Number(attr.Text, 0)
        If (dwID > 0) Then
            attr.Text = CStr(dwID + 1)
            Set attr = Nothing
            Set node = SchemaGet("I")
            If (Not node Is Nothing) Then
                Set node = node.cloneNode(True)
                Set attr = node.Attributes.getNamedItem("ID")
                attr.Text = CStr(dwID)
                Set attr = Nothing
                Set attr = node.Attributes.getNamedItem("T")
                attr.Text = strT
                Set attr = Nothing
                If (dwCID > 0) Then
                    Set cnode = SchemaGet("IC")
                    Set cnode = cnode.cloneNode(True)
                    Set attr = cnode.Attributes.getNamedItem("ID")
                    attr.Text = CStr(dwCID)
                    Set cnode = node.appendChild(cnode)
                End If
                Set node = m_items.appendChild(node)
                m_bDirty = True
            End If
        End If
    Else
        Set attr = node.Attributes.getNamedItem("ID")
        dwID = String2Number(attr.Text, 0)
    End If
    ItemXMLAdd = dwID
    Exit Function
End Function

Public Function CategoryXMLAdd(strT As String, dwCID As Long) As Long
    Dim astr As String
    Dim node As Object, cnode As Object, attr As Object
    Dim dwID As Long, i As Long, ct As Long
    
    astr = "C[@T=""" & strT & """]"
    Set node = m_categories.selectSingleNode(astr)
    If (node Is Nothing) Then
        dwID = -1
        Set attr = m_categories.Attributes.getNamedItem("NextID")
        If (Not attr Is Nothing) Then dwID = String2Number(attr.Text, 0)
        If (dwID > 0) Then
            attr.Text = CStr(dwID + 1)
            Set attr = Nothing
            Set node = SchemaGet("C")
            If (Not node Is Nothing) Then
                Set node = node.cloneNode(True)
                Set attr = node.Attributes.getNamedItem("ID")
                attr.Text = CStr(dwID)
                Set attr = Nothing
                Set attr = node.Attributes.getNamedItem("T")
                attr.Text = strT
                Set attr = Nothing
                Set node = m_categories.appendChild(node)
                m_bDirty = True
            End If
        End If
    Else
        Set attr = node.Attributes.getNamedItem("ID")
        dwID = String2Number(attr.Text, 0)
    End If
    CategoryXMLAdd = dwID
    Exit Function
End Function

Public Function BasketXMLAdd(strT As String, strXDate As String) As Long
    Dim astr As String
    Dim node As Object, cnode As Object, attr As Object
    Dim dwID As Long, i As Long, ct As Long
    
    astr = "B[@T=""" & strT & """]"
    Set node = m_baskets.selectSingleNode(astr)
    If (node Is Nothing) Then
        dwID = -1
        Set attr = m_baskets.Attributes.getNamedItem("NextID")
        If (Not attr Is Nothing) Then dwID = String2Number(attr.Text, 0)
        If (dwID > 0) Then
            attr.Text = CStr(dwID + 1)
            Set attr = Nothing
            Set node = SchemaGet("B")
            If (Not node Is Nothing) Then
                Set node = node.cloneNode(True)
                Set attr = node.Attributes.getNamedItem("ID")
                attr.Text = CStr(dwID)
                Set attr = Nothing
                Set attr = node.Attributes.getNamedItem("T")
                attr.Text = strT
                Set attr = Nothing
                Set attr = node.Attributes.getNamedItem("XD")
                attr.Text = strXDate
                Set attr = Nothing
                Set attr = node.Attributes.getNamedItem("NS")
                attr.Text = "1"
                Set attr = Nothing
                Set node = m_baskets.appendChild(node)
                m_bDirty = True
            End If
        End If
    Else
        Set attr = node.Attributes.getNamedItem("ID")
        dwID = String2Number(attr.Text, 0)
    End If
    BasketXMLAdd = dwID
    Exit Function
End Function


Public Function ItemXMLEdit(strT As String, dwID As Long) As Long
    Dim astr As String
    Dim node As Object, attr As Object
    
    astr = "I[@ID=""" & dwID & """]/@T"
    Set node = m_items.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        node.Text = strT
        ItemXMLEdit = dwID
        m_bDirty = True
    Else
        ItemXMLEdit = -1
    End If
    Set node = Nothing
    Exit Function
End Function

Public Function CategoryXMLEdit(strT As String, dwID As Long) As Long
    Dim astr As String
    Dim node As Object, attr As Object
    
    astr = "C[@ID=""" & dwID & """]/@T"
    Set node = m_categories.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        node.Text = strT
        CategoryXMLEdit = dwID
        m_bDirty = True
    Else
        CategoryXMLEdit = -1
    End If
    Set node = Nothing
    Exit Function
End Function

Public Function BasketXMLEdit(strT As String, strXDate As String, dwID As Long) As Long
    Dim astr As String
    Dim node As Object, attr As Object
    
    astr = "B[@ID=""" & dwID & """]"
    Set node = m_baskets.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        Set attr = node.Attributes.getNamedItem("T")
        attr.Text = strT
        Set attr = node.Attributes.getNamedItem("XD")
        attr.Text = strXDate
        BasketXMLEdit = dwID
        m_bDirty = True
    Else
        BasketXMLEdit = -1
    End If
    Set attr = Nothing
    Set node = Nothing
    Exit Function
End Function


Public Function ItemXMLDel(dwID As Long) As Long
    Dim astr As String
    Dim node As Object, attr As Object
    
    astr = "I[@ID=""" & dwID & """]"
    Set node = m_items.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        Set node = m_items.removeChild(node)
        ItemXMLDel = dwID
        m_bDirty = True
    Else
        ItemXMLDel = -1
    End If
    Set node = Nothing
    Exit Function
End Function

Public Function BasketXMLDel(dwID As Long) As Long
    Dim astr As String
    Dim node As Object, attr As Object
    
    astr = "B[@ID=""" & dwID & """]"
    Set node = m_baskets.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        Set node = m_baskets.removeChild(node)
        BasketXMLDel = dwID
        m_bDirty = True
    Else
        BasketXMLDel = -1
    End If
    Set node = Nothing
    Exit Function
End Function
Public Function CategoryXMLDel(dwID As Long) As Long
    Dim astr As String
    Dim node As Object, nodes As Object, cnode As Object
    Dim i As Long, ct As Long
    
    astr = "C[@ID=""" & dwID & """]"
    Set node = m_categories.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        Set node = m_categories.removeChild(node)
        Set node = Nothing
        Set nodes = ItemNodesByCategoryGet(dwID)
        ct = nodes.length
        astr = "IC[@ID=""" & dwID & """]"
        For i = 0 To ct - 1
            Set node = nodes(i)
            Set cnode = node.selectSingleNode(astr)
            If (Not cnode Is Nothing) Then Set cnode = node.removeChild(cnode)
            Set cnode = Nothing
        Next i
        Set nodes = Nothing
        CategoryXMLDel = dwID
        m_bDirty = True
    Else
        CategoryXMLDel = -1
    End If
    Set cnode = Nothing
    Set node = Nothing
    Set nodes = Nothing
    Exit Function
End Function


Public Sub ItemByCategoryFill(dwCID As Long, ctrl As Control)
    Dim nodes As Object, attr As Object
    Dim i As Long, ct As Long, dwID As Long
    
    ctrl.Clear
    Set nodes = ItemNodesByCategoryGet(dwCID)
    If (Not nodes Is Nothing) Then
        ct = nodes.length
        For i = 0 To ct - 1
            dwID = -1
            Set attr = nodes(i).Attributes.getNamedItem("ID")
            If (Not attr Is Nothing) Then dwID = String2Number(attr.Text, -1)
            Set attr = nodes(i).Attributes.getNamedItem("T")
            If (Not attr Is Nothing And dwID > 0) Then
                ctrl.AddItem attr.Text
                ctrl.ItemData(ctrl.NewIndex) = dwID
            End If
            Set attr = Nothing
        Next i
    End If
    Set nodes = Nothing
    Exit Sub
End Sub

Public Function ItemByBasketFill(dwBID As Long, ctrl As Control) As Double
    Dim nodes As Object, attr As Object
    Dim i As Long, ct As Long, dwID As Long
    Dim amt As Double, q As Double, p As Double
    
    amt = 0
    ctrl.Clear
    Set nodes = ItemNodesByBasketGet(dwBID)
    If (Not nodes Is Nothing) Then
        ct = nodes.length
        For i = 0 To ct - 1
            dwID = -1
            Set attr = nodes(i).Attributes.getNamedItem("SEQ")
            If (Not attr Is Nothing) Then dwID = String2Number(attr.Text, -1)
            Set attr = nodes(i).Attributes.getNamedItem("T")
            If (Not attr Is Nothing And dwID > 0) Then
                ctrl.AddItem attr.Text
                ctrl.ItemData(ctrl.NewIndex) = dwID
            End If
            Set attr = nodes(i).Attributes.getNamedItem("Q")
            If (Not attr Is Nothing) Then q = String2Number(attr.Text, 0) Else q = 0
            Set attr = nodes(i).Attributes.getNamedItem("P")
            If (Not attr Is Nothing) Then p = String2Number(attr.Text, 0) Else p = 0
            amt = amt + q * p
            Set attr = nodes(i).Attributes.getNamedItem("A")
            If (Not attr Is Nothing) Then attr.Text = FormatNumber(amt, 2)
            Set attr = Nothing
        Next i
    End If
    ItemByBasketFill = amt
    Set nodes = Nothing
    Exit Function
End Function

Public Function BasketDetailGet(dwBID As Long, data)

    Dim nodes As Object, attr As Object
    Dim astr As String, strXD As String, strName As String
    Dim i As Long, ct As Long, dwID As Long
    Dim tamt As Double, pamt As Double, uamt As Double
    Dim q As Double, p As Double, t As Double
    Dim tct As Long, pct As Long, uct As Long, zct As Long
    
    tamt = 0
    pamt = 0
    uamt = 0
    tct = 0
    pct = 0
    zct = 0
    uct = 0
    
    astr = "B[@ID=""" & dwBID & """]"
    Set nodes = m_baskets.selectSingleNode(astr)
    If (Not nodes Is Nothing) Then
        Set attr = nodes.Attributes.getNamedItem("T")
        If (Not attr Is Nothing) Then strName = attr.Text Else strName = "Not found"
        Set attr = nodes.Attributes.getNamedItem("XD")
        If (Not attr Is Nothing) Then strXD = attr.Text Else strXD = ""
    End If
    Set nodes = Nothing
    
    Set nodes = ItemNodesByBasketGet(dwBID)
    If (Not nodes Is Nothing) Then
        ct = nodes.length
        For i = 0 To ct - 1
            Set attr = nodes(i).Attributes.getNamedItem("P")
            If (Not attr Is Nothing) Then p = String2Number(attr.Text, 0) Else p = 0
            Set attr = nodes(i).Attributes.getNamedItem("Q")
            If (Not attr Is Nothing) Then
                q = String2Number(attr.Text, 0)
                If (q = 0) Then attr.Text = "1"
            Else
                q = 1
            End If
            t = q * p
            tamt = tamt + t
            tct = tct + 1
            Set attr = nodes(i).Attributes.getNamedItem("S")
            If (Not attr Is Nothing) Then
                If (attr.Text = "P") Then
                    pct = pct + 1
                    pamt = pamt + t
                Else
                    If (p > 0) Then
                        uct = uct + 1
                        uamt = uamt + t
                    End If
                End If
            End If
            If (p = 0) Then zct = zct + 1
            Set attr = nodes(i).Attributes.getNamedItem("A")
            If (Not attr Is Nothing) Then attr.Text = FormatNumber(tamt, 2)
            Set attr = Nothing
        Next i
    End If
    
    data(detail_basket_name) = astr
    data(detail_basket_expiration) = strXD
    data(detail_basket_amount) = FormatNumber(tamt, 2)
    data(detail_basket_count) = FormatNumber(tct, 0)
    data(detail_basket_pamount) = FormatNumber(pamt, 2)
    data(detail_basket_pcount) = FormatNumber(pct, 0)
    data(detail_basket_uamount) = FormatNumber(uamt, 2)
    data(detail_basket_ucount) = FormatNumber(uct, 0)
    data(detail_basket_zcount) = FormatNumber(zct, 0)
    
    Set nodes = Nothing
    Exit Function
End Function

Public Function ItemNodesByBasketGet(dwBID As Long) As Object
    Dim astr As String
    If (dwBID > 0) Then
        astr = "B[@ID=""" & dwBID & """]/BI"
    Else
        astr = "B/BI"
    End If
    Set ItemNodesByBasketGet = m_baskets.selectNodes(astr)
    Exit Function
End Function

Public Function ItemInAnyBasket(dwID As Long) As Boolean
    Dim astr As String
    Dim node As String
    
    astr = "B/BI[@ID=""" & dwID & """]"
    Set node = m_baskets.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        ItemInAnyBasket = True
    Else
        ItemInAnyBasket = False
    End If
    Set node = Nothing
    Exit Function
End Function


Public Function ItemNodesByCategoryGet(dwCID As Long) As Object
    Dim astr As String
    If (dwCID > 0) Then
        astr = "I[IC/@ID=""" & dwCID & """]"
    Else
        astr = "I"
    End If
    Set ItemNodesByCategoryGet = m_items.selectNodes(astr)
    Exit Function
End Function

Public Function ItemXMLAddCategory(dwID As Long, dwCID As Long) As Boolean
    Dim astr As String
    Dim node As Object, cnode As Object, attr As Object
    
    astr = "I[@ID=""" & dwID & """]"
    Set node = m_items.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        astr = "IC[@ID=""" & dwCID & """]"
        Set cnode = node.selectSingleNode(astr)
        If (Not cnode Is Nothing) Then
            ItemXMLAddCategory = False
        Else
            Set cnode = SchemaGet("IC")
            Set cnode = cnode.cloneNode(True)
            Set attr = cnode.Attributes.getNamedItem("ID")
            attr.Text = CStr(dwCID)
            Set cnode = node.appendChild(cnode)
            m_bDirty = True
            ItemXMLAddCategory = True
        End If
    End If
    Set node = Nothing
    Set cnode = Nothing
    Set attr = Nothing
    Exit Function
End Function

Public Function ItemXMLDelCategory(dwID As Long, dwCID As Long) As Boolean
    Dim astr As String
    Dim node As Object, cnode As Object, attr As Object
    
    astr = "I[@ID=""" & dwID & """]"
    Set node = m_items.selectSingleNode(astr)
    If (Not node Is Nothing) Then
        astr = "IC[@ID=""" & dwCID & """]"
        Set cnode = node.selectSingleNode(astr)
        If (cnode Is Nothing) Then
            ItemXMLDelCategory = False
        Else
            Set cnode = node.removeChild(cnode)
            m_bDirty = True
            ItemXMLDelCategory = True
        End If
    End If
    Set node = Nothing
    Set cnode = Nothing
    Set attr = Nothing
    Exit Function
End Function

Public Sub DataSetDirty()
    m_bDirty = True
    Exit Sub
End Sub