ZIPPING

[Jim Niezgoda]

Is there any way to create a .ZIP file in VB or C++

Thanks,

Jim

[Iouri]

'frmZipping
Private Sub Command1_Click()
With Options
.ActionToDo = Add
.Compression = eXtra
.FilesToAdd = AddHiddenSystem
.Options = Recurse_Directories
.IfFileAlreadyExists = AlwaysOverwrite
End With

Call AddFilesToZip(txtSourceDir, txtDestFile)
End Sub

'module - mdlAddToZip
Public SetToHide As Boolean

Private Enum CheckDirOrFile
IsDirectory = 1
IsFilename = 2
End Enum


Public Function AddFilesToZip(strSourceDir As String, strDestFile As String, Optional LocationOfWinZip As String) As String
Dim ProcessIsReady As Boolean
Dim CheckFile As Boolean
Dim CheckName As String
Dim HwndOfWinzip As Integer
Dim GetPercentDone As Byte

CheckFile = FileExists(strDestFile, IsFilename)
With Options
If CheckFile = True Then
Select Case .IfFileAlreadyExists
Case 0: GoTo QuitZipProcess '(Default) NotOverwrite
Case 1: Kill strDestFile 'AlwaysOverwrite
Case 2: GoTo QuitZipProcess 'NotOverwrite
Case Else: GoTo QuitZipProcess '(Default) NotOverwrite
End Select
End If
End With

CheckFile = FileExists(strSourceDir, IsDirectory)
If CheckFile = False Then
MsgBox "Deze directory bestaat niet"
Else
Call RunWinZip(strSourceDir, strDestFile)
CheckName = CheckNameToFind(strDestFile)
HwndOfWinzip = FindHwndOfWinzip("WinZip - " & CheckName)

Do Until ProcessIsReady = True
GetPercentDone = GetPercentComplete(HwndOfWinzip)
frmZipping.ProgressBar1.Value = GetPercentDone
frmZipping.ProgressBar1.Refresh
ProcessIsReady = CheckWinzipProcess
DoEvents
Loop
End If
Exit Function

QuitZipProcess:
MsgBox "Het ZIP process is afgebroken"
End Function

Private Function RunWinZip(strSourceDir As String, strDestFile As String, Optional LocationOfWinZip As String, Optional Options As String) As Integer
Dim CommandLine As String

CommandLine = GetOptions
If Trim(LocationOfWinZip) = "" Then
Shell "C:\program Files\Winzip\Winzip32.exe" & CommandLine & strDestFile & " " & strSourceDir & "\*.*", vbHide
Else
Shell LocationOfWinZip & CommandLine & strDestFile & " " & strSourceDir & "\*.*", vbHide
End If
End Function

Private Function FindHwndOfWinzip(strNameToFind As String) As Integer
Dim i As Integer
Dim FindHWND As Integer

Call DoEnumWindows

For i = 1 To InsertWindowInfo.ItemsInArray
FindHWND = InStr(LCase(InsertWindowInfo.GetWindowName(i)), LCase(strNameToFind))
If FindHWND <> 0 Then
GetWinZipHwnd = InsertWindowInfo.GetHWND(i)
Call EnumChildWindows(GetWinZipHwnd, AddressOf WndEnumChildProc, Nothing)
FindHwndOfWinzip = GetProgressHwnd
End If
Next i
End Function

Private Function GetPercentComplete(HwndToTrack As Integer) As Byte
Dim CheckPercentComplete As Byte

CheckPercentComplete = SendMessage(GetProgressHwnd, PBM_GETPOS, 0, ByVal 0)
If CheckPercentComplete > 20 Then
If SetToHide = False Then
Call MoveWindowToHidePos
SetToHide = True
GetPercentComplete = CheckPercentComplete
DoEvents
Else
GetPercentComplete = CheckPercentComplete
DoEvents
End If
Else
GetPercentComplete = CheckPercentComplete
DoEvents
End If
End Function

Private Sub MoveWindowToHidePos()
Dim GetResX As Integer
Dim GetResY As Integer

GetResX = Screen.Width \ Screen.TwipsPerPixelX
GetResY = Screen.Height \ Screen.TwipsPerPixelY

Call MoveWindow(GetWinZipHwnd, GetResX + 1000, GetResY + 1000, 0, 0, 1)
Call ShowWindow(GetWinZipHwnd, SW_SHOW)

End Sub

Private Function GetOptions() As String
Dim MakeCmdLine As String

With Options
Select Case .ActionToDo
Case 0, 1: MakeCmdLine = "-a" 'Add / -a
Case 2: MakeCmdLine = "-f" 'Freshen / -f
Case 3: MakeCmdLine = "-u" 'Update / u
Case 4: MakeCmdLine = "-m" 'Move / -m
Case Else: MakeCmdLine = "-a" 'Add / -a
End Select

Select Case .Compression
Case 0: MakeCmdLine = MakeCmdLine & " -en" '(Default) Normal / -en
Case 1: MakeCmdLine = MakeCmdLine & " -ex" 'Extra / -ex
Case 2: MakeCmdLine = MakeCmdLine & " -en" 'Normal / -en
Case 3: MakeCmdLine = MakeCmdLine & " -ef" 'Fast / -ef
Case 4: MakeCmdLine = MakeCmdLine & " -es" 'Super fast / -es
Case 5: MakeCmdLine = MakeCmdLine & " -e0" 'No compression / -e0
Case Else: MakeCmdLine = MakeCmdLine & " -en" '(Default) Normal / -en
End Select

Select Case .FilesToAdd
Case 0, 1: MakeCmdLine = MakeCmdLine & " -hs" 'AddHiddenSystem / -hs
Case Else: MakeCmdLine = MakeCmdLine & " -hs" '(Default) AddHiddenSystem / -hs
End Select

Select Case .Options
Case 0: MakeCmdLine = MakeCmdLine & " -r" '(Default) Recurse_Directories / -r
Case 1: MakeCmdLine = MakeCmdLine & " -r" 'Recurse_Directories / -r
Case 2: MakeCmdLine = MakeCmdLine & " -p" 'Save_Extra_Directory_Info / -p
Case Else: MakeCmdLine = MakeCmdLine & " -r" '(Default) Recurse_Directories / -r
End Select

Select Case .PassWord
Case 0: 'Nothing - No protection
Case 1: MakeCmdLine = MakeCmdLine & " -s" 'Password protection / -s
Case Else: 'Nothing - No protection
End Select
End With

GetOptions = " " & MakeCmdLine & " "
End Function

Private Function CheckWinzipProcess() As Boolean
Dim strNameOfWinzip As String

strNameOfWinzip = GetWindowName(GetWinZipHwnd)
If Trim(strNameOfWinzip) <> "" Then
CheckWinzipProcess = False
DoEvents
Else
CheckWinzipProcess = True
DoEvents
End If
End Function

Private Function FileExists(Filename, WhatToCheck As CheckDirOrFile) As Boolean
Select Case WhatToCheck
Case 1:
If Right(Filename, 1) <> "\" Then
Filename = Filename & "\"
FileExists = (Dir(Filename) <> "")
End If
Case 2:
FileExists = (Dir(Filename) <> "")
End Select
End Function

Private Function CheckNameToFind(NameToCheck As String) As String
If Mid(NameToCheck, 2, 2) = ":\" Then
CheckNameToFind = Trim(Mid(NameToCheck, 4))
End If
End Function

'module - mdlEnumWindows

Private Declare Function EnumWindows Lib "User32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function EnumChildWindows Lib "User32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Any) As Long
Public GetProgressHwnd As Long
Public GetWinZipHwnd As Long

Public InsertWindowInfo As GetWindowInfo
Private Type GetWindowInfo
GetHWND(1 To 1000) As Integer
GetWindowName(1 To 1000) As String
ItemsInArray As Integer
End Type

Public Sub DoEnumWindows()
Call EnumWindows(AddressOf EnumWindowProc, &H0)
End Sub

Private Function EnumWindowProc(ByVal hwnd As Long, ToListbox As ListBox) As Long
Dim strWindowName As String
Dim strClassName As String

strWindowName = GetWindowName(hwnd)

With InsertWindowInfo
.ItemsInArray = .ItemsInArray + 1
.GetHWND(.ItemsInArray) = CInt(hwnd)
.GetWindowName(.ItemsInArray) = strWindowName
End With

EnumWindowProc = 1 'Zorgt ervoor dat Enumwindows door blijft gaan totdat er geen HWND's meer zijn
End Function

Public Function GetWindowName(Handle As Long) As String
Dim intWindowLenght As Integer
Dim strWindowName As String

intWindowLenght = GetWindowTextLength(Handle) + 1
strWindowName = Space$(intWindowLenght)
GetWindowText Handle, strWindowName, intWindowLenght ' API function call
strWindowName = Mid(strWindowName, 1, Len(strWindowName) - 1)

GetWindowName = strWindowName
End Function

Public Function WndEnumChildProc(ByVal hwnd As Long) As Long
Dim bRet As Long
Dim myStr As String * 50
Dim FindClass As Integer

bRet = GetClassName(hwnd, myStr, 50)

FindClass = InStr(LCase(myStr), "msctls_progress32")
If FindClass <> 0 Then
GetProgressHwnd = hwnd
Else
WndEnumChildProc = 1
End If
End Function

'module - mdlWindowProp

Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, wParam As Any, lParam As Any) As Long
Public Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Declare Function ShowWindow Lib "User32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

'Hoort bij ShowWindow
Public Const SW_HIDE = 0 'Hide the window.
Public Const SW_MAXIMIZE = 3 'Maximize the window.
Public Const SW_MINIMIZE = 6 'Minimize the window.
Public Const SW_RESTORE = 9 'Restore the window (not maximized nor minimized).
Public Const SW_SHOW = 5 'Show the window.
Public Const SW_SHOWMAXIMIZED = 3 'Show the window maximized.
Public Const SW_SHOWMINIMIZED = 2 'Show the window minimized.
Public Const SW_SHOWMINNOACTIVE = 7 'Show the window minimized but do not activate it.
Public Const SW_SHOWNA = 8 'Show the window in its current state but do not activate it.
Public Const SW_SHOWNOACTIVATE = 4 'Show the window in its most recent size and position but do not activate it.
Public Const SW_SHOWNORMAL = 1 'Show the window and activate it (as usual).

'Hoort bij SendMessage
Public Const PBM_STEPIT = 1029
Public Const WM_USER = &H400
Public Const PBM_GETPOS = (WM_USER + 8)


'module - mdlZipOptions

Public Options As ZipOptions
Public Type ZipOptions
ActionToDo As ActionZIP
Options As OptionsZIP
Compression As CompressionZIP
PassWord As String
FilesToAdd As FilesToAddZIP
IfFileAlreadyExists As IfFileExists
End Type


Public Enum ActionZIP
Add = 1 'Add to archive
Freshen = 2 'Freshen archive
Update = 3 'Update archive
Move = 4 'Move to archive
End Enum

Public Enum OptionsZIP
Recurse_Directories = 1 'Recurse Directories
Save_Extra_Directory_Info = 2 'Save Extra Directory Info
End Enum

Public Enum CompressionZIP
eXtra = 1 'Extra
Normal = 2 'Normal
Fast = 3 'Fast
Super_Fast = 4 'Super fast
No_Compression = 5 'No compression
End Enum

Public Enum PassWordZIP
PassWord = 1 'Password protection.
End Enum

Public Enum FilesToAddZIP
AddHiddenSystem = 1 'Add also hidden and system files to archive
DoNotAddHiddenSystem = 1
End Enum

Public Enum IfFileExists
AlwaysOverwrite = 1
NotOverwrite = 2
End Enum




Iouri Boutchkine
iouri@hotsheet.com