vbAccelerator - Contents of code file: frmZip.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmZipTester
Caption = "Zip Tester"
ClientHeight = 4035
ClientLeft = 4410
ClientTop = 2280
ClientWidth = 6735
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmZip.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4035
ScaleWidth = 6735
Begin MSComctlLib.StatusBar sbrMain
Align = 2 'Align Bottom
Height = 330
Left = 0
TabIndex = 5
Top = 3705
Width = 6735
_ExtentX = 11880
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 11351
Text = "MAIN"
TextSave = "MAIN"
Key = "MAIN"
EndProperty
EndProperty
End
Begin VB.ListBox lstLog
Height = 3375
Left = 2400
TabIndex = 4
Top = 120
Width = 4275
End
Begin VB.CheckBox chkAddComment
Caption = "Add &Comment"
Height = 255
Left = 240
TabIndex = 3
Top = 1140
Width = 2055
End
Begin VB.CheckBox chkEncrypt
Caption = "En&crypt"
Height = 195
Left = 240
TabIndex = 2
Top = 1500
Width = 2055
End
Begin VB.CommandButton cmdSingleFile
Caption = "&File..."
Height = 375
Left = 180
TabIndex = 1
Top = 240
Width = 1275
End
Begin VB.CommandButton cmdRecurse
Caption = "&Recurse..."
Height = 375
Left = 180
TabIndex = 0
Top = 720
Width = 1275
End
End
Attribute VB_Name = "frmZipTester"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents m_cZ As cZip
Attribute m_cZ.VB_VarHelpID = -1
Private Sub cmdRecurse_Click()
With m_cZ
.ZipFile = App.Path & "\Test_Rec.zip"
.Encrypt = (chkEncrypt.Value = vbChecked)
.AddComment = (chkAddComment.Value = vbChecked)
.BasePath = App.Path
.ClearFileSpecs
.AddFileSpec "*.fr*"
.AddFileSpec "*.cls"
.AddFileSpec "*.bas"
.StoreFolderNames = True
.RecurseSubDirs = True
.Zip
If (.Success) Then
MsgBox "Zipped files." _
& vbCrLf & vbCrLf & _
" Source: files matching *.fr*;*.cls;*.bas from " & .BasePath &
vbCrLf & _
" To: " & .ZipFile, vbInformation
Else
MsgBox "Zipping failed.", vbExclamation
End If
End With
End Sub
Private Sub cmdSingleFile_Click()
Dim cc As New GCommonDialog
Dim sFIle As String
' Get the file to zip:
If (cc.VBGetOpenFileName(sFIle, , , , , , "All Files (*.*)|*.*", , , "Choose
File to Zip", , Me.hwnd)) Then
With m_cZ
.Encrypt = (chkEncrypt.Value = vbChecked)
.AddComment = (chkAddComment.Value = vbChecked)
.ZipFile = App.Path & "\Test_One.zip"
.StoreFolderNames = False
.RecurseSubDirs = False
.ClearFileSpecs
.AddFileSpec sFIle
.Zip
If (.Success) Then
MsgBox "Zipped one file." _
& vbCrLf & vbCrLf & _
" Source: " & .FileSpec(1) & vbCrLf & _
" To: " & .ZipFile, vbInformation
Else
MsgBox "Zip Failed.", vbExclamation
End If
End With
End If
End Sub
Private Sub Form_Load()
Set m_cZ = New cZip
End Sub
Private Sub m_cZ_CommentRequest(sComment As String, bCancel As Boolean)
'
Dim sComm As String
sComm = InputBox("Enter comment:", App.EXEName)
sComm = Trim(sComm)
If Len(sComm) = 0 Then
bCancel = True
Else
sComment = sComm
End If
'
End Sub
Private Sub m_cZ_PasswordRequest(sPassword As String, ByVal lMaxPasswordLength
As Long, ByVal bConfirm As Boolean, bCancel As Boolean)
'
Dim sPass As String
Dim sMsg As String
If (bConfirm) Then
sMsg = "Confirm password:"
Else
sMsg = "Enter password:"
End If
sPass = InputBox(sMsg, App.EXEName)
sPass = Trim(sPass)
If (Len(sPass) = 0) Then
bCancel = True
Else
sPassword = sPass
End If
'
End Sub
Private Sub m_cZ_Progress(ByVal lCount As Long, ByVal sMsg As String)
sbrMain.Panels(1).Text = sMsg
lstLog.AddItem sMsg
lstLog.ListIndex = lstLog.NewIndex
End Sub
|
|