home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 31
/
CDASC_31_1996_juillet_aout.iso
/
vrac
/
altd201a.zip
/
VB4032.ARJ
/
VB40.32
/
ARCLIBD.BAS
< prev
next >
Wrap
BASIC Source File
|
1996-04-19
|
16KB
|
559 lines
Attribute VB_Name = "Module1"
'
' ARCLIB.BAS
'
' Header file for ArchiveLib 2.0
'
' Copyright (c) 1994-1996 Greenleaf Software, Inc.
' All Rights Reserved
'
' DESCRIPTION
'
' This file contains the entire definition of ArchiveLib as used with
' Visual Basic 4.0. It also contains a few wrapper functions
'
' FUNCTIONS
'
' ALDelete()
' ALExtract()
' ALFreeDir()
' ALReadDir()
' ALWriteDir()
'
' REVISION HISTORY
'
' February 14, 1996 2.0A : New release
'
Option Explicit
'
' Lifted from WIN32API.TXT
'
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
'
' Simplified API
'
'
' ALZipDir is the structure used to hold a PKZIP directory.
'
Public Type ALZipDir
name As String
comment As String
compressed_size As Long
compressed_position As Long
size As Long
crc As Long
mark As Integer
month As Integer
date As Integer
year As Integer
hour As Integer
minute As Integer
second As Integer
'
' These need to be String * 1 in VB30
'
r As Byte
a As Byte
s As Byte
h As Byte
d As Byte
level As Byte
End Type
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
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
Declare Function newALSimpleMonitor Lib "TD20FVB" (ByVal text_window&, ByVal file_progress_window&, ByVal job_progress_window&) As Long
Declare Sub ALReadDirEntryVB Lib "TD20FVB" (z As ALZipDir, ByVal entry&)
Declare Sub ALWriteDirEntryVB Lib "TD20FVB" (z As ALZipDir, ByVal FileName$, ByVal comment$, ByVal List&)
'
' ALArchive
'
Declare Function newALPkArchive Lib "TD20FVB" (ByVal file_name$) As Long
Declare Function ALArchiveSetComment Lib "TD20FVB" (ByVal this_object&, ByVal comment$) As Long
Declare Function ALArchiveWriteDirectory Lib "TD20FVB" (ByVal this_object&, ByVal List&) As Long
Declare Sub deleteALArchive Lib "TD20FVB" (ByVal this_object&)
Declare Function ALArchiveDelete Lib "TD20FVB" (ByVal this_object&, ByVal List&, ByVal object_archive&) As Long
Declare Function ALArchiveExtract Lib "TD20FVB" (ByVal this_object&, ByVal List&) As Long
Declare Function ALArchiveGetStorage Lib "TD20FVB" (ByVal Archive&) As Long
Declare Sub ALArchiveSetStripOnExtract Lib "TD20FVB" (ByVal this_object&, ByVal flag&)
Declare Function ALArchiveGetComment Lib "TD20FVB" Alias "ALArchiveGetCommentVB" (ByVal this_object&) As String
Declare Function ALArchiveReadDirectory Lib "TD20FVB" (ByVal this_object&, ByVal List&) As Long
'
' ALEntryList
'
Declare Function newALListPkCompressFileTools Lib "TD20FVB" (ByVal Monitor&, ByVal level&, ByVal window_bits&, ByVal mem_level&) As Long
Declare Function newALListPkDecompressFileTools Lib "TD20FVB" (ByVal Monitor&) As Long
Declare Sub deleteALEntryList Lib "TD20FVB" (ByVal this_object&)
Declare Function ALEntryListGetFirstEntry Lib "TD20FVB" (ByVal this_object&) As Long
'
' ALEntry
'
Declare Function ALEntryGetComment Lib "TD20FVB" Alias "ALEntryGetCommentVB" (ByVal this_object&) As String
Declare Function ALEntryGetNextEntry Lib "TD20FVB" (ByVal this_object&) As Long
Declare Function ALEntryGetStorage Lib "TD20FVB" (ByVal this_object&) As Long
'
' ALStorage
'
Declare Function ALStorageGetName Lib "TD20FVB" Alias "ALStorageGetNameVB" (ByVal this_object&) As String
'
' ALMonitor
'
Declare Sub deleteALMonitor Lib "TD20FVB" (ByVal this_object&)
'
' Misc
'
Global Const AL_MONITOR_OBJECTS = 0
Global Const AL_MONITOR_JOB = 1
Global Const AL_SEND_BYTE_COUNT = 0
Global Const AL_SEND_RATIO = 1
Global Const AL_CANT_OPEN_BUFFER = -1200
Global Const AL_CANT_ALLOCATE_MEMORY = -1199
Global Const AL_CANT_CREATE_ENGINE = -1198
Global Const AL_CANT_CREATE_STORAGE_OBJECT = -1197
Global Const AL_RENAME_ERROR = -1196
Global Const AL_CANT_OPEN_FILE = -1195
Global Const AL_SEEK_ERROR = -1194
Global Const AL_READ_ERROR = -1193
Global Const AL_WRITE_ERROR = -1192
Global Const AL_DELETE_ERROR = -1191
Global Const AL_ILLEGAL_PARAMETER = -1190
Global Const AL_INTERNAL_ERROR = -1189
Global Const AL_USER_ABORT = -1188
Global Const AL_SERVER_NOT_PRESENT = -1187
Global Const AL_COMPRESSION_TYPE_MISMATCH = -1186
Global Const AL_NEED_LENGTH = -1185
Global Const AL_CRC_ERROR = -1184
Global Const AL_COMPARE_ERROR = -1183
Global Const AL_UNKNOWN_COMPRESSION_TYPE = -1182
Global Const AL_UNKNOWN_STORAGE_OBJECT = -1181
Global Const AL_INVALID_ARCHIVE = -1180
Global Const AL_LOGIC_ERROR = -1179
Global Const AL_BACKUP_FAILURE = -1178
Global Const AL_GETSEL_ERROR = -1177
Global Const AL_DUPLICATE_ENTRY = -1176
Global Const AL_END_OF_FILE = -1
Global Const AL_SUCCESS = 0
Global Const AL_DEFAULT = -2
Global Const AL_TRAVERSE = 1
Global Const AL_DONT_TRAVERSE = 0
Global Const AL_UPPER = 0
Global Const AL_LOWER = 1
Global Const AL_MIXED = 2
Global Const AL_GREENLEAF_COPY = -1
Global Const AL_GREENLEAF_LEVEL_0 = 0
Global Const AL_GREENLEAF_LEVEL_1 = 1
Global Const AL_GREENLEAF_LEVEL_2 = 2
Global Const AL_GREENLEAF_LEVEL_3 = 3
Global Const AL_GREENLEAF_LEVEL_4 = 4
Global Const AL_SET = " "
Global AL_CLEAR As Byte
Global AL_DUMMY(1) As Byte
'
' NAME
'
' ALDelete()
'
' PLATFORMS/ENVIRONMENTS
'
' Windows
' VB
'
' SHORT DESCRIPTION
'
' The simplified interface function to delete files from a ZIP file.
'
' VB SYNOPSIS
'
' Function ALDelete ( z() As ALZipDir,
' ByVal text_window%,
' ByVal file_window%,
' ByVal job_window% ) As Integer
'
' ARGUMENTS
'
' z : The ALZipDir array. This is the array you will have
' have read in using ALReadDir(). Every entry in the
' array that has a mark set will be deleted.
'
' text_window : The handle for the window that will receive
' file names as they are processed.
'
' file_window : The handle for the window that will receive
' updates on the percentage of each file that
' has been processed.
'
' job_window : The handle for the window that will receive
' updates on the percentage of the entire job that
' has been processed.
'
' DESCRIPTION
'
' The simplified ALDelete function deletes the files you specified
' in the ALZipDir array. To do this, the function has to recover
' the ALArchive pointer that is stashed in the last element of the
' array. Then, it builds an ALEntryList that is used to call
' ALArchive::Delete().
'
' RETURNS
'
' AL_SUCCESS if things went well, o/w an ArchiveLib error code.
'
' EXAMPLE
'
' SEE ALSO
'
' REVISION HISTORY
'
' February 14, 1996 2.0A : New Release
'
' April 2, 1996 2.01A : Had to modify the code to account for the
' fact that ALArchiveDelete returns a count of
' files deleted upon success, not a status
'
'
Public Function ALDelete(z() As ALZipDir, ByVal text_window&, ByVal file_window&, ByVal job_window&) As Long
Dim i As Long
Dim arc As Long
Dim List As Long
Dim hOutput As Long
Dim hMonitor As Long
i = UBound(z, 1)
arc = z(i).compressed_size
hMonitor = newALSimpleMonitor(text_window, file_window, job_window)
List = newALListPkDecompressFileTools(hMonitor)
For i = LBound(z, 1) To UBound(z, 1) - 1
ALWriteDirEntryVB z(i), z(i).name, z(i).comment, List
Next
hOutput = newALPkArchive("")
i = ALArchiveDelete(arc, list, hOutput)
if i >= 0 then
ALDelete = AL_SUCCESS
else
ALDelete = i
end if
deleteALEntryList (List)
deleteALArchive (hOutput)
deleteALMonitor (hMonitor)
End Function
'
' NAME
'
' ALExtract()
'
' PLATFORMS/ENVIRONMENTS
'
' Windows
' VB
'
' SHORT DESCRIPTION
'
' The simplified interface function to extract files from a ZIP file.
'
' VB SYNOPSIS
'
' Function ALExtract ( z() As ALZipDir,
' ByVal strip_path,
' ByVal text_window%,
' ByVal file_window%,
' ByVal job_window% ) As Integer
'
' ARGUMENTS
'
' z : The ALZipDir array. This is the array you will have
' have read in using ALReadDir(). Every entry in the
' array that has a mark set will be extracted.
'
' strip_path : If this flag is set, the files that are extracted
' from the archive will have their paths stripped
' before the extraction takes place.
'
' text_window : The handle for the window that will receive
' file names as they are processed.
'
' file_window : The handle for the window that will receive
' updates on the percentage of each file that
' has been processed.
'
' job_window : The handle for the window that will receive
' updates on the percentage of the entire job that
' has been processed.
'
' DESCRIPTION
'
' The simplified ALExtract function extracts the files you specified
' in the ALZipDir array. To do this, the function has to recover
' the ALArchive pointer that is stashed in the last element of the
' array. Then, it builds an ALEntryList that is used to call
' ALArchive::Extract().
'
' RETURNS
'
' AL_SUCCESS if things went well, o/w an ArchiveLib error code.
'
' EXAMPLE
'
' SEE ALSO
'
' REVISION HISTORY
'
' February 14, 1996 2.0A : New Release
'
' April 2, 1996 2.01A : Had to modify the code to account for the
' fact that ALArchiveExtract returns a count of
' files extracted upon success, not a status.
'
Public Function ALExtract(z() As ALZipDir, ByVal strip_path, ByVal text_window&, ByVal file_window&, ByVal job_window&) As Long
Dim i As Long
Dim arc As Long
Dim List As Long
Dim hMonitor As Long
i = UBound(z, 1)
arc = z(i).compressed_size
hMonitor = newALSimpleMonitor(text_window, file_window, job_window)
List = newALListPkDecompressFileTools(hMonitor)
For i = LBound(z, 1) To UBound(z, 1) - 1
ALWriteDirEntryVB z(i), z(i).name, z(i).comment, List
Next
ALArchiveSetStripOnExtract arc, strip_path
i = ALArchiveExtract(arc, list)
if i >= 0 then
ALExtract = AL_SUCCESS
else
ALExtract = i
end if
deleteALEntryList (List)
deleteALMonitor (hMonitor)
End Function
'
' NAME
'
' ALFreeDir()
'
' PLATFORMS/ENVIRONMENTS
'
' Windows
' VB
'
' SHORT DESCRIPTION
'
' The simplified interface function frees the memory allocated for
' an ALZipDir.
'
' VB SYNOPSIS
'
' Sub ALFreeDir (z() As ALZipDir)
'
' ARGUMENTS
'
' z : The ALZipDir array. This is the array you will have
' have read in using ALReadDir().
'
' DESCRIPTION
'
' Any time you read in the directory from a PKZIP file using ALReadDir(),
' you must eventually delete it using this function. It takes care of
' freeing up the space used by the array itself, by the file names, the
' file comments, the archive comment, and the archive object itself.
' Under VB, a simple Redim to size 0 takes care of almost everything,
' and the interface function deleteALArchive() does the rest.
'
' RETURNS
'
' Nothing.
'
' EXAMPLE
'
' SEE ALSO
'
' REVISION HISTORY
'
' February 14, 1996 2.0A : New Release
'
Public Sub ALFreeDir(z() As ALZipDir)
Dim i As Long
Dim arc As Long
i = UBound(z, 1)
arc = z(i).compressed_size
If arc <> 0 Then deleteALArchive (arc)
ReDim z(0)
i = UBound(z, 1)
z(i).compressed_size = 0
End Sub
'
' NAME
'
' ALReadDir()
'
' PLATFORMS/ENVIRONMENTS
'
' Windows
' VB
'
' SHORT DESCRIPTION
'
' The simplified interface function reads in the directory of a ZIP file.
'
' VB SYNOPSIS
'
' Sub ALReadDir ( z() As ALZipDir,
' ByVal filename As String,
' count%,
' status% )
'
' ARGUMENTS
'
' z() : An array of type ALZipDir. If there is anything
' in the array at the time of this function
' call, it will be deleted.
'
' filename : The name of the zip archive whose directory
' you want to read.
'
' count : The integer that is going to receive the count of
' items in the directory.
'
' error : The integer that is going to receive the status from
' the ALReadDir operation.
'
' DESCRIPTION
'
' This function reads in the directory information from a ZIP
' file, then takes each entry and inserts it into an ALZipDir array.
' This means it has to take each record and reformat the data so
' that it fits in this fixed array. Formatting the array is
' mostly done by a C++ helper function called ALReadDirEntry().
'
' RETURNS
'
' Nothing.
'
' EXAMPLE
'
' SEE ALSO
'
' REVISION HISTORY
'
' February 14, 1996 2.0A : New Release
'
Public Sub ALReadDir(z() As ALZipDir, ByVal FileName As String, count&, status&)
Dim hArchive As Long
Dim hList As Long
Dim hEntry As Long
Dim hStorage As Long
Dim i As Long
Dim top As Long
hArchive = newALPkArchive(FileName)
hList = newALListPkDecompressFileTools(0)
status& = ALArchiveReadDirectory(hArchive, hList)
ReDim z(0 To 9)
top = 9
i = LBound(z, 1)
hEntry = ALEntryListGetFirstEntry(hList)
While hEntry <> 0
If i > top Then
top = top + 10
ReDim Preserve z(0 To top)
top = UBound(z, 1)
End If
hStorage = ALEntryGetStorage(hEntry)
z(i).name = ALStorageGetName(hStorage)
z(i).comment = ALEntryGetComment(hEntry)
ALReadDirEntryVB z(i), hEntry
i = i + 1
hEntry = ALEntryGetNextEntry(hEntry)
Wend
ReDim Preserve z(0 To i)
z(i).size = -1
z(i).compressed_size = hArchive 'The cute part
z(i).comment = ALArchiveGetComment(hArchive)
z(i).name = FileName
count& = i
deleteALEntryList (hList)
End Sub
'
' NAME
'
' ALWriteDir()
'
' PLATFORMS/ENVIRONMENTS
'
' Windows
' VB
'
' SHORT DESCRIPTION
'
' This function writes an ALZipDir array out to a ZIP file.
'
' VB SYNOPSIS
'
' Function ALWriteDir (z() As ALZipDir) As Integer
'
' ARGUMENTS
'
' z : An ALZipDir array. The contents of
' this array are going to be written out to the
' ZIP file, completely replacing its present directory.
'
' DESCRIPTION
'
' This function writes a new directory out to a ZIP file. This is
' a reasonable thing to do if you read in the directory from the same
' ZIP file, and have udpated some file names, comments, permission
' bits, etc.
'
' RETURNS
'
' A standard ArchiveLib return, AL_SUCCESS if things went well, and
' something < 0 if things went bad.
'
' EXAMPLE
'
' SEE ALSO
'
' REVISION HISTORY
'
' February 14, 1996 2.0A : New Release
'
Public Function ALWriteDir(z() As ALZipDir) As Long
Dim i As Long
Dim arc As Long
Dim List As Long
i = UBound(z, 1)
arc = z(i).compressed_size
List = newALListPkDecompressFileTools(0)
For i = LBound(z, 1) To UBound(z, 1) - 1
ALWriteDirEntryVB z(i), z(i).name, z(i).comment, List
Next
i = ALArchiveSetComment(arc, z(i).comment)
ALWriteDir = ALArchiveWriteDirectory(arc, List)
deleteALEntryList (List)
End Function
Public Function DLLName() As String
DLLName = ".\TD20FVB.DLL"
End Function