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

#If 0 Then

' *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
' 803 (800) = ctPackage_Update_RenameFilesWrapper
'1000       = ctPackage_Update_CreateRawFileDataContent










Private Const cByte1 As Byte = 1

Private Declare Function CreateFileA Lib "kernel32.dll" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long


#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 &H40&) = &H40& Then
  Public Function ctPackage_Update_ClearWaste(ByVal ctPackagePointer 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
    Dim ctPIType As ctPackage_InfoType
    
    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      Stop
'    If Not ctPIType.FileHandle = -1& Then
'      Stop
      'xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
      'If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader - ctPackageConst_EndSizeMinus, 0&, 0&) = -1& Then
      '  If Not ReadFile(ctPIType.FileHandle, ByVal xChar1, Len(xChar1), 0&, ByVal 0&) = 0& Then
      '    'Get FileID, ctpitype.fileheader + 1&, xChar1
      '    xLong1 = ctpitype.fileheader + ctPackageConst_HeaderSize + _
      '                LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount + 1&) * ctPackageConst_TOCWidth + _
      '                LenCharToLong(xChar1, ctPackageConst_HeaderPosFileNames) + _
      '                LenCharToLong(xChar1, ctPackageConst_HeaderPosDataSize)
      '    xChar1 = ctPackageConst_EndSizeText1 & LenLongToChar(ctpitype.fileheader) & 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 If
      End If
    End Function
  #End If

#If (ctPackage_Update_FlagA And &H21&) = &H21& Then
  Public Function ctPackage_Update_ErasePackage(ByVal ctPackagePointer 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
    
    Stop
    'xChar1 = ctPackageConst_HeaderInfoText & String(ctPackageConst_HeaderEmptyNullsWidth, vbNullChar) ' ctPackage_InternalUsage_EmptyHeader
    'Put FileID, ctpitype.fileheader + 1&, xChar1
    'xLong1 = LOF(FileID) - ctPackageConst_EndSize - 1&
    'xLong2 = ctpitype.fileheader + 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(ByRef ctPackagePointer 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 ctPIType As ctPackage_InfoType
    
    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      Stop
      'Close FileID
      'Kill NewOrOverwriteFileName
      'ctPackage_Update_DestroyPackage = True
      'ElseIf Not ctpitype.fileheader = -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, ctpitype.fileheader, 0&, 0&, TempFileAccessID, BinaryMoveFileData_NullstringNew, ctPackage_DefaultBlockSize, ProgressControl, 0&, ctpitype.fileheader - 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 ctPackagePointer As Long, _
    ByRef FilesExternInternArray() As String, _
    ByVal FileArrayCount As Long, _
    Optional ByVal Compress As Boolean = True, _
    Optional ByVal BreakIfFileAccessError As Boolean = False, _
    Optional ByVal FileExistsHandling As ctPackage_IfExistsModes = ctPackage_Exists_Break, _
    Optional ByVal Reserved_DoubleAttacheFilesHandling As ctPackage_DoubleNewFilesModes = ctPackage_DoubleNewFiles_Break, _
    Optional ByVal ctPackagePointer_OutFile As Long, _
    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(ctPackagePointer, xCharA1(), FileArrayCount, "", Compress, BreakIfFileAccessError, FileExistsHandling, Reserved_DoubleAttacheFilesHandling, ctPackagePointer_OutFile, MinimumCompress, ProgressControl)
    End Function
  #End If


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


#If (ctPackage_Update_FlagA And &H403&) = &H403& And False Then
  Public Function ctPackage_Update_MergePackagesWrapper( _
    ByVal ctPackagePointer 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 FileExistsHandling As ctPackage_IfExistsModes = ctPackage_Exists_Break, _
    Optional ByVal Reserved_DoubleAttacheFilesHandling As ctPackage_DoubleNewFilesModes = ctPackage_DoubleNewFiles_Break, _
    Optional ByVal ctPackagePointer_OutFile As Long, _
    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&
    
    Dim FileAccessFileID As Long
    FileAccessFileID = FreeFile
    
    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(ctPackagePointer, xCharA1(), xLong3, SourceDelFileOrNotByteStream, Reserved_ReCompress, BreakIfFileAccessError, FileExistsHandling, Reserved_DoubleAttacheFilesHandling, ctPackagePointer_OutFile, 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 &H803&) = &H803& Then
  'ctPackage_Update_RenameFilesWrapper(xCharA1(), xLong2 \ 2&, , , hWndProgress)
  Public Function ctPackage_Update_RenameFilesWrapper(ByVal ctPackagePointer As Long, ByRef RenamingArray() As String, ByVal RenamingArrayCount As Long, Optional ByVal Unknown1 As Long, Optional ByVal Unknown2 As Long, Optional ByVal ProgressControl As Long) As Long
    'Dim xCharA1(0) As String
    Stop
    'ctPackage_Update_RenameFilesWrapper = ctPackage_Update(ctPackagePointer,  xCharA1(), 0&, DelFileOrNotByteStream, False, False, ctPackage_Exists_NoCheck, , , , ProgressControl)
    End Function
  #End If
#End If
