VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "COMPRESSION"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private Const OF_READ = &H0
Private Const OF_CREATE = &H1000
Private Const OFS_MAXPATHNAME = 128

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

' OpenFile() Structure
Private Type OFSTRUCT
        cBytes As Byte
        fFixedDisk As Byte
        nErrCode As Integer
        Reserved1 As Integer
        Reserved2 As Integer
        szPathName(OFS_MAXPATHNAME) As Byte
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
    hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
    lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
    PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
    hObject As Long) As Long

Private Declare Function LZCopy Lib "lz32.dll" (ByVal _
    hfSource As Long, ByVal hfDest As Long) As Long

Private Declare Function LZOpenFile Lib "lz32.dll" Alias "LZOpenFileA" _
    (ByVal lpszFile As String, lpOf As OFSTRUCT, ByVal style As Long) _
    As Long

Private Declare Function LZSeek Lib "lz32.dll" (ByVal _
    hfFile As Long, ByVal lOffset As Long, ByVal nOrigin _
    As Long) As Long

Private Declare Function LZRead Lib "lz32.dll" (ByVal _
    hfFile As Long, ByVal lpvBuf As String, ByVal cbread _
    As Long) As Long

Private Declare Sub LZClose Lib "lz32.dll" (ByVal hfFile As Long)

Private expandedName As String
Private compressedName As String

Property Get fileName() As String
    fileName = expandedName
End Property

Property Let fileName(fName As String)
    expandedName = fName
End Property

Public Sub compress()
    Dim p As PROCESS_INFORMATION
    Dim s As STARTUPINFO
    Dim procStatus As Long

    ' Initialize the STARTUPINFO structure:
    s.cb = Len(s)

    ' Start the shelled application:
    ' make sure that close upon exit is checked.
    CreateProcessA 0&, "setupkit\compress -r " & expandedName, _
       0&, 0&, 1&, _
       NORMAL_PRIORITY_CLASS, 0&, 0&, s, p

    ' Wait for the shelled application to finish:
    WaitForSingleObject p.hProcess, INFINITE

    CloseHandle p.hThread
    CloseHandle p.hProcess

    compressedName = Left(expandedName, _
        Len(expandedName) - 1) & "_"
End Sub

Public Sub expand()
    Dim openStruct As OFSTRUCT
    Dim hSource As Long
    Dim hDestination As Long
    Dim ret As Long
    
    hSource = LZOpenFile(compressedName, openStruct, OF_READ)

    ' Note: Do not use expName$ you will get a access violation.
    ' take care to pre-allocate space.
    hDestination = LZOpenFile(expandedName, openStruct, OF_CREATE)
    ret = LZCopy(hSource, hDestination)
    LZClose hDestination
    LZClose hSource
End Sub

Public Sub read(recNum As Long, recLen As Long, recBuf As String)
    Dim openStruct As OFSTRUCT
    Dim hSource As Long
    Dim hDestination As Long

    hSource = LZOpenFile(compressedName, openStruct, OF_READ)
    LZSeek hSource, recLen * (recNum - 1), 0
    LZRead hSource, recBuf, recLen
    LZClose hSource
End Sub


