VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cGAMProject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Package As cGAMPackage
Public Registry As cGAMRegistryNode
Public RegistryTypes As CHive
Public ErrDescription As String
Public ErrSource As String

Public Function LoadHeader(FileName As String, Optional Password As String = "", Optional OverridePassword As Boolean = False, Optional OverrideChildPasswords As Boolean = True) As Boolean
    Log "Loading Project Header ('" & FileName & "')...", ltAction
    
    On Error GoTo fehler:
    Set Package = New cGAMPackage
    If Not Package.FileOpen(FileName, Password, OverridePassword, OverrideChildPasswords) Then LoadHeader = False: Err.Raise 10001, Package.ErrSource, Package.ErrDesc
    LoadHeader = True
    
    Log "Header loaded successfully.", ltSuccess
    Exit Function
fehler:
    ErrDescription = Err.Description
    ErrSource = Err.source
End Function

Public Function LoadProject(FileName As String, Optional Password As String = "", Optional OverridePassword As Boolean = False, Optional OverrideChildPasswords As Boolean = True) As Boolean
    Log "Loading Project '" & FileName & "'...", ltAction

    On Error GoTo fehler:
    
    If Not LoadHeader(FileName, Password, OverridePassword, OverrideChildPasswords) Then LoadProject = False: Err.Raise 1234, ErrSource, ErrDescription
    LoadRegistry
    LoadProject = True
    Exit Function
    
fehler:
    LoadProject = False
    ErrDescription = Err.Description
    ErrSource = Err.source
End Function

Public Function SaveRegistry() As Boolean
    Dim fId As Integer
    Dim XMLString As String
    XMLString = RegistryToXML

    fId = Package.RPAK.Root.FindFile("registrydump.xml")
    
    If fId > 0 Then
        Package.RPAK.Root.FileContent(fId) = XMLString
    Else
        Package.RPAK.Root.AddFile "registrydump.xml", XMLString
        frmViewProject.Update
    End If

    Package.RPAK.FileSave Package.RPAK.FileName
End Function

Public Function LoadRegistry() As Boolean
    Log "Initializing Registry...", ltAction
    Set Registry = New cGAMRegistryNode
    Registry.NodeType = "category"
    Registry.NodeName = "registry"
    Registry.FriendlyName = "Registry Root"
    
    Set RegistryTypes = New CHive
    
    Dim i As Integer
    For i = 1 To LoadedDependencies.Count
    LoadedDependencies(i).StructureToRegistry Registry, RegistryTypes
    Next i
    
    Log "Registry Structure generated.", ltSuccess
    Log "Putting Registry into memory...", ltAction
    
    Dim fId As Integer
    fId = Package.RPAK.Root.FindFile("registrydump.xml")
    
    Dim XMLString As String
    
    If fId > 0 Then
        XMLString = Package.RPAK.Root.FileContent(fId)
        XMLToRegistry XMLString
    Else
        Exit Function
    End If
End Function

Private Function RegistryToXML() As String
    Dim XMLDom As New DOMDocument

    Dim mainnode As IXMLDOMElement
    Set mainnode = XMLDom.createElement("registry")
    Set XMLDom.documentElement = mainnode

    AddXMLChildren XMLDom, mainnode, Registry

    RegistryToXML = XMLDom.xml
End Function

Public Sub XMLToRegistry(XMLString As String)
    Dim XMLDom As New DOMDocument
    
    If XMLDom.loadXML(XMLString) Then
        XMLElementToRegistry XMLDom.documentElement, XMLDom
    Else
        MsgBox XMLDom.parseError.reason, , "Error on parsing XML"
    End If
End Sub

Public Sub XMLElementToRegistry(XMLNode As IXMLDOMElement, _
                                DomDoc As DOMDocument, Optional CreateifNonExistent = False)
    Dim Nodepath As String
    Dim ret As Boolean
    Nodepath = GetXMLElementPath(XMLNode)
    ret = False

    If Not Nodepath = "" Then
        Nodepath = Left$(Nodepath, Len(Nodepath) - 1)
    
        Dim RegNode As cGAMRegistryNode
        Set RegNode = Registry.RecursiveFind(Nodepath)
    
        Dim edi As Object
        
        If Not RegNode Is Nothing Then

            Set edi = GetSettingsEditor(XMLNode.getAttributeNode("type").Text)

            If Not edi Is Nothing Then
                'Debug.Print Nodepath & " --> '" & XMLNode.Text & "'"
                ret = edi.XMLToData(RegNode, XMLNode, DomDoc, Me)
            End If
        End If
    End If

    If Not ret Then
        Dim i As Integer

        For i = 0 To XMLNode.childNodes.Length - 1
            If XMLNode.childNodes(i).baseName = "node" Then
                XMLElementToRegistry XMLNode.childNodes(i), DomDoc, CreateifNonExistent
            End If
        Next i
    End If
End Sub
'#End Region

Public Function GetXMLElementPath(XMLNode As IXMLDOMElement, Optional SoFarPath As String = "") As String
    If XMLNode.ParentNode Is Nothing Then GetXMLElementPath = SoFarPath: Exit Function

    Dim A As IXMLDOMAttribute
    Set A = XMLNode.getAttributeNode("name")
    If A Is Nothing Then GetXMLElementPath = SoFarPath: Exit Function

    GetXMLElementPath = GetXMLElementPath(XMLNode.ParentNode, A.Text & "\" & SoFarPath)
End Function

Public Function AddXMLChildren(DomDoc As DOMDocument, Node As IXMLDOMElement, RegNode As cGAMRegistryNode)
    Dim i As Integer
    Dim edi As Object
    Dim n As IXMLDOMElement, A As IXMLDOMAttribute
    Dim sn As cGAMRegistryNode
    Dim ret As Boolean

    Set edi = GetSettingsEditor(RegNode.NodeType)
    If Not edi Is Nothing Then ret = edi.DataToXML(RegNode, Node, DomDoc, Me)

    If Not ret Then
        For i = 1 To RegNode.SubElements.Count
            Set sn = RegNode.SubElements(i)
            Set n = DomDoc.createElement("node")
    
            Set A = DomDoc.createAttribute("name")
            A.Text = sn.NodeName
            n.Attributes.setNamedItem A
    
            Set A = DomDoc.createAttribute("type")
            A.Text = sn.NodeType
            n.Attributes.setNamedItem A
            Node.appendChild n
            AddXMLChildren DomDoc, n, RegNode.SubElements(i)
        Next i
    End If
End Function
