' Library Scripting
' C:\WINDOWS\system32\scrrun.dll
' Microsoft Scripting Runtime
Global FSO As New Scripting.FileSystemObject
Global FOL As Scripting.Folder
Global FIL As Scripting.File
 
' Library WSHRuntimeLibrary
' C:\WINDOWS\System32\wshom.ocx
' Windows Script Host Object Model
 
Global WSH As New IWshShell_Class
 
Global Const WshHide = 0
Global Const WshNormalFocus = 1
Global Const WshMinimizedFocus = 2
Global Const WshMaximizedFocus = 3
Global Const WshNormalNoFocus = 4
Global Const WshMinimizedNoFocus = 6
 
' External Program
' winzip32.exe
 
Global Const wHKM = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\"
Global Swiz As String 
Global Const wizMinimized = " -min "
Global Const wizAdd = " -a "
Global Const wizFreshen = " -f "
Global Const wizMove = " -m "
Global Const wizUpdate = " -u "
Global Const wizFolders = " -r "
Global Const wizRootPath = " -p "
Global Const wizExtra = " -ex "
Global Const wizNormal = " -en "
Global Const wizFast = " -ef "
Global Const wizSuperFast = " -es "
Global Const wizNoCompession = " -e0 "
Global Const wizHiddenFiles = " -hs "
Global Const wizPW = " -s " '"Password can be in quotes"
Global Const wizUnzip = " -e "
Global Const wizOverwrite = " -o "
Global Const wizJunkPaths = " -j "
 
Function dos83(Sstr As String) As String
Select case true
case FSO.FileExists(Sstr)
      dos83 = FSO.GetFile(Sstr).ShortPath
case FSO.FolderExists(Sstr)
      dos83 = FSO.GetFolder(Sstr).ShortPath
case else
       msgbox "ERROR" Das übergebene Argument ist werder File noch Verzeichnis"" & _
         "& _
       vblf & Sstr ,,"Function dos83"
End select
End Function
 
Function zip(ByVal sQel As String, ByVal sZil As String, Smod As String) As _
  Variant
Dim i As Byte
if len(Swiz) =0 then
         on error resume next
         Swiz = WSH.RegRead(wHKM & "winzip32.exe\")
         If Err.Number <> 0 Then
               Swiz = WSH.RegRead(wHKM & "winzip32.exe\(default)")
         End If
         on error goto 0
         Swiz = FZ.dos83(Swiz)
End if
sQel = FZ.dos83(sQel)
If Len(sQel) = 0 Then Exit Function
i = InStrRev(sZil, "\")
sZil = FZ.dos83(Left(sZil, i)) & Mid(sZil, i)
Select Case InStr(Smod, wizUnzip)
Case 0 ' zip
    If Right(sQel, 1) = "\" Then sQel = sQel & "* "
    debug.print "zipping " & Mid(sQel, InStrRev(sQel, "\") + 1)
    zip = WSH.Run(Swiz & Smod & sZil & " " & sQel, WshMinimizedNoFocus, True)
Case Else ' unzip
    debug.print "unzipping " & Mid(sQel, InStrRev(sQel, "\") + 1)
    zip = WSH.Run(Swiz & Smod & sQel & " " & sZil, WshMinimizedNoFocus, True)
End Select
End Function