[API]
GetFileSize
ReadFile
SetFilePointer
CloseHandle

[INCLUDE]
CreateFile

[DEFINE]
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
Private Const ctPackage_DefaultBlockSize As Long = &H3FFF00 ' BinaryMoveFileData_DefaultBlockSize
Private Const ctPackage_MinimumCompressDefault As Long = 95&

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

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

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

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

Private Const ctPackageConst_TOCWidth As Long = 13&
Private Const ctPackageConst_TOCPosFlags As Long = 1&
Private Const ctPackageConst_TOCPWFlags As Long = 1&
Private Const ctPackageConst_TOCPosFileNameSize As Long = 2&
Private Const ctPackageConst_TOCPosIntSize As Long = 6&
Private Const ctPackageConst_TOCPosExtSize As Long = 10&
Private Const TOCSizeHolderSmall As Long = 4&
Private Const ctPackageConst_TOCOverWriteExtSizePos As Long = 9&
Private Const ctPackageConst_TOCOverWriteExtSizePosRs As Long = 14&
Private Const ctPackageConst_TOCParamPosExtSize As Long = 10&
'Private Const ctPackageConst_TOCOverWriteExtSizePos As Long = 5&
'Private Const ctPackageConst_TOCOverWriteExtSizePosRs As Long = 10&
'Private 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&
Private Const ctPackageConst_TOCPWSecondStart As Long = 2&
Private Const ctPackageConst_TOCPWSecondWidth As Long = 4&
Private Const ctPackageConst_TOCPosLast As Long = 10&
Private Const ctPackageConst_TOCSizeTotal As Long = 26& '(minfilesize)

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

Public Const ctPackage_VersionInfo As String = "ctpA 1.04.00 2004/10/28"
Public Const ctPackage_Version As Single = 1

[CODE]
Public Function ctPackage_Open(ByVal FileName As String, ByRef ctPackagePointer As Long, Optional ByVal WriteAccess As Boolean = False) As Boolean
  Dim ctPIType As ctPackage_InfoType
  'Call RtlMoveMemory(ctPIType, ByVal ctPackagePointer, ctPackage_InfoTypeSize)
  
  If WriteAccess Then
    ctPIType.FileHandle = CreateFile(FileName, CreateOrReuse, FILE_READWRITE)
    ctPIType.CanModify = cByte1
    Else
    ctPIType.FileHandle = CreateFile(FileName, OpenExisting, FILE_READ)
    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 = ctPackage_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
                    Call RtlMoveMemory(ByVal ctPackagePointer, ctPIType, ctPackage_InfoTypeSize)
                    ctPackage_Open = True
                    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

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

Private Function ctPackage_LenCharToLong(ByVal xChar1 As String, Optional ByVal Address As Long = 1&) As Long
  xChar1 = Mid(xChar1, Address, 4&) & String(4&, vbNullChar)
  Address = Asc(xChar1)
  ctPackage_LenCharToLong = ( _
                   (Address And &H7F) * &H1000000 + _
                   Asc(Mid(xChar1, 2&, 1&)) * &H10000 + _
                   Asc(Mid(xChar1, 3&, 1&)) * &H100& + _
                   Asc(Mid(xChar1, 4&, 1&)) _
                   ) Or &H80000000 * ((Address And &H80&) \ &H80&)
  End Function

#If ctPackage_GetFileList Or ctPackage_Update Then
  Private Function ctPackage_LenLongToChar(ByVal xLong1 As Long) As String
    ctPackage_LenLongToChar = Chr((((xLong1 And &H80000000) \ &H1000000) And &HFF&) + ((xLong1 And &H7F000000) \ &H1000000)) & _
                              Chr((xLong1 And &HFF0000) \ &H10000) & _
                              Chr((xLong1 And &HFF00&) \ &H100&) & _
                              Chr(xLong1 And &HFF&)
    End Function
  #End If