home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form frmExtract
- BorderStyle = 4 'Fixed ToolWindow
- Caption = "Extract from Archive"
- ClientHeight = 2910
- ClientLeft = 45
- ClientTop = 285
- ClientWidth = 3870
- BeginProperty Font
- Name = "Tahoma"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 2910
- ScaleWidth = 3870
- ShowInTaskbar = 0 'False
- StartUpPosition = 3 'Windows Default
- Begin VB.Frame frNew
- Caption = "New archive name:"
- BeginProperty Font
- Name = "Tahoma"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 2895
- Left = 0
- TabIndex = 0
- Top = 0
- Width = 3855
- Begin VB.DriveListBox driveNew
- Height = 315
- Left = 120
- TabIndex = 6
- Top = 240
- Width = 2295
- End
- Begin VB.CommandButton cmdCancel
- Caption = "&Cancel"
- Height = 285
- Left = 2520
- TabIndex = 5
- Top = 600
- Width = 1095
- End
- Begin VB.CommandButton cmdExtract
- Caption = "E&xtract"
- Height = 285
- Left = 2520
- TabIndex = 4
- Top = 240
- Width = 1095
- End
- Begin VB.TextBox Text1
- Height = 285
- Left = 120
- TabIndex = 3
- Text = "NewDirectory"
- Top = 2520
- Width = 2295
- End
- Begin VB.CommandButton cmdNewDir
- Caption = "&Add Folder"
- Height = 285
- Left = 2520
- TabIndex = 2
- Top = 2520
- Width = 1095
- End
- Begin VB.DirListBox dirNew
- Height = 1890
- Left = 120
- TabIndex = 1
- Top = 600
- Width = 2295
- End
- Begin VB.Label lblHelp
- Caption = "To create a new sub-directory use the space below and press ""Add Folder"""
- Height = 1455
- Left = 2520
- TabIndex = 7
- Top = 960
- Width = 1215
- WordWrap = -1 'True
- End
- End
- Attribute VB_Name = "frmExtract"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Private Sub cmdCancel_Click()
- Unload Me
- End Sub
- Private Sub cmdExtract_Click()
- Dim FileName As String
- Dim i As Integer
- 'Don't add a "\" to a Drive itself "D:\" or it will look like, "D:\\"
- If Len(dirNew.Path) > 3 Then
- frmAZPCoDec.ActiveZipperPro1.Destination = dirNew.Path & "\"
- Else
- frmAZPCoDec.ActiveZipperPro1.Destination = dirNew.Path
- End If
- Me.Visible = False
- If UseZip = False Then
- frmAZPCoDec.ActiveZipperPro1.CompLevel (1) 'Init the MaxFiles property
- For i = 1 To frmAZPCoDec.ActiveZipperPro1.MaxFiles
- FileName = frmAZPCoDec.ListView1.ListItems(i)
- 'set the status bar
- frmAZPCoDec.stat.Panels(1).Text = "Extracting " & FileName & "..."
- frmAZPCoDec.ActiveZipperPro1.DecompressedFile = FileName
- frmAZPCoDec.ActiveZipperPro1.Decompress i, RFile, WState
- Next
- Else
- frmAZPCoDec.ActiveZipperPro1.UnZipIt True
- End If
- frmAZPCoDec.stat.Panels(1).Text = "No Task..."
- Unload Me
- End Sub
- Private Sub cmdNewDir_Click()
- Dim NewPath As String
- 'Don't add the "\" to the Root Drive path. i.e. "D:\" would look like "D:\\"
- If Len(dirNew.Path) > 3 Then
- NewPath = dirNew.Path & "\" & Text1.Text
- Else
- NewPath = dirNew.Path & Text1.Text
- End If
- MkDir NewPath
- dirNew.Path = NewPath
- End Sub
- Private Sub dirNew_Change()
- Dim KeyAscii As Integer
- If KeyAscii = 10 Or 13 Then
- dirNew.Path = dirNew.List(dirNew.ListIndex)
- End If
- End Sub
- Private Sub driveNew_Change()
- dirNew.Path = driveNew.Drive
- End Sub
-