home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap22 / compress.cls next >
Encoding:
Text File  |  1995-09-24  |  4.1 KB  |  149 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "COMPRESSION"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Private Const OF_READ = &H0
  11. Private Const OF_CREATE = &H1000
  12. Private Const OFS_MAXPATHNAME = 128
  13.  
  14. Private Const NORMAL_PRIORITY_CLASS = &H20&
  15. Private Const INFINITE = -1&
  16.  
  17. ' OpenFile() Structure
  18. Private Type OFSTRUCT
  19.         cBytes As Byte
  20.         fFixedDisk As Byte
  21.         nErrCode As Integer
  22.         Reserved1 As Integer
  23.         Reserved2 As Integer
  24.         szPathName(OFS_MAXPATHNAME) As Byte
  25. End Type
  26.  
  27. Private Type STARTUPINFO
  28.     cb As Long
  29.     lpReserved As String
  30.     lpDesktop As String
  31.     lpTitle As String
  32.     dwX As Long
  33.     dwY As Long
  34.     dwXSize As Long
  35.     dwYSize As Long
  36.     dwXCountChars As Long
  37.     dwYCountChars As Long
  38.     dwFillAttribute As Long
  39.     dwFlags As Long
  40.     wShowWindow As Integer
  41.     cbReserved2 As Integer
  42.     lpReserved2 As Long
  43.     hStdInput As Long
  44.     hStdOutput As Long
  45.     hStdError As Long
  46. End Type
  47.  
  48. Private Type PROCESS_INFORMATION
  49.     hProcess As Long
  50.     hThread As Long
  51.     dwProcessID As Long
  52.     dwThreadID As Long
  53. End Type
  54.  
  55. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
  56.     hHandle As Long, ByVal dwMilliseconds As Long) As Long
  57.  
  58. Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
  59.     lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
  60.     lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
  61.     ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
  62.     ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
  63.     lpStartupInfo As STARTUPINFO, lpProcessInformation As _
  64.     PROCESS_INFORMATION) As Long
  65.  
  66. Private Declare Function CloseHandle Lib "kernel32" (ByVal _
  67.     hObject As Long) As Long
  68.  
  69. Private Declare Function LZCopy Lib "lz32.dll" (ByVal _
  70.     hfSource As Long, ByVal hfDest As Long) As Long
  71.  
  72. Private Declare Function LZOpenFile Lib "lz32.dll" Alias "LZOpenFileA" _
  73.     (ByVal lpszFile As String, lpOf As OFSTRUCT, ByVal style As Long) _
  74.     As Long
  75.  
  76. Private Declare Function LZSeek Lib "lz32.dll" (ByVal _
  77.     hfFile As Long, ByVal lOffset As Long, ByVal nOrigin _
  78.     As Long) As Long
  79.  
  80. Private Declare Function LZRead Lib "lz32.dll" (ByVal _
  81.     hfFile As Long, ByVal lpvBuf As String, ByVal cbread _
  82.     As Long) As Long
  83.  
  84. Private Declare Sub LZClose Lib "lz32.dll" (ByVal hfFile As Long)
  85.  
  86. Private expandedName As String
  87. Private compressedName As String
  88.  
  89. Property Get fileName() As String
  90.     fileName = expandedName
  91. End Property
  92.  
  93. Property Let fileName(fName As String)
  94.     expandedName = fName
  95. End Property
  96.  
  97. Public Sub compress()
  98.     Dim p As PROCESS_INFORMATION
  99.     Dim s As STARTUPINFO
  100.     Dim procStatus As Long
  101.  
  102.     ' Initialize the STARTUPINFO structure:
  103.     s.cb = Len(s)
  104.  
  105.     ' Start the shelled application:
  106.     ' make sure that close upon exit is checked.
  107.     CreateProcessA 0&, "setupkit\compress -r " & expandedName, _
  108.        0&, 0&, 1&, _
  109.        NORMAL_PRIORITY_CLASS, 0&, 0&, s, p
  110.  
  111.     ' Wait for the shelled application to finish:
  112.     WaitForSingleObject p.hProcess, INFINITE
  113.  
  114.     CloseHandle p.hThread
  115.     CloseHandle p.hProcess
  116.  
  117.     compressedName = Left(expandedName, _
  118.         Len(expandedName) - 1) & "_"
  119. End Sub
  120.  
  121. Public Sub expand()
  122.     Dim openStruct As OFSTRUCT
  123.     Dim hSource As Long
  124.     Dim hDestination As Long
  125.     Dim ret As Long
  126.     
  127.     hSource = LZOpenFile(compressedName, openStruct, OF_READ)
  128.  
  129.     ' Note: Do not use expName$ you will get a access violation.
  130.     ' take care to pre-allocate space.
  131.     hDestination = LZOpenFile(expandedName, openStruct, OF_CREATE)
  132.     ret = LZCopy(hSource, hDestination)
  133.     LZClose hDestination
  134.     LZClose hSource
  135. End Sub
  136.  
  137. Public Sub read(recNum As Long, recLen As Long, recBuf As String)
  138.     Dim openStruct As OFSTRUCT
  139.     Dim hSource As Long
  140.     Dim hDestination As Long
  141.  
  142.     hSource = LZOpenFile(compressedName, openStruct, OF_READ)
  143.     LZSeek hSource, recLen * (recNum - 1), 0
  144.     LZRead hSource, recBuf, recLen
  145.     LZClose hSource
  146. End Sub
  147.  
  148.  
  149.