385 lines
12 KiB
Plaintext
385 lines
12 KiB
Plaintext
|
VERSION 5.00
|
||
|
|
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
|
||
|
|
Begin VB.Form VBUnzFrm
|
||
|
|
AutoRedraw = -1 'True
|
||
|
|
Caption = "VBUnzFrm"
|
||
|
|
ClientHeight = 4785
|
||
|
|
ClientLeft = 780
|
||
|
|
ClientTop = 525
|
||
|
|
ClientWidth = 9375
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Fixedsys"
|
||
|
|
Size = 9
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
LinkTopic = "VBUnzFrm"
|
||
|
|
ScaleHeight = 4785
|
||
|
|
ScaleWidth = 9375
|
||
|
|
StartUpPosition = 1 'Fenstermitte
|
||
|
|
Begin VB.CheckBox checkOverwriteAll
|
||
|
|
Alignment = 1 'Rechts ausgerichtet
|
||
|
|
Caption = "Overwrite all?"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "MS Sans Serif"
|
||
|
|
Size = 9.75
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 255
|
||
|
|
Left = 240
|
||
|
|
TabIndex = 5
|
||
|
|
Top = 1320
|
||
|
|
Width = 4425
|
||
|
|
End
|
||
|
|
Begin VB.TextBox txtZipFName
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Courier New"
|
||
|
|
Size = 9.75
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 375
|
||
|
|
Left = 4440
|
||
|
|
TabIndex = 1
|
||
|
|
Top = 120
|
||
|
|
Width = 4335
|
||
|
|
End
|
||
|
|
Begin VB.TextBox txtExtractRoot
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Courier New"
|
||
|
|
Size = 9.75
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 375
|
||
|
|
Left = 4440
|
||
|
|
TabIndex = 4
|
||
|
|
Top = 720
|
||
|
|
Width = 4335
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cmdStartUnz
|
||
|
|
Caption = "Start"
|
||
|
|
Height = 495
|
||
|
|
Left = 240
|
||
|
|
TabIndex = 6
|
||
|
|
Top = 1800
|
||
|
|
Width = 3255
|
||
|
|
End
|
||
|
|
Begin VB.TextBox txtMsgOut
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Courier New"
|
||
|
|
Size = 9
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 2175
|
||
|
|
Left = 240
|
||
|
|
Locked = -1 'True
|
||
|
|
MultiLine = -1 'True
|
||
|
|
ScrollBars = 3 'Beides
|
||
|
|
TabIndex = 8
|
||
|
|
TabStop = 0 'False
|
||
|
|
Top = 2520
|
||
|
|
Width = 8895
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cmdQuitVBUnz
|
||
|
|
Cancel = -1 'True
|
||
|
|
Caption = "Quit"
|
||
|
|
Height = 495
|
||
|
|
Left = 6240
|
||
|
|
TabIndex = 7
|
||
|
|
Top = 1800
|
||
|
|
Width = 2895
|
||
|
|
End
|
||
|
|
Begin VB.CommandButton cmdSearchZfile
|
||
|
|
Caption = "..."
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "MS Sans Serif"
|
||
|
|
Size = 8.25
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 375
|
||
|
|
Left = 8760
|
||
|
|
TabIndex = 2
|
||
|
|
Top = 120
|
||
|
|
Width = 375
|
||
|
|
End
|
||
|
|
Begin MSComDlg.CommonDialog CommonDialog1
|
||
|
|
Left = 4800
|
||
|
|
Top = 1800
|
||
|
|
_ExtentX = 847
|
||
|
|
_ExtentY = 847
|
||
|
|
_Version = 393216
|
||
|
|
End
|
||
|
|
Begin VB.Label Label1
|
||
|
|
Caption = "Complete path-name of Zip-archive:"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "MS Sans Serif"
|
||
|
|
Size = 9.75
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 255
|
||
|
|
Left = 240
|
||
|
|
TabIndex = 0
|
||
|
|
Top = 120
|
||
|
|
Width = 3855
|
||
|
|
End
|
||
|
|
Begin VB.Label Label2
|
||
|
|
Caption = "Extract archive into directory:"
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "MS Sans Serif"
|
||
|
|
Size = 9.75
|
||
|
|
Charset = 0
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
Height = 255
|
||
|
|
Left = 240
|
||
|
|
TabIndex = 3
|
||
|
|
Top = 720
|
||
|
|
Width = 3855
|
||
|
|
End
|
||
|
|
End
|
||
|
|
Attribute VB_Name = "VBUnzFrm"
|
||
|
|
Attribute VB_GlobalNameSpace = False
|
||
|
|
Attribute VB_Creatable = False
|
||
|
|
Attribute VB_PredeclaredId = True
|
||
|
|
Attribute VB_Exposed = False
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
'---------------------------------------------------
|
||
|
|
'-- Please Do Not Remove These Comment Lines!
|
||
|
|
'----------------------------------------------------------------
|
||
|
|
'-- Sample VB 5 / VB 6 code to drive unzip32.dll
|
||
|
|
'-- Contributed to the Info-ZIP project by Mike Le Voi
|
||
|
|
'--
|
||
|
|
'-- Contact me at: mlevoi@modemss.brisnet.org.au
|
||
|
|
'--
|
||
|
|
'-- Visit my home page at: http://modemss.brisnet.org.au/~mlevoi
|
||
|
|
'--
|
||
|
|
'-- Use this code at your own risk. Nothing implied or warranted
|
||
|
|
'-- to work on your machine :-)
|
||
|
|
'----------------------------------------------------------------
|
||
|
|
'--
|
||
|
|
'-- This Source Code Is Freely Available From The Info-ZIP Project
|
||
|
|
'-- Web Server At:
|
||
|
|
'-- ftp://ftp.info-zip.org/pub/infozip/infozip.html
|
||
|
|
'--
|
||
|
|
'-- A Very Special Thanks To Mr. Mike Le Voi
|
||
|
|
'-- And Mr. Mike White
|
||
|
|
'-- And The Fine People Of The Info-ZIP Group
|
||
|
|
'-- For Letting Me Use And Modify Their Orginal
|
||
|
|
'-- Visual Basic 5.0 Code! Thank You Mike Le Voi.
|
||
|
|
'-- For Your Hard Work In Helping Me Get This To Work!!!
|
||
|
|
'---------------------------------------------------------------
|
||
|
|
'--
|
||
|
|
'-- Contributed To The Info-ZIP Project By Raymond L. King.
|
||
|
|
'-- Modified June 21, 1998
|
||
|
|
'-- By Raymond L. King
|
||
|
|
'-- Custom Software Designers
|
||
|
|
'--
|
||
|
|
'-- Contact Me At: king@ntplx.net
|
||
|
|
'-- ICQ 434355
|
||
|
|
'-- Or Visit Our Home Page At: http://www.ntplx.net/~king
|
||
|
|
'--
|
||
|
|
'---------------------------------------------------------------
|
||
|
|
'--
|
||
|
|
'-- Modified August 17, 1998
|
||
|
|
'-- by Christian Spieler
|
||
|
|
'-- (added sort of a "windows oriented" user interface)
|
||
|
|
'-- Modified May 11, 2003
|
||
|
|
'-- by Christian Spieler
|
||
|
|
'-- (use late binding for referencing the common dialog)
|
||
|
|
'-- Modified December 30, 2008
|
||
|
|
'-- by Ed Gordon
|
||
|
|
'-- (add Overwrite_All checkbox and resizing of txtMsgOut
|
||
|
|
'-- output box)
|
||
|
|
'-- Modified January 03, 2009
|
||
|
|
'-- by Christian Spieler
|
||
|
|
'-- (fixed tab navigation sequence, changed passing of
|
||
|
|
'-- "overwrite-all" setting to use existing option flags,
|
||
|
|
'-- cleared all msg buffer at start of every DLL call,
|
||
|
|
'-- removed code that is not supported by VB5)
|
||
|
|
'--
|
||
|
|
'---------------------------------------------------------------
|
||
|
|
|
||
|
|
Private mCommDlgCtrl As Object
|
||
|
|
|
||
|
|
Private Sub cmdStartUnz_Click()
|
||
|
|
|
||
|
|
Dim MsgTmp As String
|
||
|
|
|
||
|
|
Cls
|
||
|
|
txtMsgOut.Text = ""
|
||
|
|
|
||
|
|
'-- Init Global Message Variables
|
||
|
|
uZipInfo = ""
|
||
|
|
uZipMessage = ""
|
||
|
|
uZipNumber = 0 ' Holds The Number Of Zip Files
|
||
|
|
|
||
|
|
'-- Select UNZIP32.DLL Options - Change As Required!
|
||
|
|
' 1 = Always Overwrite Files
|
||
|
|
uOverWriteFiles = Me.checkOverwriteAll.Value
|
||
|
|
' 1 = Prompt To Overwrite
|
||
|
|
uPromptOverWrite = IIf(uOverWriteFiles = 0, 1, 0)
|
||
|
|
uDisplayComment = 0 ' 1 = Display comment ONLY!!!
|
||
|
|
uHonorDirectories = 1 ' 1 = Honour Zip Directories
|
||
|
|
|
||
|
|
'-- Select Filenames If Required
|
||
|
|
'-- Or Just Select All Files
|
||
|
|
uZipNames.uzFiles(0) = vbNullString
|
||
|
|
uNumberFiles = 0
|
||
|
|
|
||
|
|
'-- Select Filenames To Exclude From Processing
|
||
|
|
' Note UNIX convention!
|
||
|
|
' vbxnames.s(0) = "VBSYX/VBSYX.MID"
|
||
|
|
' vbxnames.s(1) = "VBSYX/VBSYX.SYX"
|
||
|
|
' numx = 2
|
||
|
|
|
||
|
|
'-- Or Just Select All Files
|
||
|
|
uExcludeNames.uzFiles(0) = vbNullString
|
||
|
|
uNumberXFiles = 0
|
||
|
|
|
||
|
|
'-- Change The Next 2 Lines As Required!
|
||
|
|
'-- These Should Point To Your Directory
|
||
|
|
uZipFileName = txtZipFName.Text
|
||
|
|
uExtractDir = txtExtractRoot.Text
|
||
|
|
If Len(uExtractDir) <> 0 Then
|
||
|
|
uExtractList = 0 ' 0 = Extract if dir specified
|
||
|
|
Else
|
||
|
|
uExtractList = 1 ' 1 = List Contents Of Zip
|
||
|
|
End If
|
||
|
|
|
||
|
|
'-- Let's Go And Unzip Them!
|
||
|
|
Call VBUnZip32
|
||
|
|
|
||
|
|
'-- Tell The User What Happened
|
||
|
|
If Len(uZipMessage) > 0 Then
|
||
|
|
MsgTmp = uZipMessage
|
||
|
|
uZipMessage = ""
|
||
|
|
End If
|
||
|
|
|
||
|
|
'-- Display Zip File Information.
|
||
|
|
If Len(uZipInfo) > 0 Then
|
||
|
|
MsgTmp = MsgTmp & vbNewLine & "uZipInfo is:" & vbNewLine & uZipInfo
|
||
|
|
uZipInfo = ""
|
||
|
|
End If
|
||
|
|
|
||
|
|
'-- Display The Number Of Extracted Files!
|
||
|
|
If uZipNumber > 0 Then
|
||
|
|
MsgTmp = MsgTmp & vbNewLine & "Number Of Files: " & Str(uZipNumber)
|
||
|
|
End If
|
||
|
|
|
||
|
|
txtMsgOut.Text = txtMsgOut.Text & MsgTmp & vbNewLine
|
||
|
|
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub Form_Load()
|
||
|
|
|
||
|
|
'-- To work around compatibility issues between different versions of
|
||
|
|
'-- Visual Basic, we use a late bound untyped object variable to reference
|
||
|
|
'-- the common dialog ActiveX-control object at runtime.
|
||
|
|
On Error Resume Next
|
||
|
|
Set mCommDlgCtrl = CommonDialog1
|
||
|
|
On Error GoTo 0
|
||
|
|
'-- Disable the "call openfile dialog" button, when the common dialog
|
||
|
|
'-- object is not available
|
||
|
|
cmdSearchZfile.Visible = Not (mCommDlgCtrl Is Nothing)
|
||
|
|
|
||
|
|
txtZipFName.Text = vbNullString
|
||
|
|
txtExtractRoot.Text = vbNullString
|
||
|
|
Me.Show
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_Resize()
|
||
|
|
Dim Wid As Single
|
||
|
|
Dim Hei As Single
|
||
|
|
|
||
|
|
Wid = Me.Width - 600 ' 9495 - 8895
|
||
|
|
If Wid < 2000 Then Wid = 2000
|
||
|
|
txtMsgOut.Width = Wid
|
||
|
|
|
||
|
|
Hei = Me.Height - 3120 ' 5295 - 2175
|
||
|
|
If Hei < 1000 Then Hei = 1000
|
||
|
|
txtMsgOut.Height = Hei
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_Unload(Cancel As Integer)
|
||
|
|
'-- remove runtime reference to common dialog control object
|
||
|
|
Set mCommDlgCtrl = Nothing
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub cmdQuitVBUnz_Click()
|
||
|
|
Unload Me
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
Private Sub cmdSearchZfile_Click()
|
||
|
|
If mCommDlgCtrl Is Nothing Then Exit Sub
|
||
|
|
mCommDlgCtrl.CancelError = False
|
||
|
|
mCommDlgCtrl.DialogTitle = "Open Zip-archive"
|
||
|
|
'-- The following property is not supported in the first version(s)
|
||
|
|
'-- of the common dialog controls. But this feature is of minor
|
||
|
|
'-- relevance in our context, so we simply skip over the statement
|
||
|
|
'-- in case of errors.
|
||
|
|
On Error Resume Next
|
||
|
|
mCommDlgCtrl.DefaultExt = ".zip"
|
||
|
|
On Error GoTo err_deactivateControl
|
||
|
|
'-- Initialize the file name with the current setting of the filename
|
||
|
|
'-- text box.
|
||
|
|
mCommDlgCtrl.FileName = txtZipFName.Text
|
||
|
|
'-- Provide reasonable filter settings for selecting Zip archives.
|
||
|
|
mCommDlgCtrl.Filter = "Zip archives (*.zip)|*.zip|All files (*.*)|*.*"
|
||
|
|
mCommDlgCtrl.ShowOpen
|
||
|
|
'-- In case the user closed the dialog via cancel, the FilenName
|
||
|
|
'-- property contains its initial setting and no change occurs.
|
||
|
|
txtZipFName.Text = mCommDlgCtrl.FileName
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
err_deactivateControl:
|
||
|
|
'-- Emit a warning message.
|
||
|
|
MsgBox "Unexpected error #" & CStr(Err.Number) & " in call to ComDLG32" _
|
||
|
|
& " FileOpen dialog:" & vbNewLine & Err.Description & vbNewLine _
|
||
|
|
& vbNewLine & "The version of the COMDLG32.OCX control installed" _
|
||
|
|
& " on your system seems to be too old. Please consider upgrading" _
|
||
|
|
& " to a recent release of the Common Dialog ActiveX control." _
|
||
|
|
& vbNewLine & "The ""Choose File from List"" dialog functionality" _
|
||
|
|
& " has been disabled for this session.", _
|
||
|
|
vbCritical + vbOKOnly, "FileOpen Dialog incompatible"
|
||
|
|
'-- Deactivate the control and prevent further usage in this session.
|
||
|
|
Set mCommDlgCtrl = Nothing
|
||
|
|
cmdSearchZfile.Enabled = False
|
||
|
|
End Sub
|
||
|
|
|