home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / vrac / altd201a.zip / VB4032.ARJ / VB40.32 / ARCLIB.BAS < prev    next >
BASIC Source File  |  1996-04-19  |  16KB  |  559 lines
  1. Attribute VB_Name = "Module1"
  2. '
  3. '  ARCLIB.BAS
  4. '
  5. '   Header file for ArchiveLib 2.0
  6. '
  7. '   Copyright (c) 1994-1996 Greenleaf Software, Inc.
  8. '   All Rights Reserved
  9. '
  10. '  DESCRIPTION
  11. '
  12. '   This file contains the entire definition of ArchiveLib as used with
  13. '   Visual Basic 4.0.  It also contains a few wrapper functions
  14. '
  15. '  FUNCTIONS
  16. '
  17. '   ALDelete()
  18. '   ALExtract()
  19. '   ALFreeDir()
  20. '   ALReadDir()
  21. '   ALWriteDir()
  22. '
  23. '  REVISION HISTORY
  24. '
  25. '   February 14, 1996  2.0A : New release
  26. '
  27. Option Explicit
  28. '
  29. ' Lifted from WIN32API.TXT
  30. '
  31. Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  32. Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  33. '
  34. ' Simplified API
  35. '
  36. '
  37. ' ALZipDir is the structure used to hold a PKZIP directory.
  38. '
  39. Public Type ALZipDir
  40.   name As String
  41.   comment As String
  42.   compressed_size As Long
  43.   compressed_position As Long
  44.   size As Long
  45.   crc As Long
  46.   mark As Integer
  47.   month As Integer
  48.   date As Integer
  49.   year As Integer
  50.   hour As Integer
  51.   minute As Integer
  52.   second As Integer
  53. '
  54. ' These need to be String * 1 in VB30
  55. '
  56.   r As Byte
  57.   a As Byte
  58.   s As Byte
  59.   h As Byte
  60.   d As Byte
  61.   level As Byte
  62.   End Type
  63. Declare Function ALCreate Lib "TD20FVB" Alias "ALCreateVB" (ByVal archive_name$, ByVal input_files$, ByVal strip_path&, ByVal text_window&, ByVal file_progress_window&, ByVal job_progress_window&) As Long
  64. Declare Function ALAppend Lib "TD20FVB" Alias "ALAppendVB" (ByVal archive_name$, ByVal input_files$, ByVal strip_path&, ByVal text_window&, ByVal file_progress_window&, ByVal job_progress_window&) As Long
  65. Declare Function newALSimpleMonitor Lib "TD20FVB" (ByVal text_window&, ByVal file_progress_window&, ByVal job_progress_window&) As Long
  66. Declare Sub ALReadDirEntryVB Lib "TD20FVB" (z As ALZipDir, ByVal entry&)
  67. Declare Sub ALWriteDirEntryVB Lib "TD20FVB" (z As ALZipDir, ByVal FileName$, ByVal comment$, ByVal List&)
  68. '
  69. ' ALArchive
  70. '
  71. Declare Function newALPkArchive Lib "TD20FVB" (ByVal file_name$) As Long
  72. Declare Function ALArchiveSetComment Lib "TD20FVB" (ByVal this_object&, ByVal comment$) As Long
  73. Declare Function ALArchiveWriteDirectory Lib "TD20FVB" (ByVal this_object&, ByVal List&) As Long
  74. Declare Sub deleteALArchive Lib "TD20FVB" (ByVal this_object&)
  75. Declare Function ALArchiveDelete Lib "TD20FVB" (ByVal this_object&, ByVal List&, ByVal object_archive&) As Long
  76. Declare Function ALArchiveExtract Lib "TD20FVB" (ByVal this_object&, ByVal List&) As Long
  77. Declare Function ALArchiveGetStorage Lib "TD20FVB" (ByVal Archive&) As Long
  78. Declare Sub ALArchiveSetStripOnExtract Lib "TD20FVB" (ByVal this_object&, ByVal flag&)
  79. Declare Function ALArchiveGetComment Lib "TD20FVB" Alias "ALArchiveGetCommentVB" (ByVal this_object&) As String
  80. Declare Function ALArchiveReadDirectory Lib "TD20FVB" (ByVal this_object&, ByVal List&) As Long
  81. '
  82. ' ALEntryList
  83. '
  84. Declare Function newALListPkCompressFileTools Lib "TD20FVB" (ByVal Monitor&, ByVal level&, ByVal window_bits&, ByVal mem_level&) As Long
  85. Declare Function newALListPkDecompressFileTools Lib "TD20FVB" (ByVal Monitor&) As Long
  86. Declare Sub deleteALEntryList Lib "TD20FVB" (ByVal this_object&)
  87. Declare Function ALEntryListGetFirstEntry Lib "TD20FVB" (ByVal this_object&) As Long
  88. '
  89. ' ALEntry
  90. '
  91. Declare Function ALEntryGetComment Lib "TD20FVB" Alias "ALEntryGetCommentVB" (ByVal this_object&) As String
  92. Declare Function ALEntryGetNextEntry Lib "TD20FVB" (ByVal this_object&) As Long
  93. Declare Function ALEntryGetStorage Lib "TD20FVB" (ByVal this_object&) As Long
  94. '
  95. ' ALStorage
  96. '
  97. Declare Function ALStorageGetName Lib "TD20FVB" Alias "ALStorageGetNameVB" (ByVal this_object&) As String
  98. '
  99. ' ALMonitor
  100. '
  101. Declare Sub deleteALMonitor Lib "TD20FVB" (ByVal this_object&)
  102. '
  103. ' Misc
  104. '
  105.  
  106. Global Const AL_MONITOR_OBJECTS = 0
  107. Global Const AL_MONITOR_JOB = 1
  108.  
  109. Global Const AL_SEND_BYTE_COUNT = 0
  110. Global Const AL_SEND_RATIO = 1
  111.  
  112. Global Const AL_CANT_OPEN_BUFFER = -1200
  113. Global Const AL_CANT_ALLOCATE_MEMORY = -1199
  114. Global Const AL_CANT_CREATE_ENGINE = -1198
  115. Global Const AL_CANT_CREATE_STORAGE_OBJECT = -1197
  116. Global Const AL_RENAME_ERROR = -1196
  117. Global Const AL_CANT_OPEN_FILE = -1195
  118. Global Const AL_SEEK_ERROR = -1194
  119. Global Const AL_READ_ERROR = -1193
  120. Global Const AL_WRITE_ERROR = -1192
  121. Global Const AL_DELETE_ERROR = -1191
  122. Global Const AL_ILLEGAL_PARAMETER = -1190
  123. Global Const AL_INTERNAL_ERROR = -1189
  124. Global Const AL_USER_ABORT = -1188
  125. Global Const AL_SERVER_NOT_PRESENT = -1187
  126. Global Const AL_COMPRESSION_TYPE_MISMATCH = -1186
  127. Global Const AL_NEED_LENGTH = -1185
  128. Global Const AL_CRC_ERROR = -1184
  129. Global Const AL_COMPARE_ERROR = -1183
  130. Global Const AL_UNKNOWN_COMPRESSION_TYPE = -1182
  131. Global Const AL_UNKNOWN_STORAGE_OBJECT = -1181
  132. Global Const AL_INVALID_ARCHIVE = -1180
  133. Global Const AL_LOGIC_ERROR = -1179
  134. Global Const AL_BACKUP_FAILURE = -1178
  135. Global Const AL_GETSEL_ERROR = -1177
  136. Global Const AL_DUPLICATE_ENTRY = -1176
  137. Global Const AL_END_OF_FILE = -1
  138. Global Const AL_SUCCESS = 0
  139.  
  140. Global Const AL_DEFAULT = -2
  141.  
  142. Global Const AL_TRAVERSE = 1
  143. Global Const AL_DONT_TRAVERSE = 0
  144.  
  145. Global Const AL_UPPER = 0
  146. Global Const AL_LOWER = 1
  147. Global Const AL_MIXED = 2
  148.  
  149. Global Const AL_GREENLEAF_COPY = -1
  150. Global Const AL_GREENLEAF_LEVEL_0 = 0
  151. Global Const AL_GREENLEAF_LEVEL_1 = 1
  152. Global Const AL_GREENLEAF_LEVEL_2 = 2
  153. Global Const AL_GREENLEAF_LEVEL_3 = 3
  154. Global Const AL_GREENLEAF_LEVEL_4 = 4
  155. Global Const AL_SET = " "
  156. Global AL_CLEAR As Byte
  157. Global AL_DUMMY(1) As Byte
  158.  
  159.  
  160. '
  161. '  NAME
  162. '
  163. '   ALDelete()
  164. '
  165. '  PLATFORMS/ENVIRONMENTS
  166. '
  167. '   Windows
  168. '   VB
  169. '
  170. '  SHORT DESCRIPTION
  171. '
  172. '   The simplified interface function to delete files from a ZIP file.
  173. '
  174. '  VB SYNOPSIS
  175. '
  176. '   Function ALDelete ( z() As ALZipDir,
  177. '                       ByVal text_window%,
  178. '                       ByVal file_window%,
  179. '                       ByVal job_window% ) As Integer
  180. '
  181. '  ARGUMENTS
  182. '
  183. '   z             :  The ALZipDir array.  This is the array you will have
  184. '                    have read in using ALReadDir().  Every entry in the
  185. '                    array that has a mark set will be deleted.
  186. '
  187. '   text_window   : The handle for the window that will receive
  188. '                   file names as they are processed.
  189. '
  190. '   file_window   : The handle for the window that will receive
  191. '                   updates on the percentage of each file that
  192. '                   has been processed.
  193. '
  194. '   job_window    : The handle for the window that will receive
  195. '                   updates on the percentage of the entire job that
  196. '                   has been processed.
  197. '
  198. '  DESCRIPTION
  199. '
  200. '    The simplified ALDelete function deletes the files you specified
  201. '    in the ALZipDir array.  To do this, the function has to recover
  202. '    the ALArchive pointer that is stashed in the last element of the
  203. '    array.  Then, it builds an ALEntryList that is used to call
  204. '    ALArchive::Delete().
  205. '
  206. '  RETURNS
  207. '
  208. '   AL_SUCCESS if things went well, o/w an ArchiveLib error code.
  209. '
  210. '  EXAMPLE
  211. '
  212. '  SEE ALSO
  213. '
  214. '  REVISION HISTORY
  215. '
  216. '    February 14, 1996  2.0A : New Release
  217. '
  218. '    April 2, 1996      2.01A : Had to modify the code to account for the
  219. '                               fact that ALArchiveDelete returns a count of
  220. '                               files deleted upon success, not a status
  221. '
  222. '
  223.  
  224. Public Function ALDelete(z() As ALZipDir, ByVal text_window&, ByVal file_window&, ByVal job_window&) As Long
  225.     Dim i As Long
  226.     Dim arc As Long
  227.     Dim List As Long
  228.     Dim hOutput As Long
  229.     Dim hMonitor As Long
  230.  
  231.     i = UBound(z, 1)
  232.     arc = z(i).compressed_size
  233.     hMonitor = newALSimpleMonitor(text_window, file_window, job_window)
  234.     List = newALListPkDecompressFileTools(hMonitor)
  235.     For i = LBound(z, 1) To UBound(z, 1) - 1
  236.         ALWriteDirEntryVB z(i), z(i).name, z(i).comment, List
  237.     Next
  238.     hOutput = newALPkArchive("")
  239.     i = ALArchiveDelete(arc, list, hOutput)
  240.     if i >= 0 then
  241.         ALDelete = AL_SUCCESS
  242.     else
  243.         ALDelete = i
  244.     end if
  245.     deleteALEntryList (List)
  246.     deleteALArchive (hOutput)
  247.     deleteALMonitor (hMonitor)
  248. End Function
  249.  
  250.  
  251. '
  252. '  NAME
  253. '
  254. '   ALExtract()
  255. '
  256. '  PLATFORMS/ENVIRONMENTS
  257. '
  258. '   Windows
  259. '   VB
  260. '
  261. '  SHORT DESCRIPTION
  262. '
  263. '   The simplified interface function to extract files from a ZIP file.
  264. '
  265. '  VB SYNOPSIS
  266. '
  267. '   Function ALExtract ( z() As ALZipDir,
  268. '                        ByVal strip_path,
  269. '                        ByVal text_window%,
  270. '                        ByVal file_window%,
  271. '                        ByVal job_window% ) As Integer
  272. '
  273. '  ARGUMENTS
  274. '
  275. '   z             :  The ALZipDir array.  This is the array you will have
  276. '                    have read in using ALReadDir().  Every entry in the
  277. '                    array that has a mark set will be extracted.
  278. '
  279. '   strip_path    :  If this flag is set, the files that are extracted
  280. '                    from the archive will have their paths stripped
  281. '                    before the extraction takes place.
  282. '
  283. '   text_window   : The handle for the window that will receive
  284. '                   file names as they are processed.
  285. '
  286. '   file_window   : The handle for the window that will receive
  287. '                   updates on the percentage of each file that
  288. '                   has been processed.
  289. '
  290. '   job_window    : The handle for the window that will receive
  291. '                   updates on the percentage of the entire job that
  292. '                   has been processed.
  293. '
  294. '  DESCRIPTION
  295. '
  296. '    The simplified ALExtract function extracts the files you specified
  297. '    in the ALZipDir array.  To do this, the function has to recover
  298. '    the ALArchive pointer that is stashed in the last element of the
  299. '    array.  Then, it builds an ALEntryList that is used to call
  300. '    ALArchive::Extract().
  301. '
  302. '  RETURNS
  303. '
  304. '   AL_SUCCESS if things went well, o/w an ArchiveLib error code.
  305. '
  306. '  EXAMPLE
  307. '
  308. '  SEE ALSO
  309. '
  310. '  REVISION HISTORY
  311. '
  312. '    February 14, 1996  2.0A : New Release
  313. '
  314. '    April 2, 1996      2.01A : Had to modify the code to account for the
  315. '                               fact that ALArchiveExtract returns a count of
  316. '                               files extracted upon success, not a status.
  317. '
  318.  
  319. Public Function ALExtract(z() As ALZipDir, ByVal strip_path, ByVal text_window&, ByVal file_window&, ByVal job_window&) As Long
  320.     Dim i As Long
  321.     Dim arc As Long
  322.     Dim List As Long
  323.     Dim hMonitor As Long
  324.  
  325.     i = UBound(z, 1)
  326.     arc = z(i).compressed_size
  327.     hMonitor = newALSimpleMonitor(text_window, file_window, job_window)
  328.     List = newALListPkDecompressFileTools(hMonitor)
  329.     For i = LBound(z, 1) To UBound(z, 1) - 1
  330.         ALWriteDirEntryVB z(i), z(i).name, z(i).comment, List
  331.     Next
  332.     ALArchiveSetStripOnExtract arc, strip_path
  333.     i = ALArchiveExtract(arc, list)
  334.     if i >= 0 then
  335.         ALExtract = AL_SUCCESS
  336.     else
  337.         ALExtract = i
  338.     end if
  339.     deleteALEntryList (List)
  340.     deleteALMonitor (hMonitor)
  341. End Function
  342.  
  343. '
  344. '  NAME
  345. '
  346. '   ALFreeDir()
  347. '
  348. '  PLATFORMS/ENVIRONMENTS
  349. '
  350. '   Windows
  351. '   VB
  352. '
  353. '  SHORT DESCRIPTION
  354. '
  355. '   The simplified interface function frees the memory allocated for
  356. '   an ALZipDir.
  357. '
  358. '  VB SYNOPSIS
  359. '
  360. '   Sub ALFreeDir (z() As ALZipDir)
  361. '
  362. '  ARGUMENTS
  363. '
  364. '   z             :  The ALZipDir array.  This is the array you will have
  365. '                    have read in using ALReadDir().
  366. '
  367. '  DESCRIPTION
  368. '
  369. '   Any time you read in the directory from a PKZIP file using ALReadDir(),
  370. '   you must eventually delete it using this function.  It takes care of
  371. '   freeing up the space used by the array itself, by the file names, the
  372. '   file comments, the archive comment, and the archive object itself.
  373. '   Under VB, a simple Redim to size 0 takes care of almost everything,
  374. '   and the interface function deleteALArchive() does the rest.
  375. '
  376. '  RETURNS
  377. '
  378. '   Nothing.
  379. '
  380. '  EXAMPLE
  381. '
  382. '  SEE ALSO
  383. '
  384. '  REVISION HISTORY
  385. '
  386. '    February 14, 1996  2.0A : New Release
  387. '
  388. Public Sub ALFreeDir(z() As ALZipDir)
  389.     Dim i As Long
  390.     Dim arc As Long
  391.     i = UBound(z, 1)
  392.     arc = z(i).compressed_size
  393.     If arc <> 0 Then deleteALArchive (arc)
  394.     ReDim z(0)
  395.     i = UBound(z, 1)
  396.     z(i).compressed_size = 0
  397. End Sub
  398.  
  399. '
  400. '  NAME
  401. '
  402. '   ALReadDir()
  403. '
  404. '  PLATFORMS/ENVIRONMENTS
  405. '
  406. '   Windows
  407. '   VB
  408. '
  409. '  SHORT DESCRIPTION
  410. '
  411. '   The simplified interface function reads in the directory of a ZIP file.
  412. '
  413. '  VB SYNOPSIS
  414. '
  415. '   Sub ALReadDir ( z() As ALZipDir,
  416. '                   ByVal filename As String,
  417. '                   count%,
  418. '                   status% )
  419. '
  420. '  ARGUMENTS
  421. '
  422. '   z()           :  An array of type ALZipDir.  If there is anything
  423. '                    in the array at the time of this function
  424. '                    call, it will be deleted.
  425. '
  426. '   filename      :  The name of the zip archive whose directory
  427. '                    you want to read.
  428. '
  429. '   count         :  The integer that is going to receive the count of
  430. '                    items in the directory.
  431. '
  432. '   error         :  The integer that is going to receive the status from
  433. '                    the ALReadDir operation.
  434. '
  435. '  DESCRIPTION
  436. '
  437. '   This function reads in the directory information from a ZIP
  438. '   file, then takes each entry and inserts it into an ALZipDir array.
  439. '   This means it has to take each record and reformat the data so
  440. '   that it fits in this fixed array.  Formatting the array is
  441. '   mostly done by a C++ helper function called ALReadDirEntry().
  442. '
  443. '  RETURNS
  444. '
  445. '   Nothing.
  446. '
  447. '  EXAMPLE
  448. '
  449. '  SEE ALSO
  450. '
  451. '  REVISION HISTORY
  452. '
  453. '    February 14, 1996  2.0A : New Release
  454. '
  455.  
  456. Public Sub ALReadDir(z() As ALZipDir, ByVal FileName As String, count&, status&)
  457.   Dim hArchive As Long
  458.   Dim hList As Long
  459.   Dim hEntry As Long
  460.   Dim hStorage As Long
  461.  
  462.   Dim i As Long
  463.   Dim top As Long
  464.  
  465.   hArchive = newALPkArchive(FileName)
  466.   hList = newALListPkDecompressFileTools(0)
  467.   status& = ALArchiveReadDirectory(hArchive, hList)
  468.   ReDim z(0 To 9)
  469.   top = 9
  470.   i = LBound(z, 1)
  471.   hEntry = ALEntryListGetFirstEntry(hList)
  472.   While hEntry <> 0
  473.       If i > top Then
  474.         top = top + 10
  475.         ReDim Preserve z(0 To top)
  476.         top = UBound(z, 1)
  477.       End If
  478.       hStorage = ALEntryGetStorage(hEntry)
  479.       z(i).name = ALStorageGetName(hStorage)
  480.       z(i).comment = ALEntryGetComment(hEntry)
  481.       ALReadDirEntryVB z(i), hEntry
  482.       i = i + 1
  483.       hEntry = ALEntryGetNextEntry(hEntry)
  484.   Wend
  485.   ReDim Preserve z(0 To i)
  486.   z(i).size = -1
  487.   z(i).compressed_size = hArchive 'The cute part
  488.   z(i).comment = ALArchiveGetComment(hArchive)
  489.   z(i).name = FileName
  490.   count& = i
  491.   deleteALEntryList (hList)
  492. End Sub
  493.  
  494. '
  495. '  NAME
  496. '
  497. '   ALWriteDir()
  498. '
  499. '  PLATFORMS/ENVIRONMENTS
  500. '
  501. '   Windows
  502. '   VB
  503. '
  504. '  SHORT DESCRIPTION
  505. '
  506. '   This function writes an ALZipDir array out to a ZIP file.
  507. '
  508. '  VB SYNOPSIS
  509. '
  510. '   Function ALWriteDir (z() As ALZipDir) As Integer
  511. '
  512. '  ARGUMENTS
  513. '
  514. '   z             :  An ALZipDir array.  The contents of
  515. '                    this array are going to be written out to the
  516. '                    ZIP file, completely replacing its present directory.
  517. '
  518. '  DESCRIPTION
  519. '
  520. '   This function writes a new directory out to a ZIP file.  This is
  521. '   a reasonable thing to do if you read in the directory from the same
  522. '   ZIP file, and have udpated some file names, comments, permission
  523. '   bits, etc.
  524. '
  525. '  RETURNS
  526. '
  527. '   A standard ArchiveLib return, AL_SUCCESS if things went well, and
  528. '   something < 0 if things went bad.
  529. '
  530. '  EXAMPLE
  531. '
  532. '  SEE ALSO
  533. '
  534. '  REVISION HISTORY
  535. '
  536. '    February 14, 1996  2.0A : New Release
  537. '
  538.  
  539. Public Function ALWriteDir(z() As ALZipDir) As Long
  540.     Dim i As Long
  541.     Dim arc As Long
  542.     Dim List As Long
  543.  
  544.     i = UBound(z, 1)
  545.     arc = z(i).compressed_size
  546.     List = newALListPkDecompressFileTools(0)
  547.     For i = LBound(z, 1) To UBound(z, 1) - 1
  548.         ALWriteDirEntryVB z(i), z(i).name, z(i).comment, List
  549.     Next
  550.     i = ALArchiveSetComment(arc, z(i).comment)
  551.     ALWriteDir = ALArchiveWriteDirectory(arc, List)
  552.     deleteALEntryList (List)
  553. End Function
  554.  
  555. Public Function DLLName() As String
  556.   DLLName = ".\TD20FVB.DLL"
  557. End Function
  558.  
  559.