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

Public MyArchive As cRPakArchive
Public MyParent As cRPakFolder


Private m_sFolderName As String

Private m_iFileCount As Integer
Private m_iFolderCount As Integer

Private m_aFiles() As tPakFile
Private m_aFolders() As cRPakFolder

Public Property Get FolderName() As String
    FolderName = m_sFolderName
End Property


Public Property Let FolderName(vNew As String)
MyArchive.SetChangedFlag
    m_sFolderName = vNew
End Property

Public Property Get IsRoot() As Boolean
IsRoot = (MyParent Is Nothing)
End Property


Public Function FileNew() As Boolean
FileSave
End Function

Public Function FileOpen() As Boolean
Dim FileNum As Integer
FileNum = MyArchive.FileNum

Dim tInt As Integer, tLng As Long

Get #FileNum, , tInt
m_sFolderName = String(tInt, Chr(0))
Get #1, , m_sFolderName


Get #FileNum, , m_iFileCount

Dim i As Integer

If m_iFileCount > 0 Then ReDim m_aFiles(0 To m_iFileCount - 1)

For i = 0 To m_iFileCount - 1
    Get #FileNum, , tInt: m_aFiles(i).FileName = String(tInt, Chr(0))
    Get #FileNum, , m_aFiles(i).FileName
    Get #FileNum, , m_aFiles(i).FileSize
    Get #FileNum, , m_aFiles(i).Flags
    
    Get #FileNum, , tLng: m_aFiles(i).FileContent = String(tLng, Chr(0))
    Get #FileNum, , m_aFiles(i).FileContent
Next i

Get #FileNum, , m_iFolderCount


If m_iFolderCount > 0 Then ReDim m_aFolders(0 To m_iFolderCount - 1)

For i = 0 To m_iFolderCount - 1
    Set m_aFolders(i) = New cRPakFolder
    Set m_aFolders(i).MyParent = Me
    Set m_aFolders(i).MyArchive = MyArchive
    m_aFolders(i).FileOpen
Next i



End Function

Public Function FileSave() As Boolean
On Error GoTo fehler:

Dim FileNum As Integer
FileNum = MyArchive.FileNum

Put #FileNum, , CInt(Len(m_sFolderName))
Put #FileNum, , m_sFolderName

Put #FileNum, , m_iFileCount
Dim i As Integer
For i = 0 To m_iFileCount - 1
    Put #FileNum, , CInt(Len(m_aFiles(i).FileName))
    Put #FileNum, , m_aFiles(i).FileName
    Put #FileNum, , m_aFiles(i).FileSize
    Put #FileNum, , m_aFiles(i).Flags
    
    Put #FileNum, , CLng(Len(m_aFiles(i).FileContent))
    Put #FileNum, , m_aFiles(i).FileContent
Next i

Put #FileNum, , m_iFolderCount

Dim Ok As Boolean
Ok = True

For i = 0 To m_iFolderCount - 1
    Ok = Ok And m_aFolders(i).FileSave 'xtreme recursion :D
    If Not Ok Then Exit For
Next i

FileSave = Ok

Exit Function
fehler:
FileSave = False

MyArchive.ErrDesc = Err.Description
MyArchive.ErrSource = Err.Source
Exit Function
End Function

Public Function DoesExist(PathToFile As String) As Boolean

If InStr(1, PathToFile, "\") > 0 Then
    Dim SubFolder As String, Pos As Integer, RestOfPath As String
    
    Pos = InStr(1, PathToFile, "\")
    SubFolder = Left(PathToFile, Pos - 1)
    RestOfPath = Mid(PathToFile, Pos + 1)
    
    Dim subfldrID As Integer
    subfldrID = FindFolder(SubFolder)
    
    If subfldrID = -1 Then DoesExist = False: Exit Function
    
    DoesExist = m_aFolders(subfldrID).DoesExist(RestOfPath)
    
Else
    Dim FileID As Integer
    FileID = FindFile(PathToFile)
    
    If FileID = -1 Then DoesExist = False: Exit Function
    
    DoesExist = True
End If
End Function

Public Function GetContent(PathToFile As String) As String

If InStr(1, PathToFile, "\") > 0 Then
    Dim SubFolder As String, Pos As Integer, RestOfPath As String
    
    Pos = InStr(1, PathToFile, "\")
    SubFolder = Left(PathToFile, Pos - 1)
    RestOfPath = Mid(PathToFile, Pos + 1)
    
    Dim subfldrID As Integer
    subfldrID = FindFolder(SubFolder)
    
    If subfldrID = -1 Then Err.Raise 10011, "PAK Engine: GetContent", "Folder not found: '" & SubFolder & "'"
    
    GetContent = m_aFolders(subfldrID).GetContent(RestOfPath)
    
Else
    Dim FileID As Integer
    FileID = FindFile(PathToFile)
    
    If FileID = -1 Then Err.Raise 10012, "PAK Engine: GetContent", "File not found: '" & PathToFile & "'"
    
    GetContent = FileContent(FileID)
End If

End Function

Public Function GetFolder(PathToFolder As String) As cRPakFolder
If PathToFolder = "" Then Set GetFolder = Me: Exit Function

If InStr(1, PathToFolder, "\") > 0 Then
    Dim SubFolder As String, Pos As Integer, RestOfPath As String
    
    Pos = InStr(1, PathToFolder, "\")
    SubFolder = Left(PathToFolder, Pos - 1)
    RestOfPath = Mid(PathToFolder, Pos + 1)
    
    Dim subfldrID As Integer
    subfldrID = FindFolder(SubFolder)
    
    If subfldrID = -1 Then Err.Raise 10011, "PAK Engine: GetContent", "Folder not found: '" & SubFolder & "'"
    
    Set GetFolder = m_aFolders(subfldrID).GetFolder(RestOfPath)
    
Else
    Dim FolderID As Integer
    FolderID = FindFolder(PathToFolder)
    
    If FolderID = -1 Then Err.Raise 10012, "PAK Engine: GetContent", "Folder not found: '" & PathToFolder & "'"
    
    Set GetFolder = m_aFolders(FolderID)
End If

End Function

Public Function FindFile(FileName As String) As Integer
Dim i As Integer
For i = 0 To m_iFileCount - 1
If LCase(m_aFiles(i).FileName) = LCase(FileName) Then FindFile = i: Exit Function
Next i
FindFile = -1
End Function

Public Function FindFolder(FolderName As String) As Integer
Dim i As Integer
For i = 0 To m_iFolderCount - 1
If LCase(m_aFolders(i).FolderName) = LCase(FolderName) Then FindFolder = i: Exit Function
Next i
FindFolder = -1
End Function

Public Property Get FileContent(FileID As Integer) As String
Dim s As String
Dim FN As String
FN = m_aFiles(FileID).FileName
s = m_aFiles(FileID).FileContent
ZLib.DecompressString s, m_aFiles(FileID).FileSize
CodeString s, MyArchive.Password
FileContent = s
End Property

Public Property Let FileContent(FileID As Integer, ByVal NewValue As String)
MyArchive.SetChangedFlag
Dim s As String
s = NewValue
m_aFiles(FileID).FileSize = Len(s)
CodeString s, MyArchive.Password
ZLib.CompressString s
m_aFiles(FileID).FileContent = s
End Property

Public Property Get FileName(FileID As Integer) As String
FileName = m_aFiles(FileID).FileName
End Property

Public Property Let FileName(FileID As Integer, NewValue As String)
MyArchive.SetChangedFlag
m_aFiles(FileID).FileName = NewValue
End Property

Public Property Get FileSize(FileID As Integer) As Long
FileSize = m_aFiles(FileID).FileSize
End Property

Public Property Let FileSize(FileID As Integer, NewValue As Long)
MyArchive.SetChangedFlag
m_aFiles(FileID).FileSize = NewValue
End Property

Public Property Get Flags(FileID As Integer) As Long
Flags = m_aFiles(FileID).Flags
End Property

Public Property Let Flags(FileID As Integer, NewValue As Long)
MyArchive.SetChangedFlag
m_aFiles(FileID).Flags = NewValue
End Property

Public Property Get FileCount() As Long
FileCount = m_iFileCount
End Property

Public Property Get FolderCount() As Long
FolderCount = m_iFolderCount
End Property

Public Property Get Folders(FolderID As Integer) As cRPakFolder
Set Folders = m_aFolders(FolderID)
End Property

Public Function AddFolder(FolderName As String) As cRPakFolder
Dim nf As New cRPakFolder
MyArchive.SetChangedFlag


Set nf.MyArchive = MyArchive
Set nf.MyParent = Me

nf.FolderName = FolderName


ReDim Preserve m_aFolders(0 To m_iFolderCount) As cRPakFolder
Set m_aFolders(m_iFolderCount) = nf

m_iFolderCount = m_iFolderCount + 1

Set AddFolder = nf
End Function

Public Function AddFile(FileName As String, Content As String) As Boolean

If FindFile(FileName) >= 0 Then
    MyArchive.ErrDesc = "File already exists, cannot add: '" & FileName & "'"
    MyArchive.ErrSource = "cRPakFolder.AddFile"
    AddFile = False
    Exit Function
End If

MyArchive.SetChangedFlag
ReDim Preserve m_aFiles(0 To m_iFileCount) As tPakFile

With m_aFiles(m_iFileCount)
    .FileName = FileName
    .FileSize = Len(Content)
    
    FileContent(m_iFileCount) = Content
End With

m_iFileCount = m_iFileCount + 1

AddFile = True

MyArchive.SetChangedFlag
End Function

Public Function DeleteFile(FileID As Integer) As Boolean
On Error GoTo fehler
MyArchive.SetChangedFlag

m_iFileCount = m_iFileCount - 1

Dim i As Integer
For i = FileID To m_iFileCount - 1
m_aFiles(i) = m_aFiles(i + 1)
Next i

If m_iFileCount > 0 Then ReDim Preserve m_aFiles(0 To m_iFileCount - 1)

DeleteFile = True
Exit Function
fehler:
DeleteFile = False

MyArchive.ErrDesc = Err.Description
MyArchive.ErrSource = Err.Source
Exit Function
End Function


Public Function DeleteFolder(FolderID As Integer) As Boolean
On Error GoTo fehler
MyArchive.SetChangedFlag

m_iFolderCount = m_iFolderCount - 1

Dim i As Integer
For i = FolderID To m_iFolderCount - 1
Set m_aFolders(i) = m_aFolders(i + 1)
Next i

If m_iFolderCount > 0 Then ReDim Preserve m_aFolders(0 To m_iFolderCount - 1)



DeleteFolder = True
Exit Function
fehler:
DeleteFolder = False

MyArchive.ErrDesc = Err.Description
MyArchive.ErrSource = Err.Source
Exit Function
End Function


Public Function ChangePassword(NewPassword As String)
Dim i As Integer
Dim s As String
        
For i = 0 To m_iFileCount - 1
    s = m_aFiles(i).FileContent
    ZLib.DecompressString s, m_aFiles(i).FileSize
    CodeString s, MyArchive.Password
    CodeString s, NewPassword
    ZLib.CompressString s
    m_aFiles(i).FileContent = s
Next i

For i = 0 To m_iFolderCount - 1
    m_aFolders(i).ChangePassword NewPassword
Next i
End Function


