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