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