An easy zip extraction on XP

[sapero]

This is a console example of how to read data from z zip storage using zipfldr.dll.
In case you get unresolved externals for ILCreateFromPath and ILFree, please recreate shell32.dll import library, from tools menu in your Ebasic IDE.

Code Select Expand

' ZIP extraction using zipfldr.dll from Windows XP
' compile for console

$include "shlwapi.inc"
$include "shlobj.inc"
$include "stdio.inc"
$include "stierr.inc" ' just for STIERR_OBJECTNOTFOUND

$define ZIP_PATH  "D:\\download\\myzip.zip"
'$define UNPACK_TO "D:\\download\\myzip"

CoInitialize(0)
$ifdef UNPACK_TO
OpenZip(ZIP_PATH, UNPACK_TO)
$else
OpenZip(ZIP_PATH, NULL)
$endif
CoUninitialize()


sub ExtractFiles(IStorage storage, pointer pszTargetDir)

   if (!CreateDirectory(pszTargetDir, NULL))
      DWORD dwError = GetLastError()
      if (dwError <> ERROR_ALREADY_EXISTS)
         printf("Failed (%d) to create directory %s\n", dwError, pszTargetDir)
         return
      endif
   endif

   IEnumSTATSTG enumerator
   if (!storage->EnumElements(0,0,0,&enumerator))

      ULONG celtFetched
      STATSTG stat
      while (!enumerator->_Next(1, &stat, &celtFetched) and celtFetched)

         if (stat.pwcsName)

            pointer pszPath = new(char, lstrlen(pszTargetDir) + wcslen(stat.pwcsName) + 2)
            if (pszPath)

               sprintf(pszPath, "%s\\%S", pszTargetDir, stat.pwcsName)

               if (stat._type = STGTY_STORAGE) ' directory

                  IStorage subfolder
                  if (!storage->OpenStorage(stat.pwcsName, 0, STGM_READ, 0, 0, &subfolder))

                     ExtractFiles(subfolder, pszPath)
                     subfolder->Release()
                  endif

               elseif (stat._type = STGTY_STREAM) ' file

                  printf("processing %s ", pszPath)

                  if (stat.cbSize.QuadPart < 1024q)
                     printf("(%d bytes)\n", stat.cbSize.LowPart)
                  elseif (stat.cbSize.QuadPart < 1048576q)
                     printf("(%.2f KB)\n", stat.cbSize.LowPart/1024.0)
                  else
                     printf("(%.2f MB)\n", stat.cbSize.QuadPart/1048576.0)
                  endif

                  IStream stream
                  if (!storage->OpenStream(stat.pwcsName, 0, STGM_READ, 0, &stream))

                     IStream _file
                     ' check if the file exists
                     dwError = SHCreateStreamOnFile(pszPath, STGM_FAILIFTHERE, &_file)
                     if (dwError = STG_E_FILEALREADYEXISTS)

                        BOOL fOverwrite = FALSE
                        if (fOverwrite)
                           dwError = SHCreateStreamOnFile(pszPath, STGM_WRITE | STGM_CREATE, &_file)
                        endif

                     elseif (dwError = STIERR_OBJECTNOTFOUND)
                        dwError = SHCreateStreamOnFile(pszPath, STGM_WRITE | STGM_CREATE, &_file)
                     endif

                     if (dwError and (dwError <> STG_E_FILEALREADYEXISTS))
                        printf("Failed to create '%s' (%x)\n", pszPath, dwError)

                     elseif (!dwError)

                        ULARGE_INTEGER cbSize
                        dwError = stream->CopyTo(_file, stat.cbSize, NULL, &cbSize)
                        _file->Release()

                        'if (dwError or (stat.cbSize.QuadPart <> cbSize.QuadPart))
                        '
                        '    disk full?
                        'endif
                     endif
                     stream->Release()
                  endif
               endif
               delete pszPath
            endif
            CoTaskMemFree(stat.pwcsName)
         endif
      endwhile
      enumerator->Release()
   endif

endsub


sub OpenZip(pointer pszZip, pointer pszTargetDir)

   istring szDir[MAX_PATH]
   if (!pszTargetDir)
      ' extract to path\zipname\
      strncpy(szDir, pszZip, MAX_PATH)
      szDir[MAX_PATH-1] = 0
      PathRemoveExtension(szDir)
      pszTargetDir = szDir
   endif

   pointer pidl = ILCreateFromPath(pszZip)
   if (pidl)

      IShellFolder psfParent
      pointer   pidlChild
      if (!SHBindToParent(pidl, _IID_IShellFolder, &psfParent, &pidlChild))

         ' open the virtual zip root directory as a storage
         IStorage storage
         if (!psfParent->BindToObject(pidlChild, NULL, _IID_IStorage, &storage))

            ExtractFiles(storage, pszTargetDir)
            storage->Release()
         endif
         psfParent->Release()
      endif
      ILFree(pidl)
   endif
endsub

[LarryMc]

Sapero
I made a little addition to your zip extraction so that instead of it extracting all the files in a zip I can specify a single file to extract.
Problem is it only works for files that are in the root dir of the zip because of the way the extract routine calls itself with subdir param.

Two questions:

Is there an EASY solution to where a single file can be extracted regardless of where it resides in the nested directory structure?

Is there any EASY way to always have the extracted file be located is the directory specified in UNPACK_TO without creating any subdirectories regardless of where it resides in the zip nested directory structure?

Larry

[sapero]

Sure, it's easy. stat.pwcsName is the unicode name of current component - subdirectory or file name. Just compare type and names (should be STGTY_STREAM)

Code Select Expand

elseif (stat._type = STGTY_STREAM)
   ' a file
   if (w2s(stat.*<wstring>pwcsName) = "extract me.jpg")
      ' file name found, call storage->OpenStream ... to save it

2. do not allocate pointer pszPath inside ExtractFiles subroutine, just pass pszTargetDir (instead pszPath) to the nesting call to ExtractFiles inside STGTY_STORAGE hadler. Move CreateDirectory right after storage->OpenStream, so no directory will be created if the file could not be found.

This function is answering your two questions:

Code Select Expand

sub FindAndExtractFile(IStorage storage, string szTargetDir, wstring wszFileToExtract)

   IEnumSTATSTG enumerator
   if (!storage->EnumElements(0,0,0,&enumerator))

      ULONG celtFetched
      STATSTG stat
      while (!enumerator->_Next(1, &stat, &celtFetched) and celtFetched)

         if (stat.pwcsName)

            if (stat._type = STGTY_STORAGE) ' directory

               IStorage subfolder
               if (!storage->OpenStorage(stat.pwcsName, 0, STGM_READ, 0, 0, &subfolder))
                  FindAndExtractFile(subfolder, szTargetDir, wszFileToExtract)
                  subfolder->Release()
               endif

            elseif (stat._type = STGTY_STREAM) ' file

               ' file found ?
               if (!wcsicmp(stat.pwcsName, wszFileToExtract))
                  IStream stream
                  if (!storage->OpenStream(stat.pwcsName, 0, STGM_READ, 0, &stream))

                     ' ensure the target directory is valid
                     CreateDir(szTargetDir)

                     IStream _file
                     ' file_path = szTargetDir + "\\" + w2s(wszFileToExtract)
                     ' a) with overwrite prompt:
                     'DWORD dwError = SHCreateStreamOnFile(file_path, STGM_FAILIFTHERE, &_file)
                     ' b) overwrite always:
                     'DWORD dwError = SHCreateStreamOnFile(file_path, STGM_WRITE | STGM_CREATE, &_file)
                     ' [...]
                     stream->Release()
                  endif
               endif
            endif
            CoTaskMemFree(stat.pwcsName)
         endif
      endwhile
      enumerator->Release()
   endif
endsub

Usage:

Code Select Expand

sub OpenZip(pointer pszZip, pointer pszTargetDir)

   ' remove ExtractFiles()
   FindAndExtractFile(storage, *<string>pszTargetDir, L"extract me.jpg")

[LarryMc]

Sapero
When the file already exists the following returns a 0 (No error)

Code Select Expand

    ' a) with overwrite prompt:
    'DWORD dwError = SHCreateStreamOnFile(file_path, STGM_FAILIFTHERE, &_file)
which results in the CopyTo failing to overwrite the file with an error of 0x80030005.

If the file DOES NOT exist the above call returns 0x80070002 and the
CopyTo works and returns 0.

To sum up, the function will not overwrite an existing file but it gives no indication that the file already exists.

Larry

[sapero]

The STGM_FAILIFTHERE (=0) flag you use only to check if the file exists, the function will not create any file if you use this flag.

STGM_FAILIFTHERE
0x00000000L
Causes the create operation to fail if an existing object with the specified name exists. In this case, STG_E_FILEALREADYEXISTS is returned. This is the default creation mode; that is, if no other create flag is specified, STGM_FAILIFTHERE is implied.

There is alternative function: BOOL PathFileExists(string) from shlwapi.inc

Code Select Expand

BOOL create = TRUE

' pick a) or b)

a)
if (SHCreateStreamOnFile(file_path, STGM_FAILIFTHERE, &_file) = STG_E_FILEALREADYEXISTS)
  create = prompt()
endif
' _file is not initialized if STGM_FAILIFTHERE was used.

b)
if (PathFileExists(file_path))
  create = prompt()
endif

if (create)
  dwError = SHCreateStreamOnFile(file_path, STGM_WRITE | STGM_CREATE, &_file)

[LarryMc]

Thanks Sapero,
That cleared it up and resolved the issue for me.

Larry

[LarryMc]

Sapero

In your bag of tricks do you happen to have a routine to add a file to a zip file?


Larry

[sapero]

Hi Larry, I have never tried this, and my first example is failing with undocumented error code 0x80070002, E_FILE_NOT_FOUND.
infile->CopyTo and fileOut->Write is failing.

This is what I have so far, it does not work:

Code Select Expand

' usage ZipAddFile(storage, GetStartPath()+"unzip.eba", FALSE)

sub ZipAddFile(IStorage storage, string path, BOOL overwrite, opt pointer /*unicode*/pwszName=0),DWORD
' storage - one of the folders in your zip
' path - full/relative path to the file to add
' pwszName - optional unicode name for the new archive member. If NULL, file name will be used
pointer pwszAllocated = NULL
IStream infile
IStream fileOut
STATSTG stat
ULARGE_INTEGER cbSize
' open input file
DWORD hr = SHCreateStreamOnFile(path, STGM_READ, &infile)
if (!hr)
print "input opened"
' ensure pwszName is not NULL
if (!pwszName)
' use the file name
pointer pname = PathFindFileName(path)
int cch = lstrlen(pname) + 1
pwszAllocated = new(WCHAR, cch)

if (!pwszAllocated)
hr = E_OUTOFMEMORY
else
MultiByteToWideChar(0,0,pname,-1,pwszAllocated,cch)
pwszName = pwszAllocated
print "created name"
endif
endif

if (!hr)
' check if name exists
hr = storage->CreateStream(pwszName, STGM_FAILIFTHERE, 0, 0, &fileOut)
print "CreateStream 0x",hex$(hr)
select (hr)
case STG_E_FILEALREADYEXISTS
if (overwrite) then hr = storage->CreateStream(pwszName, STGM_WRITE|STGM_CREATE, 0, 0, &fileOut)
case S_OK
' no such file
hr = storage->CreateStream(pwszName, STGM_WRITE|STGM_CREATE, 0, 0, &fileOut)
print "CreateStream 0x",hex$(hr)
endselect

if (!hr)
infile->Stat(&stat, STATFLAG_NONAME) ' size of input file
fileOut->_SetSize(stat.cbSize)
'hr = infile->CopyTo(fileOut, stat.cbSize, NULL, &cbSize)
'print "CopyTo 0x",hex$(hr)
'if (hr)
pointer buffer = new(byte, 4096)
while (!infile->_Read(buffer, 4096, &cch))
print cch
hr = fileOut->_Write(buffer, cch, &cch)
if (hr) then print "fileOut->Write failed 0x",hex$(hr)
endwhile
delete buffer
hr = storage->Commit(STGC_CONSOLIDATE)
print "Commit 0x",hex$(hr)
'endif
endif
endif
infile->Release()
endif
if (pwszAllocated) then delete pwszAllocated
return hr
endsub