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

'17 = cannot do...
'55 = file already open
'57 = device io error            #######
'61 = disk full
'67 = too many files
'68 = device unavailable
'70 = permission denied
'71 = disk not ready
'75 = path/file access error

'#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&
Private Const cByte1 As Byte = 1

'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

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 CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh 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 SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod 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

Public Type ctPackage_InfoType
  FileHandle As Long
  FileHeader As Long
  CanModify As Long
  End Type
Public Const ctPackage_InfoTypeSize As Long = 12&

#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 = 25&
Private Const HeaderPreopenSize As Long = 12&
Private Const HeaderPosInfo As Long = 1&
Private Const HeaderPWInfo As Long = 4&
Public Const ctPackageConst_HeaderPosFileCount As Long = 4& '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 = 10&
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_Open(ByVal Filename As String, ByRef ctPackagePointer As Long, Optional ByVal WriteAccess As Boolean = False) As Long
  Dim xLong1 As Long
  Dim ctPIType As ctPackage_InfoType
  'Call RtlMoveMemory(ctPIType, ByVal ctPackagePointer, ctPackage_InfoTypeSize)
  
  If WriteAccess Then
    ctPIType.FileHandle = CreateFileA(Filename, &HC0000000, &H1, ByVal 0&, 3&, &H20&, 0&)
    ctPIType.CanModify = cByte1
    Else
    ctPIType.FileHandle = CreateFileA(Filename, &H80000000, &H1, ByVal 0&, 3&, &H20&, 0&)
    End If
  If Not ctPIType.FileHandle = -1& Then
    ctPIType.FileHeader = GetFileSize(ctPIType.FileHandle, 0&)
    If ctPIType.FileHeader > MinFileSize Then
      Filename = String(ctPackageConst_EndSize, vbNullChar)
      If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader - ctPackageConst_EndSizeMinus, 0&, 0&) = -1& Then
        If Not ReadFile(ctPIType.FileHandle, ByVal Filename, ctPackageConst_EndSize, 0&, ByVal 0&) = 0& Then
          If Left(Filename, ctPackageConst_EndSizeLeft) & Right(Filename, ctPackageConst_EndSizeRight) = ctPackageConst_EndSizeText Then
            ctPIType.FileHeader = LenCharToLong(Filename, ctPackageConst_EndSizeStart)
            Filename = String(HeaderPWInfo, vbNullChar)
            If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader, 0&, 0&) = -1& Then
              If Not ReadFile(ctPIType.FileHandle, ByVal Filename, HeaderPWInfo, 0&, ByVal 0&) = 0& Then
                If Filename = ctPackageConst_HeaderInfoText Then
                  ctPackagePointer = LocalAlloc(0&, ctPackage_InfoTypeSize)
                  If Not ctPackagePointer = 0& Then
                    xLong1 = LocalLock(ctPackagePointer)
                    If xLong1 = 0& Then
                      Call LocalFree(ctPackagePointer)
                      ctPackagePointer = 0&
                      Else
                      Call RtlMoveMemory(ByVal xLong1, ctPIType, ctPackage_InfoTypeSize)
                      Call LocalUnlock(ctPackagePointer)
                      ctPackage_Open = True
                      End If
                    End If
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    If Not ctPackage_Open Then
      CloseHandle ctPIType.FileHandle
      End If
    End If
  End Function

Public Sub ctPackage_Close(ByRef ctPackagePointer As Long)
  Dim ctPIType As ctPackage_InfoType
  If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
    Call CloseHandle(ctPIType.FileHandle)
    Call LocalFree(ctPackagePointer)
    ctPackagePointer = 0&
    End If
  End Sub

Public Function ctPackage_GetInfoEx(ByVal ctPackagePointer As Long, ByRef ctPackageInfo As ctPackage_InfoType) As Boolean
  Dim xLong1 As Long
  
  If Not ctPackagePointer = 0& Then
    xLong1 = LocalLock(ctPackagePointer)
    If Not xLong1 = 0& Then
      Call RtlMoveMemory(ctPackageInfo, ByVal ctPackagePointer, ctPackage_InfoTypeSize)
      Call LocalUnlock(ctPackagePointer)
      ctPackage_GetInfoEx = True
      End If
    End If
  End Function

#If (ctPackage_FlagA And &H1&) = &H1& Then
  Public Function ctPackage_GetFileCount(ByVal ctPackagePointer As Long) As Long
    Dim xChar1 As String
    Dim ctPIType As ctPackage_InfoType
    
    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      xChar1 = String(4&, vbNullChar)
      'Get ctPIType.FileHandle, ctPIType.fileheader + ctPackageConst_HeaderPosFileCount, xChar1
      If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader + ctPackageConst_HeaderPosFileCount, 0&, 0&) = -1& Then
        If Not ReadFile(ctPIType.FileHandle, ByVal xChar1, 4&, 0&, ByVal 0&) = 0& Then
          ctPackage_GetFileCount = LenCharToLong(xChar1)
          End If
        End If
      End If
    End Function
  #End If

#If (ctPackage_FlagA And &H2&) = &H2& Then
  Public Function ctPackage_GetFileList(ByVal ctPackagePointer 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
    Dim ctPIType As ctPackage_InfoType

    ctPackage_GetFileList = -1&
    
    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      'If Not ctPIType.FileHandle = -1& Then
        xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
        
        'Get ctPIType.FileHandle, ctPIType.FileHeader + 1&, xChar1
        If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader, 0&, 0&) = -1& Then
          If Not ReadFile(ctPIType.FileHandle, ByVal xChar1, ctPackageConst_HeaderSize, 0&, ByVal 0&) = 0& Then
        
            xLong2 = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount + 1&)
            xLong1 = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileNames)
            xChar1 = String(xLong2 * ctPackageConst_TOCWidth, vbNullChar)
            xChar2 = String(xLong1, vbNullChar)
            
            'Get ctPIType.FileHandle, ctPIType.FileHeader + ctPackageConst_HeaderSize + 1&, xChar1
            If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader + ctPackageConst_HeaderSize, 0&, 0&) = -1& Then
              If Not ReadFile(ctPIType.FileHandle, ByVal xChar1, xLong2 * ctPackageConst_TOCWidth, 0&, ByVal 0&) = 0& Then
            
                xDataPos = ctPIType.FileHeader + ctPackageConst_HeaderSize + xLong2 * ctPackageConst_TOCWidth + xLong1
                'Get ctPIType.FileHandle, , xChar2
                'If Not SetFilePointer(ctPIType.FileHandle, ctPIType.FileHeader, 0&, 0&) = -1& Then
                  If Not ReadFile(ctPIType.FileHandle, ByVal xChar2, xLong1, 0&, ByVal 0&) = 0& Then
                
                    If xLong2 > FileArraySize Then
                      ctPackage_GetFileList = FileArraySize
                      Else
                      ctPackage_GetFileList = xLong2
                      End If
                    
                    '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 If
                End If
              End If
            End If
          End If
      '  End If
      End If
    End Function
  #End If

#If (ctPackage_FlagA And &H100&) = &H100& Then
  Public Function ctPackage_GetRawFileDataContent(ByVal ctPackagePointer As Long, ByVal IntExtFilesData As String) As String
    Dim xLong1 As Long
    Dim ctPIType As ctPackage_InfoType
    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
      xLong1 = LenCharToLong(IntExtFilesData, FileIntOffset)
      ctPackage_GetRawFileDataContent = String(xLong1, vbNullChar)
      'Get ctPIType.FileHandle, LenCharToLong(IntExtFilesData, FilePosOffset) + 1&, ctPackage_GetRawFileDataContent
      If Not SetFilePointer(ctPIType.FileHandle, LenCharToLong(IntExtFilesData, FilePosOffset), 0&, 0&) = -1& Then
        If Not ReadFile(ctPIType.FileHandle, ByVal ctPackage_GetRawFileDataContent, xLong1, 0&, ByVal 0&) = 0& Then
          ctPackage_GetRawFileDataContent = Left(IntExtFilesData, 1&) & String(4&, vbNullChar) & Mid(IntExtFilesData, 6&, 8&) & ctPackage_GetRawFileDataContent
          End If
        End If
      End If
    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
    ReturnSize = Asc(Left(RawDataContent, 1&))
    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 ctPackagePointer As Long, ByRef FilesArray() As String, ByVal FileArraySize As Long, 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
    
    Dim ctPIType As ctPackage_InfoType
    If ctPackage_GetInfoEx(ctPackagePointer, ctPIType) Then
    
    Dim FileAccessFileID As Long
    FileAccessFileID = FreeFile
      
      xChar1 = String(ctPackageConst_HeaderSize, vbNullChar)
      
      Get ctPIType.FileHandle, ctPIType.FileHeader + 1&, xChar1
      xLong3 = LenCharToLong(xChar1, ctPackageConst_HeaderPosFileCount + 1&)
      
      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 = ctPIType.FileHeader + ctPackageConst_HeaderSize + xLong3 * ctPackageConst_TOCWidth + xFilenamesSize '''+ 1&
        xTOC = String(xLong3 * ctPackageConst_TOCWidth, vbNullChar)
        xFileNames = String(xFilenamesSize, vbNullChar)
        Stop
        Get ctPIType.FileHandle, ctPIType.FileHeader + ctPackageConst_HeaderSize + 1&, xTOC
        Stop
        Get ctPIType.FileHandle, , 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 ctPIType.FileHandle, xLong2, xSizes(xLong1), 0&, FileAccessFileID, ctPackage_DefaultBlockSize, ProgressControl, xDataPos, xLong6
                '''''-1&
                Else
                xChar1 = String(xLong2, vbNullChar)
                ''Get ctPIType.FileHandle, xDataPos, xChar2
                Stop
                Get ctPIType.FileHandle, 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 If
    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), True)
      End If
    End Sub
  #End If


