VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "Archive Explorer"
ClientHeight = 4710
ClientLeft = 45
ClientTop = 330
ClientWidth = 13245
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4710
ScaleWidth = 13245
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton btnUnzip
Caption = "Extract selected ones"
Height = 375
Left = 4200
TabIndex = 4
Top = 4200
Width = 9015
End
Begin VB.FileListBox FileList
Height = 3990
Left = 2040
TabIndex = 2
Top = 120
Width = 2055
End
Begin VB.DirListBox DirList
Height = 3465
Left = 120
TabIndex = 1
Top = 120
Width = 1935
End
Begin VB.DriveListBox DriveList
Height = 315
Left = 120
TabIndex = 0
Top = 3720
Width = 1935
End
Begin MSComctlLib.ListView lstInZip
Height = 3615
Left = 4080
TabIndex = 3
Top = 480
Width = 9135
_ExtentX = 16113
_ExtentY = 6376
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin VB.Label lblHeadLine
Height = 255
Left = 4200
TabIndex = 5
Top = 120
Width = 9015
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'## project:DisableMessages CodeAnalysis
'## project:DisableMessage 0354
'## project:DisableMessage 0364
Option Explicit
Dim ZF As New Cls_GetFileType
Private Filetype(10) As String
Private Sub btnUnzip_Click()
Dim FileUnzip() As Boolean
Dim ToDir As String
Dim Sel As Boolean
Dim X As Long
Dim RetVal As Boolean
With lstInZip
ReDim FileUnzip(.ListItems.Count)
For X = 1 To .ListItems.Count
If .ListItems(X).Selected Then
Sel = True
Exit For
End If
Next
For X = 1 To .ListItems.Count
If .ListItems(X).Selected = Sel Then
FileUnzip(X) = True
End If
Next
End With
ToDir = tsGetPathFromUser
If ToDir = "" Then
MsgBox "No path to store files"
Exit Sub
End If
MousePointer = vbHourglass
RetVal = ZF.UnPack(FileUnzip, ToDir)
' RetVal = ZF.Unzip(FileUnzip, ToDir)
MousePointer = vbNormal
End Sub
Private Sub DirList_Change()
FileList.Path = DirList.Path
End Sub
Private Sub DriveList_Change()
DirList.Path = DriveList.Drive
End Sub
Private Sub FileList_Click()
If FileList.FileName <> "" Then
lstInZip.ListItems.Clear
Call Show_ZipContents
If Len(ZF.CommentsPack) > 0 Then
MsgBox ZF.CommentsPack
End If
End If
End Sub
Private Sub Show_ZipContents()
Dim X As Long
Dim Enc As String
Dim DirCnt As Long
Dim FileCnt As Long
Dim Temp As Long
ZF.Get_Contents (DirList.Path & "\" & FileList.FileName)
For X = 1 To lstInZip.ListItems.Count
lstInZip.ListItems(X).Selected = False
Next
For X = 1 To ZF.FileCount
With lstInZip
Enc = " "
If ZF.Encrypted(X) Then Enc = "+"
If Not ZF.IsDir(X) Then
FileCnt = FileCnt + 1
.ListItems.Add X, , Enc & ZF.FileName(X)
.ListItems(X).SubItems(1) = ZF.Method(X)
Temp = ZF.CRC32(X)
If Temp = 0 Then
.ListItems(X).SubItems(2) = "?"
Else
.ListItems(X).SubItems(2) = Hex(Temp)
End If
Temp = ZF.Compressed_Size(X)
If Temp = 0 Then
.ListItems(X).SubItems(3) = "?"
Else
.ListItems(X).SubItems(3) = Temp
End If
.ListItems(X).SubItems(4) = ZF.UnCompressed_Size(X)
.ListItems(X).SubItems(5) = ZF.FileDateTime(X)
Else
DirCnt = DirCnt + 1
.ListItems.Add X, , Enc & ZF.FileName(X)
.ListItems(X).SubItems(1) = ZF.Method(X)
.ListItems(X).SubItems(2) = "Directory Entry"
.ListItems(X).SubItems(3) = "Directory Entry"
.ListItems(X).SubItems(4) = "Directory Entry"
.ListItems(X).SubItems(5) = ZF.FileDateTime(X)
End If
End With
Next
If ZF.FileCount > 0 Then
lblHeadLine.Caption = "Contents of " & Filetype(PackFileType) & " file " & _
FileList.FileName & " -> " & _
DirCnt & " directories and " & _
FileCnt & " files"
Else
lblHeadLine.Caption = "Not supported format"
End If
If ZF.CanUnpack Then
btnUnzip.Enabled = True
Else
btnUnzip.Enabled = False
End If
End Sub
Private Sub Form_Load()
Call Insert_Header
' FileList.Pattern = "*.zip;*.gz;*.tgz;*.tar;*.arj"
Filetype(ZipFileType) = "ZIP"
Filetype(GZFileType) = "GZIP"
Filetype(TARFileType) = "TAR"
Filetype(RARFileType) = "RAR"
Filetype(ARJFileType) = "ARJ"
Filetype(LZHFileType) = "LZH/LHA"
Filetype(CABFileType) = "Cabinet"
' DirList.Path = "d:\download\new\archives"
btnUnzip.Enabled = False
End Sub
Private Sub Insert_Header()
With lstInZip
.ColumnHeaders.Add , , "File Name"
.ColumnHeaders.Add , , "Compression Method"
.ColumnHeaders.Add , , "CRC-32"
.ColumnHeaders.Add , , "Compressed Size"
.ColumnHeaders.Add , , "Decompressed Size"
.ColumnHeaders.Add , , "File date"
End With
End Sub