1VERSION 5.00
2Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
3Begin VB.Form VBUnzFrm
4   AutoRedraw      =   -1  'True
5   Caption         =   "VBUnzFrm"
6   ClientHeight    =   4785
7   ClientLeft      =   780
8   ClientTop       =   525
9   ClientWidth     =   9375
10   BeginProperty Font
11      Name            =   "Fixedsys"
12      Size            =   9
13      Charset         =   0
14      Weight          =   400
15      Underline       =   0   'False
16      Italic          =   0   'False
17      Strikethrough   =   0   'False
18   EndProperty
19   LinkTopic       =   "VBUnzFrm"
20   ScaleHeight     =   4785
21   ScaleWidth      =   9375
22   StartUpPosition =   1  'Fenstermitte
23   Begin VB.CheckBox checkOverwriteAll
24      Alignment       =   1  'Rechts ausgerichtet
25      Caption         =   "Overwrite all?"
26      BeginProperty Font
27         Name            =   "MS Sans Serif"
28         Size            =   9.75
29         Charset         =   0
30         Weight          =   400
31         Underline       =   0   'False
32         Italic          =   0   'False
33         Strikethrough   =   0   'False
34      EndProperty
35      Height          =   255
36      Left            =   240
37      TabIndex        =   5
38      Top             =   1320
39      Width           =   4425
40   End
41   Begin VB.TextBox txtZipFName
42      BeginProperty Font
43         Name            =   "Courier New"
44         Size            =   9.75
45         Charset         =   0
46         Weight          =   400
47         Underline       =   0   'False
48         Italic          =   0   'False
49         Strikethrough   =   0   'False
50      EndProperty
51      Height          =   375
52      Left            =   4440
53      TabIndex        =   1
54      Top             =   120
55      Width           =   4335
56   End
57   Begin VB.TextBox txtExtractRoot
58      BeginProperty Font
59         Name            =   "Courier New"
60         Size            =   9.75
61         Charset         =   0
62         Weight          =   400
63         Underline       =   0   'False
64         Italic          =   0   'False
65         Strikethrough   =   0   'False
66      EndProperty
67      Height          =   375
68      Left            =   4440
69      TabIndex        =   4
70      Top             =   720
71      Width           =   4335
72   End
73   Begin VB.CommandButton cmdStartUnz
74      Caption         =   "Start"
75      Height          =   495
76      Left            =   240
77      TabIndex        =   6
78      Top             =   1800
79      Width           =   3255
80   End
81   Begin VB.TextBox txtMsgOut
82      BeginProperty Font
83         Name            =   "Courier New"
84         Size            =   9
85         Charset         =   0
86         Weight          =   400
87         Underline       =   0   'False
88         Italic          =   0   'False
89         Strikethrough   =   0   'False
90      EndProperty
91      Height          =   2175
92      Left            =   240
93      Locked          =   -1  'True
94      MultiLine       =   -1  'True
95      ScrollBars      =   3  'Beides
96      TabIndex        =   8
97      TabStop         =   0   'False
98      Top             =   2520
99      Width           =   8895
100   End
101   Begin VB.CommandButton cmdQuitVBUnz
102      Cancel          =   -1  'True
103      Caption         =   "Quit"
104      Height          =   495
105      Left            =   6240
106      TabIndex        =   7
107      Top             =   1800
108      Width           =   2895
109   End
110   Begin VB.CommandButton cmdSearchZfile
111      Caption         =   "..."
112      BeginProperty Font
113         Name            =   "MS Sans Serif"
114         Size            =   8.25
115         Charset         =   0
116         Weight          =   400
117         Underline       =   0   'False
118         Italic          =   0   'False
119         Strikethrough   =   0   'False
120      EndProperty
121      Height          =   375
122      Left            =   8760
123      TabIndex        =   2
124      Top             =   120
125      Width           =   375
126   End
127   Begin MSComDlg.CommonDialog CommonDialog1
128      Left            =   4800
129      Top             =   1800
130      _ExtentX        =   847
131      _ExtentY        =   847
132      _Version        =   393216
133   End
134   Begin VB.Label Label1
135      Caption         =   "Complete path-name of Zip-archive:"
136      BeginProperty Font
137         Name            =   "MS Sans Serif"
138         Size            =   9.75
139         Charset         =   0
140         Weight          =   400
141         Underline       =   0   'False
142         Italic          =   0   'False
143         Strikethrough   =   0   'False
144      EndProperty
145      Height          =   255
146      Left            =   240
147      TabIndex        =   0
148      Top             =   120
149      Width           =   3855
150   End
151   Begin VB.Label Label2
152      Caption         =   "Extract archive into directory:"
153      BeginProperty Font
154         Name            =   "MS Sans Serif"
155         Size            =   9.75
156         Charset         =   0
157         Weight          =   400
158         Underline       =   0   'False
159         Italic          =   0   'False
160         Strikethrough   =   0   'False
161      EndProperty
162      Height          =   255
163      Left            =   240
164      TabIndex        =   3
165      Top             =   720
166      Width           =   3855
167   End
168End
169Attribute VB_Name = "VBUnzFrm"
170Attribute VB_GlobalNameSpace = False
171Attribute VB_Creatable = False
172Attribute VB_PredeclaredId = True
173Attribute VB_Exposed = False
174Option Explicit
175
176'---------------------------------------------------
177'-- Please Do Not Remove These Comment Lines!
178'----------------------------------------------------------------
179'-- Sample VB 5 / VB 6 code to drive unzip32.dll
180'-- Contributed to the Info-ZIP project by Mike Le Voi
181'--
182'-- Contact me at: mlevoi@modemss.brisnet.org.au
183'--
184'-- Visit my home page at: http://modemss.brisnet.org.au/~mlevoi
185'--
186'-- Use this code at your own risk. Nothing implied or warranted
187'-- to work on your machine :-)
188'----------------------------------------------------------------
189'--
190'-- This Source Code Is Freely Available From The Info-ZIP Project
191'-- Web Server At:
192'-- ftp://ftp.info-zip.org/pub/infozip/infozip.html
193'--
194'-- A Very Special Thanks To Mr. Mike Le Voi
195'-- And Mr. Mike White
196'-- And The Fine People Of The Info-ZIP Group
197'-- For Letting Me Use And Modify Their Orginal
198'-- Visual Basic 5.0 Code! Thank You Mike Le Voi.
199'-- For Your Hard Work In Helping Me Get This To Work!!!
200'---------------------------------------------------------------
201'--
202'-- Contributed To The Info-ZIP Project By Raymond L. King.
203'-- Modified June 21, 1998
204'-- By Raymond L. King
205'-- Custom Software Designers
206'--
207'-- Contact Me At: king@ntplx.net
208'-- ICQ 434355
209'-- Or Visit Our Home Page At: http://www.ntplx.net/~king
210'--
211'---------------------------------------------------------------
212'--
213'-- Modified August 17, 1998
214'-- by Christian Spieler
215'-- (added sort of a "windows oriented" user interface)
216'-- Modified May 11, 2003
217'-- by Christian Spieler
218'-- (use late binding for referencing the common dialog)
219'-- Modified December 30, 2008
220'-- by Ed Gordon
221'-- (add Overwrite_All checkbox and resizing of txtMsgOut
222'-- output box)
223'-- Modified January 03, 2009
224'-- by Christian Spieler
225'-- (fixed tab navigation sequence, changed passing of
226'-- "overwrite-all" setting to use existing option flags,
227'-- cleared all msg buffer at start of every DLL call,
228'-- removed code that is not supported by VB5)
229'--
230'---------------------------------------------------------------
231
232Private mCommDlgCtrl As Object
233
234Private Sub cmdStartUnz_Click()
235
236    Dim MsgTmp As String
237
238    Cls
239    txtMsgOut.Text = ""
240
241    '-- Init Global Message Variables
242    uZipInfo = ""
243    uZipMessage = ""
244    uZipNumber = 0   ' Holds The Number Of Zip Files
245
246    '-- Select UNZIP32.DLL Options - Change As Required!
247    ' 1 = Always Overwrite Files
248    uOverWriteFiles = Me.checkOverwriteAll.Value
249    ' 1 = Prompt To Overwrite
250    uPromptOverWrite = IIf(uOverWriteFiles = 0, 1, 0)
251    uDisplayComment = 0   ' 1 = Display comment ONLY!!!
252    uHonorDirectories = 1  ' 1 = Honour Zip Directories
253
254    '-- Select Filenames If Required
255    '-- Or Just Select All Files
256    uZipNames.uzFiles(0) = vbNullString
257    uNumberFiles = 0
258
259    '-- Select Filenames To Exclude From Processing
260    ' Note UNIX convention!
261    '   vbxnames.s(0) = "VBSYX/VBSYX.MID"
262    '   vbxnames.s(1) = "VBSYX/VBSYX.SYX"
263    '   numx = 2
264
265    '-- Or Just Select All Files
266    uExcludeNames.uzFiles(0) = vbNullString
267    uNumberXFiles = 0
268
269    '-- Change The Next 2 Lines As Required!
270    '-- These Should Point To Your Directory
271    uZipFileName = txtZipFName.Text
272    uExtractDir = txtExtractRoot.Text
273    If Len(uExtractDir) <> 0 Then
274      uExtractList = 0  ' 0 = Extract if dir specified
275    Else
276      uExtractList = 1  ' 1 = List Contents Of Zip
277    End If
278
279    '-- Let's Go And Unzip Them!
280    Call VBUnZip32
281
282    '-- Tell The User What Happened
283    If Len(uZipMessage) > 0 Then
284        MsgTmp = uZipMessage
285        uZipMessage = ""
286    End If
287
288    '-- Display Zip File Information.
289    If Len(uZipInfo) > 0 Then
290        MsgTmp = MsgTmp & vbNewLine & "uZipInfo is:" & vbNewLine & uZipInfo
291        uZipInfo = ""
292    End If
293
294    '-- Display The Number Of Extracted Files!
295    If uZipNumber > 0 Then
296        MsgTmp = MsgTmp & vbNewLine & "Number Of Files: " & Str(uZipNumber)
297    End If
298
299    txtMsgOut.Text = txtMsgOut.Text & MsgTmp & vbNewLine
300
301
302End Sub
303
304
305Private Sub Form_Load()
306
307    '-- To work around compatibility issues between different versions of
308    '-- Visual Basic, we use a late bound untyped object variable to reference
309    '-- the common dialog ActiveX-control object at runtime.
310    On Error Resume Next
311    Set mCommDlgCtrl = CommonDialog1
312    On Error GoTo 0
313    '-- Disable the "call openfile dialog" button, when the common dialog
314    '-- object is not available
315    cmdSearchZfile.Visible = Not (mCommDlgCtrl Is Nothing)
316
317    txtZipFName.Text = vbNullString
318    txtExtractRoot.Text = vbNullString
319    Me.Show
320
321End Sub
322
323Private Sub Form_Resize()
324    Dim Wid As Single
325    Dim Hei As Single
326
327    Wid = Me.Width - 600 ' 9495 - 8895
328    If Wid < 2000 Then Wid = 2000
329    txtMsgOut.Width = Wid
330
331    Hei = Me.Height - 3120 ' 5295 - 2175
332    If Hei < 1000 Then Hei = 1000
333    txtMsgOut.Height = Hei
334
335End Sub
336
337Private Sub Form_Unload(Cancel As Integer)
338    '-- remove runtime reference to common dialog control object
339    Set mCommDlgCtrl = Nothing
340End Sub
341
342
343Private Sub cmdQuitVBUnz_Click()
344    Unload Me
345End Sub
346
347
348Private Sub cmdSearchZfile_Click()
349    If mCommDlgCtrl Is Nothing Then Exit Sub
350    mCommDlgCtrl.CancelError = False
351    mCommDlgCtrl.DialogTitle = "Open Zip-archive"
352    '-- The following property is not supported in the first version(s)
353    '-- of the common dialog controls. But this feature is of minor
354    '-- relevance in our context, so we simply skip over the statement
355    '-- in case of errors.
356    On Error Resume Next
357    mCommDlgCtrl.DefaultExt = ".zip"
358    On Error GoTo err_deactivateControl
359    '-- Initialize the file name with the current setting of the filename
360    '-- text box.
361    mCommDlgCtrl.FileName = txtZipFName.Text
362    '-- Provide reasonable filter settings for selecting Zip archives.
363    mCommDlgCtrl.Filter = "Zip archives (*.zip)|*.zip|All files (*.*)|*.*"
364    mCommDlgCtrl.ShowOpen
365    '-- In case the user closed the dialog via cancel, the FilenName
366    '-- property contains its initial setting and no change occurs.
367    txtZipFName.Text = mCommDlgCtrl.FileName
368    Exit Sub
369
370err_deactivateControl:
371    '-- Emit a warning message.
372    MsgBox "Unexpected error #" & CStr(Err.Number) & " in call to ComDLG32" _
373         & " FileOpen dialog:" & vbNewLine & Err.Description & vbNewLine _
374         & vbNewLine & "The version of the COMDLG32.OCX control installed" _
375         & " on your system seems to be too old. Please consider upgrading" _
376         & " to a recent release of the Common Dialog ActiveX control." _
377         & vbNewLine & "The ""Choose File from List"" dialog functionality" _
378         & " has been disabled for this session.", _
379         vbCritical + vbOKOnly, "FileOpen Dialog incompatible"
380    '-- Deactivate the control and prevent further usage in this session.
381    Set mCommDlgCtrl = Nothing
382    cmdSearchZfile.Enabled = False
383End Sub
384
385