Attribute VB_Name = "mod_ctPackage"
' Modul for Visual Basic 6
' Copyright (C) 2003-2006 Jan Vorel

' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0

'#ctPackage_FlagA
'  (ctPackage_GetHeaderPos)
'   1 = ctPackage_GetFileCount
'   2 = ctPackage_GetFileList
'  10 = ctPackage_ExtractFilesPro
' 100 = ctPackage_GetRawFileDataContent
' 300 (100) = ctPackage_UseRawFileDataContent


Private Const FilenameOffset As Long = 14&
Private Const FilePosOffset As Long = 2&
Private Const FileIntOffset As Long = 6&
Private Const FileExtOffset As Long = 10&

'Public Const BinaryMoveFileData_DefaultBlockSize As Long = &H3FFF00
Public Const ctPackage_DefaultBlockSize As Long = &H3FFF00 ' BinaryMoveFileData_DefaultBlockSize
Public Const ctPackage_MinimumCompressDefault As Long = 95&
Public Const ctPackage_VersionInfo As String = "ctpA 1.04.00 2004/10/28"
Public Const ctPackage_Version As Single = 1



#If NoCompile Then
  'ctPackage_UseGetFileListEx
  Public Enum ctPackage_DisplayModes
    ctPackage_Display_0None = 0&
    ctPackage_Display_1Flags = 1&
    ctPackage_Display_2Accessparams = 2&
    ctPackage_Display_3AccessparamsFlags = 3&
    ctPackage_Display_4Details = 4&
    ctPackage_Display_5DetailsFlags = 5&
    ctPackage_Display_6DetailsAccessparams = 6&
    ctPackage_Display_7DetailsAccessparamsFlags = 7&
    End Enum
  #End If

Public Const ctPackageConst_GetFileList_PosFlag7 As Long = 1&
Public Const ctPackageConst_GetFileList_PosOffset7 As Long = 2&
Public Const ctPackageConst_GetFileList_PosIntSize7 As Long = 6&
Public Const ctPackageConst_GetFileList_PosExtSize7 As Long = 10&
Public Const ctPackageConst_GetFileList_PosFilename7 As Long = 14&

Public Const ctPackageConst_GetFileList_PWParams7 As Long = 13&
'Public Const ctPackageConst_GetFileList_PWFlag As Long = 1&


'Private sChar1 As String
'Private sChar2 As String
'Private sLong1 As Long
'Private sLong2 As Long

Private Const MinFileSize As Long = 26&
Private Const HeaderPreopenSize As Long = 12&
Private Const HeaderPosInfo As Long = 1&
Private Const HeaderPWInfo As Long = 4&
Public Const ctPackageConst_HeaderPosFileCount As Long = 5&
Public Const ctPackageConst_HeaderPosFileNames As Long = 9&
Public Const ctPackageConst_HeaderPosDataSize As Long = 13&
Public Const ctPackageConst_HeaderPWDataSize As Long = 4&

Public Const ctPackageConst_HeaderSize As Long = 16&
Public Const ctPackageConst_HeaderInfoText As String = "ctpA"
Public Const ctPackageConst_HeaderEmptyNullsWidth As Long = 12&

Public Const ctPackageConst_TOCWidth As Long = 13&
Public Const ctPackageConst_TOCPosFlags As Long = 1&
Public Const ctPackageConst_TOCPWFlags As Long = 1&
Public Const ctPackageConst_TOCPosFileNameSize As Long = 2&
Public Const ctPackageConst_TOCPosIntSize As Long = 6&
Public Const ctPackageConst_TOCPosExtSize As Long = 10&
Private Const TOCSizeHolderSmall As Long = 4&

Public Const ctPackageConst_TOCOverWriteExtSizePos As Long = 9&
Public Const ctPackageConst_TOCOverWriteExtSizePosRs As Long = 14&
Public Const ctPackageConst_TOCParamPosExtSize As Long = 10&
'Public Const ctPackageConst_TOCOverWriteExtSizePos As Long = 5&
'Public Const ctPackageConst_TOCOverWriteExtSizePosRs As Long = 10&
'Public Const ctPackageConst_TOCParamPosExtSize As Long = 6&

'Private Const TOCPWFirst As Long = 5& ''''4&?
'Private Const TOCPWFirstStart As Long = 0&
'Private Const TOCPWFirstSpace As Long = 4&
'Private Const TOCPWFirstWidth As Long = 0&
Public Const ctPackageConst_TOCPWSecondStart As Long = 2&
Public Const ctPackageConst_TOCPWSecondWidth As Long = 4&
Public Const ctPackageConst_TOCPosLast As Long = 10&
Public Const ctPackageConst_TOCSizeTotal As Long = 26& '(minfilesize)

Public Const ctPackageConst_EndSize As Long = 10&
Public Const ctPackageConst_EndSizeMinus As Long = 9&
Public Const ctPackageConst_EndSizeLeft As Long = 3&
Public Const ctPackageConst_EndSizeRight As Long = 3&
Public Const ctPackageConst_EndSizeStart As Long = 4&
Public Const ctPackageConst_EndSizeWidth As Long = 4&
Public Const ctPackageConst_EndSizeText As String = "eofctp"
Public Const ctPackageConst_EndSizeText1 As String = "eof"
Public Const ctPackageConst_EndSizeText2 As String = "ctp"

Public Function ctPackage_GetHeaderPos(ByVal FileID As Long) As Long
  Dim xLong1 As Long
  Dim xChar1 As String

  xChar1 = String(ctPackageConst_EndSize, vbNullChar)
  xLong1 = LOF(FileID)
  If xLong1 < MinFileSize Then
    ctPackage_GetHeaderPos = -1
    Else
    Get FileID, xLong1 - ctPackageConst_EndSizeMinus, xChar1
    If Left(xChar1, ctPackageConst_EndSizeLeft) & Right(xChar1, ctPackageConst_EndSizeRight) = ctPackageConst_EndSizeText Then
      ctPackage_GetHeaderPos = LenCharToLong(xChar1, ctPackageConst_EndSizeStart)
      xChar1 = String(HeaderPWInfo, vbNullChar)
      Get FileID, ctPackage_GetHeaderPos + 1&, xChar1
      If Not xChar1 = ctPackageConst_HeaderInfoText Then
        ctPackage_GetHeaderPos = -1
        End If
      Else
      ctPackage_GetHeaderPos = -1&
      End If
    End If
  End Function

#If (ctPackage_FlagA And &H1&) = &H1& Then
  Public Function ctPackage_GetFileCount(ByVal FileID As Long, ByVal HeaderPos As Long) As Long
    Dim xChar1 As String

    If Not HeaderPos = -1& Then
      xChar1 = String(4&, vbNullChar)
      Get FileID, HeaderPos + ctPackageConst_HeaderPosFileCount, xChar1
      ctPackage_GetFileCount = LenCharToLong(xChar1)
      End If
    End Function
  #End If

#If (ctPackage_FlagA And &H2&) = &H2& Then
  Public Function ctPackage_GetFileList(ByVal FileID As Long, ByVal HeaderPos As Long, ByRef FileArray() As String, ByVal FileArraySize As Long, Optional ByRef UncompressedSize As Long, Optional ByVal IndexStep As Long = 1&, Optional ByVal IndexStart As Long = 0&) As Long
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xChar1 As String
    Dim xChar2 As String
    'Dim IndexStart As Long
    Dim xDataPos As Long

    If HeaderPos = -1& Then
      ctPackage_GetFileList = -1&
      Else
      xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
      Get FileID, HeaderPos + 1&, xChar1
      ctPackage_GetFileList = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount)
      xLong1 = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileNames)
      xChar1 = String(ctPackage_GetFileList * ctPackageConst_TOCWidth, vbNullChar)
      xChar2 = String(xLong1, vbNullChar)
      Get FileID, HeaderPos + ctPackageConst_HeaderSize + 1&, xChar1
      xDataPos = HeaderPos + ctPackageConst_HeaderSize + ctPackage_GetFileList * ctPackageConst_TOCWidth + xLong1
      Get FileID, , xChar2
      If ctPackage_GetFileList > FileArraySize Then ctPackage_GetFileList = FileArraySize
      'UncompressedSize = 0&
      For xLong1 = 0& To ctPackage_GetFileList - 1&
        xLong2 = LenCharToLong(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosFileNameSize)
        
'        FileArray(IndexStart) = Mid(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosFlags, ctPackageConst_TOCPWFlags) & _
                                LenLongToChar(xDataPos) & FileArray(IndexStart) & _
                                Mid(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosIntSize, 4& + 4&) & _
                                Left(xChar2, xLong2)
        
        FileArray(IndexStart) = Mid(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosFlags, ctPackageConst_TOCPWFlags) & _
                                LenLongToChar(xDataPos) & _
                                Mid(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosIntSize, 4& + 4&) & _
                                Left(xChar2, xLong2)
        xDataPos = xDataPos + LenCharToLong(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosIntSize)
        UncompressedSize = UncompressedSize + LenCharToLong(xChar1, xLong1 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosExtSize)
        
        xChar2 = Mid(xChar2, xLong2 + 1&)
        IndexStart = IndexStart + IndexStep
        Next
      End If
    End Function
  #End If

#If (ctPackage_FlagA And &H100&) = &H100& Then
  Public Function ctPackage_GetRawFileDataContent(ByVal FileID As Long, ByVal IntExtFilesData As String) As String
    ctPackage_GetRawFileDataContent = String(LenCharToLong(IntExtFilesData, FileIntOffset), vbNullChar)
    Get FileID, LenCharToLong(IntExtFilesData, FilePosOffset) + 1&, ctPackage_GetRawFileDataContent
    ctPackage_GetRawFileDataContent = Left(IntExtFilesData, 1&) & String(4&, vbNullChar) & Mid(IntExtFilesData, 6&, 8&) & ctPackage_GetRawFileDataContent
    End Function
  #End If

#If (ctPackage_FlagA And &H300&) = &H300& Then
  Public Function ctPackage_UseRawFileDataContent(ByVal RawDataContent As String, Optional ByRef ReturnSize As Long, Optional ByVal ProgressControl As Long = 0&, Optional ByVal ProgressStart As Long = 0&, Optional ByVal ProgressTotal As Long = 0&, Optional ByVal ProgressQueue As Long = 0&) As String
'Stop
    ReturnSize = Asc(Left(RawDataContent, 1&))
    'Exit Function
    ctPackage_UseRawFileDataContent = Mid(RawDataContent, 14&)
    If (ReturnSize And 1&) = 1& Then
      'ctCompressA_Abort = False
'Stop
      ctPackage_UseRawFileDataContent = ctCompressA_Decompress(ctPackage_UseRawFileDataContent, LenCharToLong(RawDataContent, 10&), AddressOf NewDecomProgCallback, ProgressControl, ProgressStart, ProgressTotal, ProgressQueue) ', ReturnSize)
      End If
    ReturnSize = LenCharToLong(RawDataContent, FileExtOffset)
    End Function
  #End If







#If (ctPackage_FlagA And &H10&) = &H10& Then
  Public Function ctPackage_ExtractFilesPro(ByVal FileID As Long, ByVal HeaderPos As Long, ByRef FilesArray() As String, ByVal FileArraySize As Long, Optional ByVal FileAccessFileID As Long = -1, Optional BasePath As String = vbNullChar, Optional ByVal ProgressControl As Long = 0&) As Long
    Dim xFilenamesSize As Long
    Dim xFileNames As String
    Dim xTOC As String
    Dim xDataPos As Long
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong3 As Long
    Dim xLong4 As Long
    Dim xLong5 As Long
    Dim xLong6 As Long
    Dim xChar1 As String
    Dim xChar2 As String
    Dim xSizes(65535) As Long
    
    If FileAccessFileID = -1& Or FileAccessFileID = FileID Then
      FileAccessFileID = FreeFile
      End If
    
    xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
    Get FileID, HeaderPos + 1&, xChar1
    xLong3 = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount)
    
    If xLong3 > FileArraySize Then
      xLong3 = FileArraySize
      End If
    
    If Not (xLong3 = 0&) Then
      If Not (BasePath = "" Or BasePath = vbNullChar Or Right(BasePath, 1) = "\") Then
        BasePath = BasePath & "\"
        End If
      xFilenamesSize = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileNames)
    ''''''  xLong6 = LenCharToLong(xChar1, ctPackageConst_HeaderPosDataSize, ctPackageConst_HeaderPWDataSize)
    
      xDataPos = HeaderPos + ctPackageConst_HeaderSize + xLong3 * ctPackageConst_TOCWidth + xFilenamesSize '''+ 1&
      xTOC = String(xLong3 * ctPackageConst_TOCWidth, vbNullChar)
      xFileNames = String(xFilenamesSize, vbNullChar)
      Get FileID, HeaderPos + ctPackageConst_HeaderSize + 1&, xTOC
      Get FileID, , xFileNames
        
      For xLong1 = 0& To xLong3 - 1&
        xLong2 = LenCharToLong(xTOC, xLong1& * ctPackageConst_TOCWidth + ctPackageConst_TOCPosIntSize)
        If Not FilesArray(xLong1) = "" Then
          xSizes(xLong1) = xDataPos
          xLong6 = xLong6 + xLong2
          End If
        xDataPos = xDataPos + xLong2
        Next
      xDataPos = 0&
    '  If Not xLong6 = 0& Then
        For xLong1 = 0& To xLong3 - 1&
          xLong3 = LenCharToLong(xTOC, xLong1& * ctPackageConst_TOCWidth + ctPackageConst_TOCPosFileNameSize)
          xLong2 = LenCharToLong(xTOC, xLong1& * ctPackageConst_TOCWidth + ctPackageConst_TOCPosIntSize)
          
     '         Debug.Print xLong1
          
          If Not FilesArray(xLong1) = "" Then
            'xLong2 = LenCharToLong(xTOC, xLong1& * ctPackageConst_TOCWidth + TOCPosIntSize, TOCPWIntSize)
            If FilesArray(xLong1) = vbNullChar Then
              xChar2 = Left(xFileNames, xLong3)
              Else
              xChar2 = FilesArray(xLong1)
              End If
            
            xLong4 = LenCharToLong(xTOC, xLong1& * ctPackageConst_TOCWidth + ctPackageConst_TOCPosExtSize)
            xLong5 = Asc(Mid(xTOC, xLong1& * ctPackageConst_TOCWidth + ctPackageConst_TOCPosFlags, ctPackageConst_TOCPWFlags))
            If xLong5 = 0& And Not BasePath = vbNullChar Then
              xChar2 = BasePath & xChar2
              Call CreateMyPath(xChar2)
              Close FileAccessFileID
              Open xChar2 For Output As FileAccessFileID
              Close FileAccessFileID
              Open xChar2 For Binary Lock Write As FileAccessFileID
              
              BinaryMoveFileDataEx FileID, xLong2, xSizes(xLong1), 0&, FileAccessFileID, BinaryMoveFileData_NullstringNew, ctPackage_DefaultBlockSize, ProgressControl, xDataPos, xLong6
              '''''-1&
              Else
              xChar1 = String(xLong2, vbNullChar)
              ''Get FileID, xDataPos, xChar2
              Get FileID, xSizes(xLong1) + 1&, xChar1
'              #If ctPackage_UseCoding Then
'                If (xLong5 And 2&) = 2& Then
'                  xChar1 = ctCoding7_Decode(xChar1, Password, Code7Flags)
'                  End If
'                #End If
              If (xLong5 And 1&) = 1& Then
'Stop
                xChar1 = ctCompressA_Decompress(xChar1, LenCharToLong(xTOC, 10&)) ', xLong4)
                End If
              If Len(xChar1) = xLong4 Then
                If BasePath = vbNullChar Then
                  FilesArray(xLong1) = xChar1
                  Else
                  If Not BasePath = vbNullChar Then
                    xChar2 = BasePath & xChar2
                    Call CreateMyPath(xChar2)
                    Close FileAccessFileID
                    Open xChar2 For Output As FileAccessFileID
                    Close FileAccessFileID
                    Open xChar2 For Binary Lock Write As FileAccessFileID
                    End If
                  Put FileAccessFileID, 1&, xChar1
                  End If
                End If
              End If
            
            If Not (ProgressControl = 0& Or xLong6 = 0&) Then
              ctProgressB_SetValue ProgressControl, (xDataPos + xLong2) / xLong6
              End If
            ctPackage_ExtractFilesPro = ctPackage_ExtractFilesPro + 1&
            xDataPos = xDataPos + xLong2
            End If
          xFileNames = Mid(xFileNames, xLong3 + 1&)
          Next
    '    End If
      End If
    Close FileAccessFileID
    End Function
  
  Private Sub CreateMyPath(ByVal PathAndFilename As String)
    Dim xLong1 As Long
    
    xLong1 = InStrRev(PathAndFilename, "\") - 1&
    If Not xLong1 = -1& Then
      Call MkDirEx(Left(PathAndFilename, xLong1))
      End If
    End Sub
  #End If


