keXa/kolibrios
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity
2af7a3394b
kolibrios/programs/fs/unzip60/windll/vb/vbunzip.frm
siemargl e9b1c1bac6 unzip initial commit 
git-svn-id: svn://kolibrios.org@6725 a494cfbc-eb01-0410-851d-a64ba20cac60
2016-11-18 13:40:05 +00:00

385 lines
12 KiB
Plaintext
Raw Blame History

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
View Git Blame Copy Permalink