Attribute VB_Name = "mod_ctPackage_Update"
' 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

' ####################################################################################
' ####################################################################################
' ####################################################################################
' ####################################################################################
' ####################################################################################
' ####################################################################################
' Do not optimize too much using compiler constants... this is designed for editing
' programs, not 'end-user' products.
' ####################################################################################
' ####################################################################################
' ####################################################################################
' ####################################################################################
' ####################################################################################

Option Explicit
Option Base 0



' *3+0: <""> , adds directmemory internally (alreadypacked)
'       <0!byte> < ExtData >   if first=0!, add direct memory data
'       otherwise, the file to import
' *3+1: valid internal filename
' *3+2: internalsizedata when using directmemoryadding <IntData>
'           1xFlags pushes (copies) data directly, required if copying from package to package
'           1xFlag 4xPos 4xIntSize 4xExtSize as given with filelist-function
'       DO NOT copy from/to the same archive
'       or
'           1xFlags pushes (copies) data directly, required if copying from memory (packagedata!!!) to package
'           1xFlag 0000 4xIntSize 4xExtSize <InternalPackageData>
' MinimumCompress >100 => will always use compressed version, even if > 100%

'#ctPackage_Update_FlagA
'   1       = Reserved ctPackage_InternalUsage_EmptyHeader (Update, create, erase)
'   3   (2) = ctPackage_Update
'  11  (10) = ctPackage_Update_Create
'  21  (20) = ctPackage_Update_ErasePackage
'  40       = ctPackage_Update_ClearWaste
'  C0  (80) = ctPackage_Update_DestroyPackage (requires 40)
' 103 (100) = ctPackage_Update_AttacheFilesWrapper
' 203 (200) = ctPackage_Update_DeleteFilesProWrapper
' 403 (400) = ctPackage_Update_MergePackagesWrapper
'1000       = ctPackage_Update_CreateRawFileDataContent










#If (ctPackage_Update_FlagA And &H2&) = &H2& Then
  Public Enum ctPackage_IfExistsModes
    ctPackage_Exists_NoCheck = 0&
    ctPackage_Exists_Break = 1&
    ctPackage_Exists_Update = 2&
    ctPackage_Exists_Skip = 3&
    ctPackage_Exists_ExceptionError1 = 4&
    ctPackage_Exists_ExceptionStop = 5&
    ctPackage_Exists_ExceptionEnd = 6&
    ctPackage_Exists_ExceptionCrash = 7&
    End Enum
  Public Enum ctPackage_DoubleNewFilesModes
    ctPackage_DoubleNewFiles_NoCheck = 0&
    ctPackage_DoubleNewFiles_Break = 1&
    ctPackage_DoubleNewFiles_SkipFirst = 2&
    ctPackage_DoubleNewFiles_SkipLast = 3&
    ctPackage_DoubleNewFiles_ExceptionError1 = 4&
    ctPackage_DoubleNewFiles_ExceptionStop = 5&
    ctPackage_DoubleNewFiles_ExceptionEnd = 6&
    ctPackage_DoubleNewFiles_ExceptionCrash = 7&
    End Enum
  #End If


#If (ctPackage_Update_FlagA And &H1&) = &H1& Then
  Private Function ctPackage_InternalUsage_EmptyHeader() As String
    ctPackage_InternalUsage_EmptyHeader = ctPackageConst_HeaderInfoText & String(ctPackageConst_HeaderEmptyNullsWidth, vbNullChar)
    End Function
  #End If

#If (ctPackage_Update_FlagA And &H3&) = &H3& Then
  Public Function ctPackage_Update( _
    ByVal FileID As Long, ByVal HeaderPos As Long, _
    ByRef FilesExternInternOffsetArray() As String, _
    ByVal FileArrayCount As Long, _
    Optional ByVal DelFileOrNotByteStream As String, _
    Optional ByVal CanCompress As Boolean = True, _
    Optional ByVal BreakIfFileAccessError As Boolean = False, _
    Optional ByVal FileAccessFileID As Long = -1&, _
    Optional ByVal FileExistsHandling As ctPackage_IfExistsModes = ctPackage_Exists_Break, _
    Optional ByVal Reserved_DoubleAttacheFilesHandling As ctPackage_DoubleNewFilesModes = ctPackage_DoubleNewFiles_Break, _
    Optional ByVal NoClearWaste As Boolean = False, _
    Optional ByVal OutFileID As Long = -1&, _
    Optional ByVal OutHeaderPos As Long = -1&, _
    Optional ByVal MinimumCompress As Long = ctPackage_MinimumCompressDefault, _
    Optional ByVal ProgressControl As Long = 0&) As Long



    Dim xFilenamesSize As Long
    Dim xFileNames As String
    Dim xDataSize As Long
    Dim xOldDataSize As Long
    Dim xTOC As String
    Dim xTOCNew As String
    Dim xDataPos As Long
    Dim xNewDataPos As Long
    Dim xLong3 As Long
    Dim xFileCount As Long
    Dim xLongA1(65535) As Long
    Dim xLongA2(65535) As Long
    'Dim xRemove As Long
    Dim xNewFlag As Long
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong4 As Long
    Dim xLong6 As Long
    Dim xChar1 As String
    Dim xChar2 As String
    
    
    Dim xLong5 As Long
    Dim xProgress1 As Long
    Dim xProgress2 As Long
    
'    Stop
    If FileAccessFileID = -1& Or FileAccessFileID = FileID Then
      FileAccessFileID = FreeFile
      End If
    
    If OutFileID = -1& Or OutHeaderPos = -1& Then
      OutFileID = FileID
      OutHeaderPos = HeaderPos
      End If
    
    Close FileAccessFileID
    On Error GoTo Er1
    
    For xLong1 = FileArrayCount - 1& To 0& Step -1&
      If FilesExternInternOffsetArray(xLong1 * 3 + 2&) = "" Then
        If Left(FilesExternInternOffsetArray(xLong1 * 3&), 1&) = vbNullChar Then
          xLongA2(xLong1) = Len(FilesExternInternOffsetArray(xLong1 * 3&)) - 1&
          Else
          If (GetAttr(FilesExternInternOffsetArray(xLong1 * 3&)) Mod 32&) \ 16& = 1& Then
            Error 1
            Else
            Open FilesExternInternOffsetArray(xLong1 * 3&) For Input As FileAccessFileID
            Close FileAccessFileID
            Open FilesExternInternOffsetArray(xLong1 * 3&) For Binary Access Read As FileAccessFileID
            xLongA2(xLong1) = LOF(FileAccessFileID)
            Close FileAccessFileID
            End If
          End If
        Else
        'xLongA2(xLong1) = LenCharToLong(FilesExternInternOffsetArray(xLong1 * 3 + 2&), 10&)
        xLongA2(xLong1) = LenCharToLong(FilesExternInternOffsetArray(xLong1 * 3 + 2&), ctPackageConst_GetFileList_PosIntSize7)
        'If Not xLongA2(xLong1) + 13& = Len(FilesExternInternOffsetArray(xLong1 * 3& + 2&)) Then Stop
        End If
Rs1:
      Next
    
    '''xLongA2(xLong1) = LenCharToLong(FilesExternInternOffsetArray(xLong1 * 3 + 1&), ctPackageConst_GetFileList_PosIntSize7)
    If CanCompress Then xNewFlag = 1&
    
    On Error GoTo 0
    xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
    Get FileID, HeaderPos + 1&, xChar1
    ctPackage_Update = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount)
    xFilenamesSize = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileNames)
    xOldDataSize = LenCharToLong(xChar1, ctPackageConst_HeaderPosDataSize)
    
    
    'xDataPos = HeaderPos + ctPackageConst_HeaderSize + ctPackage_Update * ctPackageConst_TOCWidth + xFilenamesSize
    xTOC = String(ctPackage_Update * ctPackageConst_TOCWidth, vbNullChar)
    xFileNames = String(xFilenamesSize, vbNullChar)
    Get FileID, HeaderPos + ctPackageConst_HeaderSize + 1, xTOC
    Get FileID, , xFileNames
    
    xDataPos = HeaderPos + ctPackageConst_HeaderSize + ctPackage_Update * ctPackageConst_TOCWidth + xFilenamesSize
    xLong5 = xDataPos
    
'    Stop
    'If Not (FileExistsHandling = ctPackage_Exists_NoCheck Or ctPackage_Update = 0&) And DelFileOrNotByteStream = String(Len(DelFileOrNotByteStream), vbNullChar) Then
    If Not ctPackage_Update = 0& Then
      xChar1 = xFileNames
      xFileNames = ""
    
      
      For xLong2 = 0& To ctPackage_Update - 1&
        
        xLong3 = LenCharToLong(xTOC, xLong2 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosFileNameSize)
        xLong4 = LenCharToLong(xTOC, xLong2 * ctPackageConst_TOCWidth + ctPackageConst_TOCPosIntSize)
        xChar2 = UCase(Left(xChar1, xLong3))
        
        If Mid(DelFileOrNotByteStream, xLong2 + 1&, 1&) = Chr(1) Then
          xChar2 = vbNullChar
          Else
        
        
        
          For xLong1 = 0& To FileArrayCount - 1&
            If UCase(FilesExternInternOffsetArray(xLong1 * 3& + 1&)) = xChar2 Then
              Select Case FileExistsHandling
                Case ctPackage_Exists_Break
                  Exit Function
                Case ctPackage_Exists_Update
                  xChar2 = vbNullChar
                Case ctPackage_Exists_Skip
                  For xLong6 = xLong1 * 3& To FileArrayCount * 3& - 4&
                    FilesExternInternOffsetArray(xLong6) = FilesExternInternOffsetArray(xLong6 + 3&)
                    Next
                  For xLong6 = xLong1 To FileArrayCount - 2&
                    xLongA2(xLong6) = xLongA2(xLong6 + 1&)
                    Next
                  FileArrayCount = FileArrayCount - 1&
                Case ctPackage_Exists_ExceptionError1
                  Error 1
                  Exit Function
                Case ctPackage_Exists_ExceptionStop
                  Stop
                Case ctPackage_Exists_ExceptionEnd
                  End
                Case ctPackage_Exists_ExceptionCrash
                  Stop
                  Stop
                  Stop
                End Select
              End If
            Next
          End If
        
'        Stop
        If xChar2 = vbNullChar Then
          ctPackage_Update = ctPackage_Update - 1&
          Else
          xDataSize = xDataSize + xLong4
          xFileNames = xFileNames & Left(xChar1, xLong3)
          xTOCNew = xTOCNew + Mid(xTOC, xLong2 * ctPackageConst_TOCWidth + 1&, ctPackageConst_TOCWidth)
          If xFileCount = 0& Then
            xLongA1(xFileCount * 2&) = xDataPos
            xLongA1(xFileCount * 2& + 1&) = xLong4
            xFileCount = xFileCount + 1&
            Else
            If xLongA1(xFileCount * 2& - 2&) + xLongA1(xFileCount * 2& - 1&) = xDataPos Then
              xLongA1(xFileCount * 2& - 1&) = xLongA1(xFileCount * 2& - 1&) + xLong4
              Else
              xLongA1(xFileCount * 2&) = xDataPos
              xLongA1(xFileCount * 2& + 1&) = xLong4
              xFileCount = xFileCount + 1&
              End If
            End If
          End If
        xChar1 = Mid(xChar1, xLong3 + 1)
        xDataPos = xDataPos + xLong4
        Next
      End If
    
'    Stop
    xLong2 = xDataSize
    '''''''''xDataSize = xDataSize + xLongA2(xLong1)
    For xLong1 = 0& To FileArrayCount - 1&
      ''''''xDataSize = xDataSize + xLongA2(xLong1)
      xLong2 = xLong2 + xLongA2(xLong1)
      xTOCNew = xTOCNew & vbNullChar & LenLongToChar(Len(FilesExternInternOffsetArray(xLong1 * 3& + 1&))) & _
                String(4&, vbNullChar) & _
                LenLongToChar(xLongA2(xLong1))
      xFileNames = xFileNames & FilesExternInternOffsetArray(xLong1 * 3& + 1&)
      Next
    '''xNewFileCount = ctPackage_update + FileArrayCount
    'ctPackage_update = ctPackage_update + FileArrayCount
    xNewDataPos = OutHeaderPos + ctPackageConst_HeaderSize + (ctPackage_Update + FileArrayCount) * ctPackageConst_TOCWidth + Len(xFileNames)
    
    xChar1 = ctPackage_InternalUsage_EmptyHeader
    Put OutFileID, OutHeaderPos + 1&, xChar1
    
    'If xDataSize > xOldDataSize Then
    
    If Not FileID = OutFileID Then
      xOldDataSize = LOF(OutFileID) - ctPackageConst_EndSize
      End If
    
    If xLong2 > xOldDataSize - xLong5 Or NoClearWaste Then
      xProgress2 = xLong2 'xDataSize
      Else
      xProgress2 = xOldDataSize - xNewDataPos 'xLong5
      End If
        
    
    'xLong5 = xNewDataPos
    For xLong4 = 0& To xFileCount - 1&
      'If xLong5 <= xLongA1(xLong4 * 2&) Then
      If xNewDataPos <= xLongA1(xLong4 * 2&) Then
        Exit For
        End If
      'xLong5 = xLong5 + xLongA1(xLong4 * 2& + 1&)
      xNewDataPos = xNewDataPos + xLongA1(xLong4 * 2& + 1&)
      Next
    
    'For xLong1 = xLong4 To xFileCount - 1&
    '  xNewDataPos = xNewDataPos + xLongA1(xLong1 * 2& + 1&)
    '  Next
    
    'xLong2 = xNewDataPos
    xLong2 = xNewDataPos
    For xLong1 = xLong4 - 1& To 0& Step -1&
      xLong3 = xLongA1(xLong1 * 2& + 1&)
      xLong2 = xLong2 - xLong3
      'xLong5 = xLong5 - xLong3
    
      Call BinaryMoveFileDataEx(FileID, xLong3, xLongA1(xLong1 * 2&), xLong2, OutFileID, BinaryMoveFileData_NullstringNo, ctPackage_DefaultBlockSize, ProgressControl, xProgress1, xProgress2)
    '  xDataSize = xDataSize + xLong3
      xProgress1 = xProgress1 + xLong3
      Next
'    Stop
    For xLong1 = xLong4 To xFileCount - 1&
      xLong3 = xLongA1(xLong1 * 2& + 1&)
      'Call BinaryMoveFileData(FileID, xLong3, xLongA1(xLong1 * 2&), xLong5, -1&, BinaryMoveFileData_NullstringNo, ctPackage_DefaultBlockSize, ProgressControl, xProgress1, xProgress2)
      Call BinaryMoveFileDataEx(FileID, xLong3, xLongA1(xLong1 * 2&), xNewDataPos, OutFileID, BinaryMoveFileData_NullstringNo, ctPackage_DefaultBlockSize, ProgressControl, xProgress1, xProgress2)
      xProgress1 = xProgress1 + xLong3
    '  xDataSize = xDataSize + xLong3
    '  xProgress1 = xProgress1 + xLong3
      'xLong5 = xLong5 + xLong3
      xNewDataPos = xNewDataPos + xLong3
      Next
    
'    Stop
    'xProgress1 = xOldDataSize
    'xNewDataPos = xLong5
    
    'xLongA2(xLong1) = LenCharToLong(FilesExternInternOffsetArray(xLong1 * 3 + 1&), ctPackageConst_GetFileList_PosIntSize7)
    
    For xLong1& = 0& To FileArrayCount - 1&
    
    
      xLong5 = xLongA2(xLong1)
      If xLongA2(xLong1) = 0& Then
        xLong4 = 0& 'xNewFlag And Not 1&
        Else
        
    '      xChar1 = Mid(FilesExternInternOffsetArray(xLong1 * 3&), 2&)
        If Not FilesExternInternOffsetArray(xLong1 * 3&) = "" Then
          If Not Left(FilesExternInternOffsetArray(xLong1 * 3&), 1&) = vbNullChar Then
            Close FileAccessFileID
            Open FilesExternInternOffsetArray(xLong1 * 3&) For Input As FileAccessFileID
            Close FileAccessFileID
            Open FilesExternInternOffsetArray(xLong1 * 3&) For Binary Access Read As FileAccessFileID
            End If
          End If
          
        If FilesExternInternOffsetArray(xLong1 * 3& + 2&) = "" Then
          If xNewFlag = 0& Then
            If Left(FilesExternInternOffsetArray(xLong1 * 3&), 1&) = vbNullChar Then
              xChar1 = Mid(FilesExternInternOffsetArray(xLong1 * 3&), 2&)
              Put OutFileID, xNewDataPos + 1&, xChar1
              Else
              Call BinaryMoveFileDataEx(FileAccessFileID, xLongA2(xLong1), 0&, xNewDataPos, OutFileID, BinaryMoveFileData_NullstringNew, ctPackage_DefaultBlockSize, ProgressControl, xProgress1, xProgress2)
              End If
            xLong4 = 0&
            Else
            xLong4 = xNewFlag
            If Left(FilesExternInternOffsetArray(xLong1 * 3&), 1&) = vbNullChar Then
              xChar1 = Mid(FilesExternInternOffsetArray(xLong1 * 3&), 2&)
              Else
              xChar1 = String(xLongA2(xLong1), vbNullChar)
              Get FileAccessFileID, 1&, xChar1
              End If
          
            If CanCompress Then
              xChar2 = ctCompressA_Compress(xChar1, ProgressControl, xProgress1, xProgress2, xLongA2(xLong1))
              xLong4 = Len(xChar2)
              If xLong4 < MinimumCompress / 100& * xLongA2(xLong1) Or MinimumCompress > 100& Then
                xChar1 = xChar2
                xLongA2(xLong1) = xLong4
                xLong4 = xNewFlag
                Else
                xLong4 = xNewFlag And Not 1&
                End If
              Else
              xLong4 = xNewFlag
              End If
              
            Put OutFileID, xNewDataPos + 1&, xChar1
            End If
            
            
          Else
          xLong6 = LenCharToLong(FilesExternInternOffsetArray(xLong1 * 3 + 2&), 2&)
          If xLong6 = 0& Then
            'Call BinaryMoveFileData(FileAccessFileID, xLongA2(xLong1), xLong6, xNewDataPos, OutFileID)
            'If Not Len(FilesExternInternOffsetArray(xLong1 * 3 + 2&)) = xLongA2(xLong1) + 13& Then Stop
            xChar1 = Mid(FilesExternInternOffsetArray(xLong1 * 3 + 2&), 14&)
            'If Not Len(xChar1) = xLongA2(xLong1) Then Stop
            Put OutFileID, xNewDataPos + 1&, xChar1
            
            
            'xLong4 = Asc(Left(FilesExternInternOffsetArray(xLong1 * 3 + 2&, 1&)))
            Else
            Call BinaryMoveFileDataEx(FileAccessFileID, xLongA2(xLong1), LenCharToLong(FilesExternInternOffsetArray(xLong1 * 3 + 2&), 2&), xNewDataPos, OutFileID, BinaryMoveFileData_NullstringNew, ctPackage_DefaultBlockSize, ProgressControl, xProgress1, xProgress2)
            End If
          xLong4 = Asc(Left(FilesExternInternOffsetArray(xLong1 * 3 + 2&), 1&))
          xTOCNew = Left(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth + ctPackageConst_TOCOverWriteExtSizePos) & _
                    Mid(FilesExternInternOffsetArray(xLong1 * 3 + 2&), ctPackageConst_GetFileList_PosExtSize7, 4&) & _
                    Mid(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth + ctPackageConst_TOCOverWriteExtSizePosRs)
    '      xLong5 = LenCharToLong(FilesExternInternOffsetArray(xLong1 * 3 + 2&), ctPackageConst_TOCParamPosExtSize)
          End If
          
        xDataSize = xDataSize + xLongA2(xLong1)
        End If
      xTOCNew = Left(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth) & _
                Chr(xLong4) & _
                Mid(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth + ctPackageConst_TOCPWSecondStart, ctPackageConst_TOCPWSecondWidth) & _
                LenLongToChar(xLongA2(xLong1)) & _
                Mid(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth + ctPackageConst_TOCPosLast)
    '  xTOCNew = Left(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth) & _
    '            Chr(xLong4) & _
    '            Mid(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth + ctPackageConst_TOCPWSecondStart, ctPackageConst_TOCPWSecondWidth) & _
    '            LenLongToChar(xLong5) & _
    '            Mid(xTOCNew, (ctPackage_Update + xLong1) * ctPackageConst_TOCWidth + ctPackageConst_TOCPosLast)
      
      'xDataSize = xDataSize + xLongA2(xLong1)
      xNewDataPos = xNewDataPos + xLongA2(xLong1)
      xProgress1 = xProgress1 + xLong5 'xLongA2(xLong1) ' + 1&)
      ctProgressB_SetValue ProgressControl, xProgress1, xProgress2
      DoEvents
      
      
      
      
      
    ''''''''''''''''''''''''''''''''  If xAbort Then Exit Function
      Next
    
    Close FileAccessFileID
    ''xLong1 = xolddatapos 'LOF(1) - ctPackageConst_EndSizeMinus
    ''xLong1 = LOF(1) - ctPackageConst_EndSize
    'If FileID = OutFileID Then
      If xOldDataSize > xNewDataPos And Not NoClearWaste Then
        'Call BinaryClearFileData(OutFileID, xNewDataPos, xOldDataSize - xNewDataPos - ctPackageConst_EndSize, ctPackage_ctProgressBarActl, ctPackage_DefaultBlockSize, xProgress1, xProgress2)
        Call BinaryClearFileData(OutFileID, xNewDataPos, xOldDataSize - xNewDataPos, ctPackage_DefaultBlockSize, ProgressControl, xProgress1, xProgress2)
        End If
    '  Else
    '  'xLong1 = LOF(OutFileID) - ctPackageConst_EndSize
    '  'If xLong1 > xNewDataPos And Not NoClearWaste Then
    '  If xOldDataSize > xNewDataPos And Not NoClearWaste Then
    '    'Call BinaryClearFileData(OutFileID, xNewDataPos, xLong1 - xNewDataPos, ctPackage_ctProgressBarActl, ctPackage_DefaultBlockSize, xProgress1, xProgress2)
    '    Call BinaryClearFileData(OutFileID, xNewDataPos, xOldDataSize - xNewDataPos, ctPackage_ctProgressBarActl, ctPackage_DefaultBlockSize, xProgress1, xProgress2)
    '    End If
    '  End If
    
    'ctPackage_update = xNewFileCount
    'xChar1 = ctPackageConst_HeaderInfoText & LenLongToChar(FileArrayCount ) & LenLongToChar(Len(xFileNames)) & LenLongToChar(xDataSize, ctPackageConst_HeaderPWDataSize) & xTOCNew & xFileNames
    
    
'    Stop
    'xChar1 = ctPackageConst_HeaderInfoText & LenLongToChar(ctPackage_Update + FileArrayCount) & LenLongToChar(Len(xFileNames)) & LenLongToChar(xDataSize) & xTOCNew & xFileNames
    ctPackage_Update = ctPackage_Update + FileArrayCount
    xChar1 = ctPackageConst_HeaderInfoText & LenLongToChar(ctPackage_Update) & LenLongToChar(Len(xFileNames)) & LenLongToChar(xDataSize) & xTOCNew & xFileNames
    Put OutFileID, HeaderPos + 1&, xChar1
    
    'xChar1 = String(ctPackageConst_EndSize, vbNullChar)
    xChar1 = ctPackageConst_EndSizeText1 & LenLongToChar(OutHeaderPos) & ctPackageConst_EndSizeText2
    xLong1 = LOF(OutFileID) - ctPackageConst_EndSize
    If xLong1 > xNewDataPos Then 'Or NoClearWaste Then
      Put OutFileID, xLong1 + 1&, xChar1
      Else
      Put OutFileID, xNewDataPos + 1&, xChar1
      End If
    
    'xChar1 = ctPackageConst_EndSizeText1 & LenLongToChar(HeaderPos) & ctPackageConst_EndSizeText2
    'Put outFileID, LOF(outFileID) - ctPackageConst_EndSizeMinus, xChar1
    
Lb1:
    On Error GoTo 0
    Close FileAccessFileID
    Exit Function
    
Er1:
    If BreakIfFileAccessError Then
      Resume Lb1
      Else
     ' For xLong2 = xLong1 To FileArrayCount - 3&
     '   FilesExternInternOffsetArray(xLong2 * 3&) = FilesExternInternOffsetArray(xLong2 * 3& + 3&)
     '   FilesExternInternOffsetArray(xLong2 * 3& + 1&) = FilesExternInternOffsetArray(xLong2 * 3& + 4&)
     '   FilesExternInternOffsetArray(xLong2 * 3& + 2&) = FilesExternInternOffsetArray(xLong2 * 3& + 5&)
     '   FileArrayCount = FileArrayCount - 1&
     '   Next
    '              For xLong5 = xLong1 * 3& To FileArrayCount * 3& - 4&
      For xLong2 = xLong1 * 3& To FileArrayCount * 3& - 4&
        FilesExternInternOffsetArray(xLong2) = FilesExternInternOffsetArray(xLong2 + 3&)
        Next
      
      For xLong2 = xLong1 To FileArrayCount - 2&
        xLongA2(xLong2) = xLongA2(xLong2 + 1&)
        Next
      Resume Rs1
      End If
    End Function
  #End If



#If (ctPackage_Update_FlagA And &H11&) = &H11& Then
  Public Function ctPackage_Update_Create(ByVal FileID As Long, Optional ByVal CanUseExisting As Boolean = True) As Long
    Dim xChar1 As String

    ctPackage_Update_Create = ctPackage_GetHeaderPos(FileID)
    If ctPackage_Update_Create = -1& Then
      ctPackage_Update_Create = LOF(FileID)
      xChar1 = ctPackage_InternalUsage_EmptyHeader & ctPackageConst_EndSizeText1 & LenLongToChar(ctPackage_Update_Create) & ctPackageConst_EndSizeText2
      Put FileID, ctPackage_Update_Create + 1&, xChar1
      Else
      If Not CanUseExisting Then
        If Not ctPackage_GetFileCount(FileID, ctPackage_Update_Create) = 0& Then
          ctPackage_Update_Create = -1&
          End If
        End If
      End If
    End Function
  #End If

  
#If (ctPackage_Update_FlagA And &H40&) = &H40& Then
  Public Function ctPackage_Update_ClearWaste(ByVal FileID As Long, ByVal HeaderPos As Long, ByVal NewOrOverwriteFileName As String, Optional ByVal TempFileAccessID As Long = -1&, Optional ByVal TempFileName As String, Optional ByVal ProgressControl As Long = 0&) As Boolean
    Dim xLong1 As Long
    Dim xChar1 As String
    
    If Not HeaderPos = -1& Then
      xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
      Get FileID, HeaderPos + 1&, xChar1
      xLong1 = HeaderPos + ctPackageConst_HeaderSize + _
                  LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount) * ctPackageConst_TOCWidth + _
                  LenCharToLong(xChar1, ctPackageConst_HeaderPosFileNames) + _
                  LenCharToLong(xChar1, ctPackageConst_HeaderPosDataSize)
      xChar1 = ctPackageConst_EndSizeText1 & LenLongToChar(HeaderPos) & ctPackageConst_EndSizeText2
      Put FileID, xLong1 + 1&, xChar1
      ctPackage_Update_ClearWaste = ctPackage_Update_DestroyPackage(FileID, xLong1 + ctPackageConst_EndSize, NewOrOverwriteFileName, TempFileAccessID, TempFileName, ProgressControl)
      Close FileID
      Open NewOrOverwriteFileName For Binary Lock Read Write As FileID
      End If
    End Function
  #End If

#If (ctPackage_Update_FlagA And &H21&) = &H21& Then
  Public Function ctPackage_Update_ErasePackage(ByVal FileID As Long, ByVal HeaderPos As Long, Optional ByVal ProgressControl As Long = 0&) As Long
    Dim xChar1 As String
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong3 As Long
    
    xChar1 = ctPackage_InternalUsage_EmptyHeader
    Put FileID, HeaderPos + 1&, xChar1
    xLong1 = LOF(FileID) - ctPackageConst_EndSize - 1&
    xLong2 = HeaderPos + ctPackageConst_HeaderSize
    xLong3 = xLong1 - xLong2
    If xLong3 > 0 Then
      Call BinaryClearFileData(FileID, xLong2, xLong3, ctPackage_DefaultBlockSize, ProgressControl, 0&, xLong3)
      End If
    End Function
  #End If

#If (ctPackage_Update_FlagA And &HC0&) = &HC0& Then
  Public Function ctPackage_Update_DestroyPackage(ByVal FileID As Long, ByVal HeaderPos As Long, ByVal NewOrOverwriteFileName As String, Optional ByVal TempFileAccessID As Long = -1&, Optional ByVal TempFileName As String, Optional ByVal ProgressControl As Long = 0&) As Boolean
    Dim xLong1 As Long
    
    If HeaderPos = 0& Then
      Close FileID
      Kill NewOrOverwriteFileName
      ctPackage_Update_DestroyPackage = True
      ElseIf Not HeaderPos = -1& Then
      If TempFileName = "" Then
'        Stop
        xLong1 = InStrRev(NewOrOverwriteFileName, ".")
        If xLong1 > InStrRev(NewOrOverwriteFileName, "\", 1&, 1&) Then
          TempFileName = Left(NewOrOverwriteFileName, xLong1 - 1) & ".TMP"
          Else
          Exit Function
          End If
        End If
'      Stop
      If TempFileAccessID = -1& Or TempFileAccessID = FileID Then
        TempFileAccessID = FreeFile
        End If
      Close TempFileAccessID
      Open TempFileName For Output As TempFileAccessID
      Close TempFileAccessID
      Open TempFileName For Binary Access Read Write As TempFileAccessID
      Call BinaryMoveFileDataEx(FileID, HeaderPos, 0&, 0&, TempFileAccessID, BinaryMoveFileData_NullstringNew, ctPackage_DefaultBlockSize, ProgressControl, 0&, HeaderPos - 1&)
      Close TempFileAccessID
      Close FileID
      On Error Resume Next
      Kill NewOrOverwriteFileName
      On Error GoTo 0
      Name TempFileName As NewOrOverwriteFileName
      ctPackage_Update_DestroyPackage = True
      End If
    End Function
  #End If




#If (ctPackage_Update_FlagA And &H103&) = &H103& Then
  Public Function ctPackage_Update_AttacheFilesWrapper( _
    ByVal FileID As Long, ByVal HeaderPos As Long, _
    ByRef FilesExternInternArray() As String, _
    ByVal FileArrayCount As Long, _
    Optional ByVal Compress As Boolean = True, _
    Optional ByVal BreakIfFileAccessError As Boolean = False, _
    Optional ByVal FileAccessFileID As Long = -1&, _
    Optional ByVal FileExistsHandling As ctPackage_IfExistsModes = ctPackage_Exists_Break, _
    Optional ByVal Reserved_DoubleAttacheFilesHandling As ctPackage_DoubleNewFilesModes = ctPackage_DoubleNewFiles_Break, _
    Optional ByVal NoClearWaste As Boolean = False, _
    Optional ByVal OutFileID As Long = -1&, _
    Optional ByVal OutHeaderPos As Long = -1&, _
    Optional ByVal MinimumCompress As Long = ctPackage_MinimumCompressDefault, _
    Optional ByVal ProgressControl As Long = 0&) As Long
    
    Dim xLong1 As Long
    Dim xCharA1() As String
    
    ReDim xCharA1(FileArrayCount * 3& - 1&)
    For xLong1 = 0& To FileArrayCount - 1&
      xCharA1(xLong1 * 3&) = FilesExternInternArray(xLong1 * 2&)
      xCharA1(xLong1 * 3& + 1&) = FilesExternInternArray(xLong1 * 2& + 1&)
      Next
    
    ctPackage_Update_AttacheFilesWrapper = ctPackage_Update(FileID, HeaderPos, xCharA1(), FileArrayCount, "", Compress, BreakIfFileAccessError, FileAccessFileID, FileExistsHandling, Reserved_DoubleAttacheFilesHandling, NoClearWaste, OutFileID, OutHeaderPos, MinimumCompress, ProgressControl)
    End Function
  #End If


#If (ctPackage_Update_FlagA And &H203&) = &H203& Then
  Public Function ctPackage_Update_DeleteFilesProWrapper(ByVal FileID As Long, ByVal HeaderPos As Long, ByVal DelFileOrNotByteStream As String, Optional ByVal NoClearWaste As Boolean = False, Optional ByVal ProgressControl As Long = 0&) As Long
    Dim xCharA1(0) As String
    
    ctPackage_Update_DeleteFilesProWrapper = ctPackage_Update(FileID, HeaderPos, xCharA1(), 0&, DelFileOrNotByteStream, False, False, -1&, ctPackage_Exists_NoCheck, , NoClearWaste, -1&, -1&, , ProgressControl)
    End Function
  #End If


#If (ctPackage_Update_FlagA And &H403&) = &H403& Then
  Public Function ctPackage_Update_MergePackagesWrapper( _
    ByVal FileID As Long, ByVal HeaderPos As Long, _
    ByVal FileToMergeFileName As String, _
    Optional ByVal FileToMergeOrNotByteStream As String, _
    Optional ByVal SourceDelFileOrNotByteStream As String, _
    Optional ByVal Reserved_ReCompress As Boolean = False, _
    Optional ByVal BreakIfFileAccessError As Boolean = False, _
    Optional ByVal FileAccessFileID As Long = -1&, _
    Optional ByVal FileExistsHandling As ctPackage_IfExistsModes = ctPackage_Exists_Break, _
    Optional ByVal Reserved_DoubleAttacheFilesHandling As ctPackage_DoubleNewFilesModes = ctPackage_DoubleNewFiles_Break, _
    Optional ByVal NoClearWaste As Boolean = False, _
    Optional ByVal OutFileID As Long = -1&, _
    Optional ByVal OutHeaderPos As Long = -1&, _
    Optional ByVal MinimumCompress As Long = ctPackage_MinimumCompressDefault, _
    Optional ByVal ProgressControl As Long = 0&) As Long

    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong3 As Long
    Dim xCharA1(65535) As String
    
    ctPackage_Update_MergePackagesWrapper = -1&
    If FileAccessFileID = -1& Then
      FileAccessFileID = FreeFile
      End If
    
    On Error GoTo Er1
    Close FileAccessFileID
    Open FileToMergeFileName For Input As FileAccessFileID
    Close FileAccessFileID
    Open FileToMergeFileName For Binary Access Read Lock Write As FileAccessFileID
    xLong1 = ctPackage_GetHeaderPos(FileAccessFileID)
    On Error GoTo 0
    If Not xLong1 = -1& Then
      xLong2 = ctPackage_GetFileList(FileAccessFileID, xLong1, xCharA1(), 65535, , 3&, 2&)
      ctPackage_Update_MergePackagesWrapper = 0&
      If Not xLong2 = 0& Then
        If FileToMergeOrNotByteStream = "" Then
          FileToMergeOrNotByteStream = String(xLong2, Chr(1&))
          End If
        Close FileAccessFileID
        xCharA1(0) = FileToMergeFileName
        For xLong2 = 0& To xLong2 - 1&
    '      Stop
          If Mid(FileToMergeOrNotByteStream, xLong2 + 1&, 1&) = Chr(1&) Then
            xCharA1(xLong3 * 3& + 1&) = Mid(xCharA1(xLong2 * 3& + 2&), ctPackageConst_GetFileList_PosFilename7)
            xCharA1(xLong3 * 3& + 2&) = Left(xCharA1(xLong2 * 3& + 2&), ctPackageConst_GetFileList_PWParams7)
            'Stop
            xLong3 = xLong3 + 1&
            End If
          Next
    '    Stop
        If Not xLong3 = 0& Then
          ctPackage_Update_MergePackagesWrapper = ctPackage_Update(FileID, HeaderPos, xCharA1(), xLong3, SourceDelFileOrNotByteStream, Reserved_ReCompress, BreakIfFileAccessError, FileAccessFileID, FileExistsHandling, Reserved_DoubleAttacheFilesHandling, NoClearWaste, OutFileID, OutHeaderPos, MinimumCompress, ProgressControl)
          End If
        End If
      End If
    
Rs1:
    On Error GoTo 0
    Close FileAccessFileID
    Exit Function
    
Er1:
    Resume Rs1
    End Function
  #End If




#If (ctPackage_Update_FlagA And &H1000&) = &H1000& Then
  Public Function ctPackage_Update_CreateRawFileDataContent(ByVal RawData As String, Optional ByVal CanCompress As Boolean = True, Optional ByVal MinimumCompress As Long = ctPackage_MinimumCompressDefault, 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
    
    Dim NewFlag As Long
    Dim xChar1 As String
    Dim xLong1 As Long
    Dim xLong2 As Long
    
    xLong1 = Len(RawData)
    If CanCompress Then
      xChar1 = ctCompressA_Compress(RawData, ProgressControl, ProgressStart, ProgressTotal, ProgressQueue)
      xLong2 = Len(xChar1)
'      Stop
      If xLong2 < MinimumCompress / 100& * xLong1 Or MinimumCompress > 100& Then
        RawData = xChar1
        NewFlag = 1&
        Else
        xLong2 = xLong1
        End If
      Else
      xLong2 = xLong1
      End If
    
    ctPackage_Update_CreateRawFileDataContent = Chr(NewFlag) & String(4, vbNullChar) & LenLongToChar(xLong2) & LenLongToChar(xLong1) & RawData
    End Function
  #End If

