|
Option Explicit
Private Type ACEBlockHead HEAD_CRC As Integer HEAD_SIZE As Integer HEAD_TYPE As Byte HEAD_FLAGS As Integer End Type Public Function InspectACEArchiveFast(sFile As String, _ ByRef lMilliSeconds As Long, _ ByRef lNumFiles As Long, _ ByRef dblUnpackedBytes As Double, _ lblArchive As Label) As Boolean On Error GoTo ErrExit Dim F As Long ' file handle Dim lFileSize As Long ' size of file Dim tBlockHead As ACEBlockHead ' Block-header Dim bADDSIZEField As Boolean ' header contains ADDSIZE Field Dim bMultVolume As Boolean ' indicated multiple volumne Dim lHeadSize As Long ' size of Block-Header Dim lADDSIZE As Long ' Value of ADDSIZE-Field Dim lNextOffset As Long ' Offset of next Block-Header Dim lVolNum As Long ' Number of current volume Dim sFilename As String ' name of archive Dim bReadNextArchive As Boolean ' to control loop Dim lATTR As Long ' File-Attributes Dim lUnpackedBytes As Long ' unpacked-bytes of file ' open exe-file StartTimer ' copy Filename to local-variable cause it's changed sFilename = sFile ' reset Volume-number lVolNum = -1& ' loop over all files of multiple archive Do ' start at file offset 0 lNextOffset = 0& ' get file-handle F = FreeFile(1) ' open file Open sFilename For Binary Access Read Shared As #F ' get size of file lFileSize = LOF(F) If lFileSize > 0 Then If Not lblArchive Is Nothing Then lblArchive.Caption = Mid$(sFilename, modIni.RInstr(sFilename, "\") + 1) lblArchive.Refresh End If End If ' read all block-headers Do While lNextOffset < lFileSize If Not ReadBlockHead(F, tBlockHead, _ bADDSIZEField, _ bMultVolume) Then GoTo ErrExit ' convert header-size from unsigned integer to long ' if the 16-bit value HEAD_SIZE is greater than 32767 ' VB interprets this a negative number ' Therefore the negative number is first converted into ' a Long via the CLng function. This results in a long ' negative number. The value is then masked to remove the ' high 16 bits. The result is a positive 16-bit number in ' a long variable lHeadSize = (CLng(tBlockHead.HEAD_SIZE) And &HFFFF&) If bADDSIZEField Then ' if ADDSIZE-Field is present read it Get #F, , lADDSIZE ' and calculate the next header-offset ' HEAD_SIZE contains the total size of the header ' starting with the HEAD_TYPE field. ' Because we've already read the HEAD_TYPE and ' HEAD_FLAGS fields (3 bytes) and we also read ' the ADDSIZE field (4 bytes) we have the subtract ' 7 bytes from the total header size. lNextOffset = Seek(F) + lHeadSize - 7& + lADDSIZE Else ' Calculate the next header-offset ' HEAD_SIZE contains the total size of the header ' starting with the HEAD_TYPE field. ' Because we've already read the HEAD_TYPE and ' HEAD_FLAGS fields (3 bytes) we have the subtract ' 3 bytes from the total header size. lNextOffset = Seek(F) + lHeadSize - 3& End If ' do different things according to the block-type Select Case tBlockHead.HEAD_TYPE Case 0 ' Archive header ' set flag whether we have to read another volume-file bReadNextArchive = bMultVolume Case 1 ' file block ' ignore all files which are continued from a ' previous volume If (tBlockHead.HEAD_FLAGS And &H1000) = 0 Then ' file continued flag not set ' read the file-header to get attributes and unpacked-sized If Not ReadFileHead(F, tBlockHead, _ lATTR, _ lUnpackedBytes) Then GoTo ErrExit ' ignore directories If lATTR <> vbDirectory Then ' count number of files and ' count unpacked bytes into a double variable ' A long may be to small to keep the value dblUnpackedBytes = dblUnpackedBytes + CDbl(lUnpackedBytes) lNumFiles = lNumFiles + 1 End If End If Case 2 ' recovery record ' ignore recovery record ' this is assumed to be at the end of the archive ' stop reading lNextOffset = lFileSize End Select ' set next read position to calculated offset Seek #F, lNextOffset Loop ' close this archive file Close #F If bReadNextArchive Then ' if this is a multiple volume build next volume name ' Cut off the extension and replace it with the next volume-number lVolNum = lVolNum + 1 sFilename = Left$(sFilename, modIni.RInstr(sFilename, ".")) & _ "C" & Format(lVolNum, "00") End If ' if the filename built above does not exist ' lFileSize will be 0 Loop While bReadNextArchive And lFileSize > 0 InspectACEArchiveFast = True lMilliSeconds = MeasureTime Exit Function ErrExit: ShowError On Error Resume Next Close #F Exit Function End Function Private Function ReadBlockHead(F As Long, _ ByRef tBlockHead As ACEBlockHead, _ ByRef bADDSIZEField As Boolean, _ ByRef bMultVolume As Boolean) As Boolean On Error GoTo ErrExit Get #F, , tBlockHead bADDSIZEField = CBool(tBlockHead.HEAD_FLAGS And &H1) bMultVolume = CBool(tBlockHead.HEAD_FLAGS And &H800) ReadBlockHead = True Exit Function ErrExit: ShowError Exit Function End Function Private Function ReadFileHead(F As Long, _ ByRef tBlockHead As ACEBlockHead, _ ByRef lATTR As Long, _ ByRef lUnpackedBytes As Long) As Boolean On Error GoTo ErrExit Dim sFNAME As String Get #F, , lUnpackedBytes ' read the FTIME-Field into the lATTR variable Get #F, , lATTR ' read the ATTR-Field into the lATTR variable Get #F, , lATTR ReadFileHead = True Exit Function ErrExit: ShowError Exit Function End Function ' ------------------------------------------------------- ' DLL- Version ' ------------------------------------------------------- Public Function InspectACEArchiveDLL(sFile As String, _ ByRef lMilliSeconds As Long, _ ByRef lNumFiles As Long, _ ByRef dblUnpackedBytes As Double, _ lblArchiv As Label) As Boolean On Error GoTo ErrExit Dim hArchive As Long Dim tHeaderdata As ACEHEADERDATA Dim lVolNum As Long Dim sFilename As String Dim bMultVolume As Boolean StartTimer sFilename = sFile lVolNum = -1& Do hArchive = modAce.OpenACEArchive(sFilename, ACEOPEN_LIST, bMultVolume) If hArchive = 0 Then Exit Do While ACEReadHeader(hArchive, tHeaderdata) = 0 If Not lblArchiv Is Nothing Then lblArchiv.Caption = modIni.LiesArchiv(tHeaderdata.Arcname) lblArchiv.Refresh End If ACEProcessFile hArchive, ACECMD_SKIP, vbNull If (tHeaderdata.flags And &H1000) = 0 Then ' file continued flag not set If tHeaderdata.FileAttr <> vbDirectory Then lNumFiles = lNumFiles + 1& dblUnpackedBytes = dblUnpackedBytes + tHeaderdata.UnpSize End If End If Wend ACECloseArchive hArchive If bMultVolume Then lVolNum = lVolNum + 1 sFilename = Left$(sFilename, modIni.RInstr(sFilename, ".")) & _ "C" & Format(lVolNum, "00") End If Loop While bMultVolume InspectACEArchiveDLL = True lMilliSeconds = MeasureTime Exit Function ErrExit: ShowError On Error Resume Next ACECloseArchive hArchive Exit Function End Function ################################################################## EntPacker für Ace, Rar, Zip Copyright Emil Weiss für Testzwecke freigestellt emil.weiss@koeln.netsurf.de http://koeln.netsurf.de/~emil.weiss (Only IE4 or later) ################################################################## |