TS-INDEX

File: frmMain.frm
Path: /TS-CODE/TS-VB6/VB6-PROJECTS/tsZIP-1.0/src/frmMain.frm
Date Modified: 2026-01-16 21:29:55
File size: 9.36 KB
MIME-type: text/plain
Charset: utf-8
Open Parent Directory
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "tsZIP"
   ClientHeight    =   4215
   ClientLeft      =   45
   ClientTop       =   630
   ClientWidth     =   10695
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4215
   ScaleWidth      =   10695
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton btnUnzip 
      Caption         =   "Extract to..."
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   4560
      Visible         =   0   'False
      Width           =   9015
   End
   Begin VB.FileListBox FileList 
      Appearance      =   0  'Flat
      Height          =   3930
      Left            =   2160
      TabIndex        =   2
      Top             =   120
      Width           =   2055
   End
   Begin VB.DirListBox DirList 
      Appearance      =   0  'Flat
      Height          =   3465
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   1935
   End
   Begin VB.DriveListBox DriveList 
      Height          =   315
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1935
   End
   Begin MSComctlLib.ListView lstInZip 
      Height          =   3975
      Left            =   4320
      TabIndex        =   3
      Top             =   120
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   7011
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      MultiSelect     =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   0
      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
   Begin VB.Menu File 
      Caption         =   "File"
      Begin VB.Menu frmMain 
         Caption         =   "Extract to..."
      End
      Begin VB.Menu Exit 
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu frmAbout 
      Caption         =   "About"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 Exit_Click()
End
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 = "" & _
                              FileList.FileName & " -> " & _
                              DirCnt & " Directories and " & _
                              FileCnt & " Files"
    Else
        lblHeadLine.Caption = "Sorry: File not supported!"
    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 = "c:\"
    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

Private Sub frmExtract_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 frmAbout_Click()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "tsZIP v1.0.0.9"    ' version
Style = vbOKOnly    ' button
Title = "About"    '  title
Ctxt = 1000    ' topic context
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbOK Then    ' User chose Ok
    MyString = "Ok"    ' Perform some action
End If
End Sub

Private Sub frmMain_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