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


Private m_strFileName As String
Private m_strPassword As String

Private iFileNum As Integer ' Nummer der Dateihandle.
Private tFileHeader As tPakHeader

Private bFileOpen As Boolean

Private m_oRootFolder As cRPakFolder

Private m_bChangedFlag As Boolean

Public ErrDesc As String
Public ErrSource As String

Public Sub SetChangedFlag()
m_bChangedFlag = True
End Sub

Public Property Get ChangedFlag() As Boolean
ChangedFlag = m_bChangedFlag
End Property

Public Property Get FileName() As String
FileName = m_strFileName
End Property

Public Property Get FileNum() As Integer
FileNum = iFileNum
End Property

Public Function FileNew(FileName As String, Password As String) As Boolean
On Error GoTo fehler:


tFileHeader.PasswordLength = Len(Password)
tFileHeader.Password = Password & GenerateRandomString(255 - Len(Password))
tFileHeader.Version = cPakVersion
tFileHeader.Identifier = "RPAK"
tFileHeader.A_HunkAJunk = GenerateRandomString(123)
tFileHeader.Another_HunkAJunk = GenerateRandomString(35)


Set m_oRootFolder = New cRPakFolder
Set m_oRootFolder.MyArchive = Me

m_strPassword = Password
m_strFileName = FileName

FileNew = FileSave(FileName)



Exit Function
fehler:
FileNew = False

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

End Function

Public Function FileOpen(FileName As String, Optional Password As String = "", Optional OverridePassword As Boolean = False) As Boolean

On Error GoTo fehler:

iFileNum = FreeFile 'Freie Dateihandle erzeugen.

If Dir(FileName) = "" Then Err.Raise 10000, "PAK Engine: FileOpen", "The file does not exist."

Open FileName For Binary Access Read As iFileNum
Get #iFileNum, , tFileHeader

If Not tFileHeader.Identifier = "RPAK" Then FileOpen = False: FileClose: Err.Raise 10001, "PAK Engine: FileOpen", "The file is not a valid R-PG Pak File!"
If Not tFileHeader.Version = cPakVersion Then FileOpen = False: FileClose: Err.Raise 10002, "PAK Engine: FileOpen", "The file uses a wrong version number (is: " & tFileHeader.Version & ", should be: " & cPakVersion & ")!"


CodeString tFileHeader.Password, cPakPassword

If Not (Password = Left(tFileHeader.Password, tFileHeader.PasswordLength) Or OverridePassword) Then FileOpen = False: FileClose: Err.Raise 10003, "PAK Engine: FileOpen", "Invalid password."

Set m_oRootFolder = New cRPakFolder
Set m_oRootFolder.MyArchive = Me
 m_oRootFolder.FileOpen


bFileOpen = True

m_strFileName = FileName
m_strPassword = Left(tFileHeader.Password, tFileHeader.PasswordLength)

'm_strPassword = tFileHeader.Password



FileClose

m_bChangedFlag = False

FileOpen = True

Exit Function
fehler:



FileOpen = False
ErrDesc = Err.Description
ErrSource = Err.Source
Exit Function
End Function




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

iFileNum = FreeFile

If Not Dir(FileName) = "" Then Kill FileName
Open FileName For Binary Access Write As iFileNum

CodeString tFileHeader.Password, cPakPassword
Put #1, , tFileHeader
CodeString tFileHeader.Password, cPakPassword

FileSave = m_oRootFolder.FileSave
FileClose

m_strFileName = FileName

m_bChangedFlag = False


Exit Function
fehler:
FileSave = False

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

Private Function FileClose() As Boolean
Close iFileNum
iFileNum = 0
bFileOpen = False
FileClose = True
End Function

Public Property Get Password() As String
    Password = m_strPassword
End Property

Public Property Let Password(vNew As String)
    Root.ChangePassword vNew
    
    m_strPassword = vNew
    tFileHeader.Password = vNew & GenerateRandomString(255 - Len(vNew))
    tFileHeader.PasswordLength = Len(vNew)
    
    m_bChangedFlag = True
End Property


Public Property Get Root() As cRPakFolder
Set Root = m_oRootFolder
End Property
