Create Zip File From File

Category: Files/Folders

Date: 02-16-2022

Return to Index


 
 
'Credit: William Burns
 
'==================================================
'  CreateZipFile - creates a zip file from a folder
'==================================================
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
#Include "WinShell.inc"  'created by the PowerBasic Com browser on Shell32 lib
 
Function PBMain() As Long
   CreateZipFileFromFile "C:\test\unicode.txt", "c:\test\unicode.zip"
End Function
 
Function CreateZipFileFromFile(byval sFrom as stringbyval sTo as stringas long
   local hFile          as dword
   'Object Variables
   DIM oShellClass      AS IShellDispatch
   DIM oSourceFolder    AS Folder
   DIM oTargetFolder    AS Folder
   DIM oItem            AS FolderItem
   'variants
   DIM vSourceFolder    AS VARIANT
   DIM vTargetFolder    AS VARIANT
   DIM vOptions         AS VARIANT
   DIM vFile            AS VARIANT
   dim sFile            as string
 
   'First we create a empty ZIP file using a standard zip file header
   try
      hFile = freefile
      open sTo for output as #hFile
      print #hFile, Chr$(80,75,5,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
      close #hFile
   catch
      ? "Error creating Zip file: " & sTo & "  Error:" & Error$(err)
      exit function
   end try
 
 
   ' Get an instance of our Windows Shell
   oShellClass = ANYCOM $PROGID_SHELL32_SHELL
 
   ' Did we get the object? If not, terminate this app
   IF ISFALSE ISOBJECT(oShellClass) OR ERR THEN
      ? "Could not get the Windows Shell object.  Error:" & str$(err)
      EXIT FUNCTION
   END IF
 
 
   'assign the source folder we want to zip up
   vSourceFolder = rtrim$(PATHNAME$(PATH, sFrom),"\")
   oSourceFolder = oShellClass.NameSpace(vSourceFolder)
 
   IF ISFALSE ISOBJECT(oSourceFolder) OR ERR THEN
      ? "Could not get the Source folder object.  Error:" & str$(err)
      goto TerminateZip
   END IF
 
 
   'assign the target folder we want to create (in this case it is a zip file)
   vTargetFolder = sTo
   oTargetFolder = oShellClass.NameSpace(vTargetFolder)
 
   IF ISFALSE ISOBJECT(oTargetFolder) OR ERR THEN
      ? "Could not get the Target folder object.  " & sTo & " Error:" & str$(err)
      goto TerminateZip
   END IF
 
 
   'get the file name we are copying
'   sFile = ucode$(PATHNAME$(NAME, sFrom) & PATHNAME$(EXTN, sFrom))
   sFile = PATHNAME$(NAMEX, sFrom)
 
   'assign the file item
   oItem = oSourceFolder.ParseName(sFile)
 
   IF ISFALSE ISOBJECT(oItem) THEN
      ? "Could not get the Item object. " & sFile & " Error:" & str$(err)
      goto TerminateZip
   END IF
 
   'now we start the copy in to the new zip file
   vOptions = 20
   oTargetFolder.CopyHere(oItem, vOptions)
 
   IF ERR THEN
      ? "Got an Error during the CopyHere method.  Error:" & str$(err)
      goto TerminateZip
   END IF
 
   'NOTE:  the above copyhere method starts a seperate thread to do the copy
   'so the command could return before the copy is finished, so we need to
   'allow time to complete.   Thus the next Sleep command.
   sleep 6000   'increase for larger folders
 
   '? sTo + " was successfully created."
   function = %TRUE
 
   TerminateZip:
 
   ' Close all of the Interfaces
vFile = EMPTY
   vSourceFolder     = EMPTY
   vTargetFolder     = EMPTY
   vOptions          = EMPTY
   oItem             = NOTHING
   oTargetFolder     = NOTHING
   oSourceFolder     = NOTHING
   oShellClass       = NOTHING
end function
 
'gbs_01267
'Date: 05-11-2013


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm