Announcement

Collapse
No announcement yet.

LiteZip/LiteUnzip

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • LiteZip/LiteUnzip

    LiteZip and LiteUnzip are two DLLs created by Jeff Glatt and posted in
    The Code Project. They allow to create .zip files and extract the
    contents of a .zip file.

    http://www.codeproject.com/useritems/LiteZip.asp#xxxx

    Here is a translation of the headers to PowerBASIC:

    Code:
    ' ========================================================================================
    ' LiteZip/LiteUnzip
    ' ========================================================================================
    
    ' LiteZip.dll and LiteUnzip.dll are two Win32 Dynamic Link libraries. The former has
    ' functions to create a ZIP archive (ie, compress numerous files into a ZIP file). The
    ' latter has functions to extract the contents of a ZIP archive.
    
    ' This project is largely based upon work by Lucian Wischik, who in turn based his work on
    ' gzip 1.1.4, zlib, and info-zip which are by by Jean-Loup Gailly and Mark Adler. Lucian's
    ' code has been reworked to be written in plain C, using only the Win32 API, and packaged
    ' into 2 DLLs. (Also some improvements to error-checking, some added functionality, and
    ' code-reduction/stream-lining was accomplished). 
    
    
    ' ========================================================================================
    ' /*
    '  * LiteZip.h
    '  *
    '  * For creating zip files using LITEZIP.DLL.
    '  *
    '  * This file is a repackaged form of extracts from the zlib code available
    '  * at www.gzip.org/zlib,  by Jean-Loup Gailly and Mark Adler. The original
    '  * copyright notice may be found in LiteZip.c. The repackaging was done
    '  * by Lucian Wischik to simplify and extend its use in Windows/C++. Also
    '  * encryption and unicode filenames have been added. Code was further
    '  * revamped and turned into a DLL (which supports both UNICODE and ANSI
    '  * C strings) by Jeff Glatt.
    '  */
    
    ' // An HZIP identifies a zip archive that is being created
    ' ========================================================================================
    
    %TZIP_OPTION_GZIP = &H80000000
    
    ' // These are the return codes from Zip functions
    %ZR_OK           = 0     ' // Success
    
    ' // The following come from general system stuff (e.g. files not openable)
    %ZR_NOFILE       = 1     ' // Can't create/open the file
    %ZR_NOALLOC      = 2     ' // Failed to allocate memory
    %ZR_WRITE        = 3     ' // A general error writing to the file
    %ZR_NOTFOUND     = 4     ' // Can't find the specified file in the zip
    %ZR_MORE         = 5     ' // There's still more data to be unzipped
    %ZR_CORRUPT      = 6     ' // The zipfile is corrupt or not a zipfile
    %ZR_READ         = 7     ' // An error reading the file
    %ZR_NOTSUPPORTED = 8     ' // The entry is in a format that can't be decompressed by this Unzip add-on
    
    ' // The following come from mistakes on the part of the caller
    %ZR_ARGS         = 9     ' // Bad arguments passed
    %ZR_NOTMMAP      = 10    ' // Tried to ZipGetMemory, but that only works on mmap zipfiles, which yours wasn't
    %ZR_MEMSIZE      = 11    ' // The memory-buffer size is too small
    %ZR_FAILED       = 12    ' // Already failed when you called this function
    %ZR_ENDED        = 13    ' // The zip creation has already been closed
    %ZR_MISSIZE      = 14    ' // The source file size turned out mistaken
    %ZR_ZMODE        = 15    ' // Tried to mix creating/opening a zip 
    
    ' // The following come from bugs within the zip library itself
    %ZR_SEEK         = 16    ' // trying to seek in an unseekable file
    %ZR_NOCHANGE     = 17    ' // changed its mind on storage, but not allowed
    %ZR_FLATE        = 18    ' // An error in the de/inflation code
    %ZR_PASSWORD     = 19    ' // Password is incorrect
    
    ' ========================================================================================
    ' DWORD WINAPI ZipCreateFileA(HZIP *zipHandle, const char *fn, const char *password)
    ' ========================================================================================
    DECLARE FUNCTION ZipCreateFile LIB "LITEZIP.DLL" ALIAS "ZipCreateFileA" ( _
      BYREF hZip AS DWORD, BYREF szFilename AS ASCIIZ, BYREF szPassword AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipCreateBuffer(HZIP *zipHandle, void *z, DWORD len, const char *password)
    ' ========================================================================================
    DECLARE FUNCTION ZipCreateBuffer LIB "LITEZIP.DLL" ALIAS "ZipCreateBuffer" ( _
      BYREF hZip AS DWORD, BYVAL lpBuffer AS DWORD, BYVAL nSize AS DWORD, BYREF szPassword AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipCreateHandle(HZIP *zipHandle, HANDLE h, const char *password)
    ' ========================================================================================
    DECLARE FUNCTION ZipCreateHandle LIB "LITEZIP.DLL" ALIAS "ZipCreateHandle" ( _
      BYREF hZip AS DWORD, BYVAL fileHandle AS DWORD, BYREF szPassword AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipAddFileA(HZIP tzip, const char *destname, const char *fn)
    ' ========================================================================================
    DECLARE FUNCTION ZipAddFile LIB "LITEZIP.DLL" ALIAS "ZipAddFileA" ( _
      BYVAL hZip AS DWORD, BYREF szZipname AS ASCIIZ, BYREF szFilename AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipAddHandleA(HZIP tzip, const char *destname, HANDLE h)
    ' ========================================================================================
    DECLARE FUNCTION ZipAddHandle LIB "LITEZIP.DLL" ALIAS "ZipAddHandleA" ( _
      BYVAL hZip AS DWORD, BYREF szZipname AS ASCIIZ, BYVAL fileHandle AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipAddBufferA(HZIP tzip, const char *destname, const void *src, DWORD len)
    ' ========================================================================================
    DECLARE FUNCTION ZipAddBuffer LIB "LITEZIP.DLL" ALIAS "ZipAddBufferA" ( _
      BYVAL hZip AS DWORD, BYREF szZipname AS ASCIIZ, BYVAL lpBuffer AS DWORD, BYVAL nSize AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipAddPipeA(HZIP tzip, const char *destname, HANDLE h, DWORD len)
    ' ========================================================================================
    DECLARE FUNCTION ZipAddPipe LIB "LITEZIP.DLL" ALIAS "ZipAddPipeA" ( _
      BYVAL hZip AS DWORD, BYREF szZipname AS ASCIIZ, BYVAL fileHandle AS DWORD, BYVAL nSize AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipAddFolderA(HZIP tzip, const char *destname)
    ' ========================================================================================
    DECLARE FUNCTION ZipAddFolder LIB "LITEZIP.DLL" ALIAS "ZipAddFolderA" ( _
      BYVAL hZip AS DWORD, BYREF szZipname AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipGetMemory(HZIP tzip, void **pbuf, DWORD *plen, HANDLE *base)
    ' ========================================================================================
    DECLARE FUNCTION ZipGetMemory LIB "LITEZIP.DLL" ALIAS "ZipGetMemory" ( _
      BYVAL hZip AS DWORD, BYREF bufferPtr AS DWORD, BYREF nSize AS DWORD, BYREF freeHandle AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipResetMemory(HZIP tzip)
    ' ========================================================================================
    DECLARE FUNCTION ZipResetMemory LIB "LITEZIP.DLL" ALIAS "ZipResetMemory" (BYVAL hZip AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipClose(HZIP tzip)
    ' ========================================================================================
    DECLARE FUNCTION ZipClose LIB "LITEZIP.DLL" ALIAS "ZipClose" (BYVAL hZip AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipOptions(HZIP tzip, DWORD flags)
    ' ========================================================================================
    DECLARE FUNCTION ZipOptions LIB "LITEZIP.DLL" ALIAS "ZipOptions" ( _
      BYVAL hZip AS DWORD, BYVAL flags AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipFormatMessageA(DWORD code, char *buf, DWORD len)
    ' ========================================================================================
    DECLARE FUNCTION ZipFormatMessage LIB "LITEZIP.DLL" ALIAS "ZipFormatMessageA" ( _
      BYVAL errornumber AS DWORD, BYREF lpBuffer AS ASCIIZ, BYVAL buffersize AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI ZipAddDirA(HZIP, const char *, DWORD)
    ' ========================================================================================
    DECLARE FUNCTION ZipAddDir LIB "LITEZIP.DLL" ALIAS "ZipAddDirA" ( _
      BYVAL hZip AS DWORD, BYREF szDirName AS ASCIIZ, BYVAL dwOffset AS DWORD) AS DWORD
    
    ' ========================================================================================
    ' /*
    '  * LiteUnzip.h 
    '  *
    '  * For decompressing the contents of zip archives using LITEUNZIP.DLL.
    '  *
    '  * This file is a repackaged form of extracts from the zlib code available
    '  * at www.gzip.org/zlib,  by Jean-Loup Gailly and Mark Adler. The original
    '  * copyright notice may be found in unzip.cpp. The repackaging was done
    '  * by Lucian Wischik to simplify and extend its use in Windows/C++. Also
    '  * encryption and unicode filenames have been added. Code was further
    '  * revamped and turned into a DLL by Jeff Glatt.
    '  */
    
    ' // An HUNZIP identifies a zip archive that has been opened
    ' ========================================================================================
    
    TYPE ZIPENTRY
      Index AS DWORD                 ' // index of this entry within the zip archive
      Attributes AS DWORD            ' // attributes, as in GetFileAttributes.
      AccessTime AS FILETIME         ' // access filetime
      CreateTime AS FILETIME         ' // create filetime
      ModifyTime AS FILETIME         ' // modify filetime
      CompressedSize AS LONG         ' // sizes of entry, compressed and uncompressed. These
      UncompressedSize AS LONG       ' // may be -1 if not yet known (e.g. being streamed in)
      szName AS ASCIIZ * %MAX_PATH   ' // entry name
    END TYPE
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipOpenFileA(HUNZIP *tunzip, const char *fn, const char *password)
    ' ========================================================================================
    DECLARE FUNCTION UnzipOpenFile LIB "LITEUNZIP.DLL" ALIAS "UnzipOpenFileA" ( _
      BYREF hUnzip AS DWORD, BYREF szFilename AS ASCIIZ, BYREF szPassword AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipOpenBuffer(HUNZIP *tunzip, void *z, DWORD len, const char *password)
    ' ========================================================================================
    DECLARE FUNCTION UnzipOpenBuffer LIB "LITEUNZIP.DLL" ALIAS "UnzipOpenBuffer" ( _
      BYREF hUnzip AS DWORD, BYVAL lpBuffer AS DWORD, BYVAL nSize AS DWORD, BYREF szPassword AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipOpenHandle(HUNZIP *tunzip, HANDLE h, const char *password)
    ' ========================================================================================
    DECLARE FUNCTION UnzipOpenHandle LIB "LITEUNZIP.DLL" ALIAS "UnzipOpenHandle" ( _
      BYREF hUnzip AS DWORD, BYVAL fileHandle AS DWORD, BYREF szPassword AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipGetItemA(HUNZIP tunzip, ZIPENTRY *ze)
    ' ========================================================================================
    DECLARE FUNCTION UnzipGetItem LIB "LITEUNZIP.DLL" ALIAS "UnzipGetItemA" ( _
      BYVAL hUnzip AS DWORD, BYREF ze AS ZIPENTRY) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipFindItemA(HUNZIP tunzip, ZIPENTRY *ze, BOOL ic)
    ' ========================================================================================
    DECLARE FUNCTION UnzipFindItem LIB "LITEUNZIP.DLL" ALIAS "UnzipFindItemA" ( _
      BYVAL hUnzip AS DWORD, BYREF ze AS ZIPENTRY, BYREF ic AS LONG) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipItemToFileA(HUNZIP tunzip, const char *fn, ZIPENTRY *ze)
    ' ========================================================================================
    DECLARE FUNCTION UnzipItemToFile LIB "LITEUNZIP.DLL" ALIAS "UnzipItemToFileA" ( _
      BYVAL hUnzip AS DWORD, BYREF szFilename AS ASCIIZ, BYREF ze AS ZIPENTRY) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipItemToHandle(HUNZIP tunzip, HANDLE h, ZIPENTRY *ze)
    ' ========================================================================================
    DECLARE FUNCTION UnzipItemToHandle LIB "LITEUNZIP.DLL" ALIAS "UnzipItemToHandle" ( _
      BYVAL hUnzip AS DWORD, BYVAL dwHandle AS DWORD, BYREF ze AS ZIPENTRY) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipItemToBuffer(HUNZIP tunzip, void *z, DWORD len, ZIPENTRY *ze)
    ' ========================================================================================
    DECLARE FUNCTION UnzipItemToBuffer LIB "LITEUNZIP.DLL" ALIAS "UnzipItemToBuffer" ( _
      BYVAL hUnzip AS DWORD, BYVAL buffer AS DWORD, BYVAL bufSize AS DWORD, BYREF ze AS ZIPENTRY) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipSetBaseDirA(HUNZIP tunzip, const char *dir)
    ' ========================================================================================
    DECLARE FUNCTION UnzipSetBaseDir LIB "LITEUNZIP.DLL" ALIAS "UnzipSetBaseDirA" ( _
      BYVAL hUnzip AS DWORD, BYREF szDirName AS ASCIIZ) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipFormatMessageA(DWORD code, char *buf, DWORD len)
    ' ========================================================================================
    DECLARE FUNCTION UnzipFormatMessage LIB "LITEUNZIP.DLL" ALIAS "UnzipFormatMessageA" ( _
      BYVAL errornumber AS DWORD, BYREF lpBuffer AS ASCIIZ, BYVAL buffersize AS LONG) AS DWORD
    
    ' ========================================================================================
    ' DWORD WINAPI UnzipClose(HUNZIP tunzip)
    ' ========================================================================================
    DECLARE FUNCTION UnzipClose LIB "LITEUNZIP.DLL" ALIAS "UnzipClose" (BYVAL hUnzip AS DWORD) AS DWORD

    ------------------
    Website: http://com.it-berater.org
    SED Editor, TypeLib Browser, Wrappers for ADO, DAO, ODBC, OLE DB, SQL-DMO, WebBrowser Control, MSHTML, HTML Editing, CDOEX, MSXML, WMI, MSAGENT, Flash Player, Task Scheduler, Accesibility, Structured Storage, WinHTTP, Microsoft ActiveX Controls (Data Binding, ADODC, Flex Grid, Hierarchical Flex Grid, Masked Edit Control, DataList, DataCombo, MAPI, INET, MCI, Winsock, Common Dialog, MSChart, Outlook View Control), and Microsoft Scripting Components.

    [This message has been edited by José Roca (edited March 31, 2006).]
    Forum: http://www.jose.it-berater.org/smfforum/index.php

  • #2
    This example shows how to create a .zip file

    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "WIN32API.INC"
    #INCLUDE "LITEZIP.INC"
    
    FUNCTION PBMAIN () AS LONG
    
       LOCAL hZip AS DWORD
    
       ZipCreateFile(hZip, "test.zip", BYVAL %NULL)
       IF hZip THEN
          ZipAddFile(hZip, "test.jpg", "test.jpg")
          ZipAddFile(hZip, "test.txt", "test.txt")
          ZipClose(hZip)
       END IF
    
    END FUNCTION
    Forum: http://www.jose.it-berater.org/smfforum/index.php

    Comment


    • #3
      This example shows how to extract the files of a .zip file

      Code:
      #COMPILE EXE
      #DIM ALL
      #INCLUDE "WIN32API.INC"
      #INCLUDE "LITEZIP.INC"
      
      FUNCTION PBMAIN () AS LONG
      
         LOCAL hUnzip AS DWORD
         LOCAL ze AS ZIPENTRY
         LOCAL numitems AS DWORD
         LOCAL idx AS DWORD
         
         UnzipOpenFile(hUnzip, "test.zip", BYVAL %NULL)
         IF hUnzip THEN
            ze.Index = &HFFFFFFFF
            UnzipGetItem(hUnzip, ze)
            numitems = ze.Index
            FOR idx = 0 TO numitems - 1
               ze.Index = idx
               UnzipGetItem(hUnzip, ze)
               UnzipItemToFile(hUnzip, ze.szName, ze)
            NEXT
            UnzipClose(hUnzip)
         END IF
      
      END FUNCTION
      Forum: http://www.jose.it-berater.org/smfforum/index.php

      Comment


      • #4
        Code works well for multiple files in the archive. I'm having trouble unzipping an archive which only contains one file. I must be missing something or something is amiss with the code.

        I just need to know if anyone else has tried unzipping a one-file archive with success.

        Thanks in advance,
        Rich

        Comment


        • #5
          1 file

          Richard,

          May be a little late, but, I've been using this for a month or so. Most of my zips have only one file. So-far I've had no trouble un-zipping them.

          Rick
          Rick

          Comment


          • #6
            Hello José,

            Though the post is several years old, I have a question about it:

            How can I add a new file to an already existing ZIP-file?
            When I activate "ZipCreateFile(hZip, "test.zip", BYVAL %NULL)", the existing "Test.zip" gets overwritten.

            Helmut
            (I'm the new)

            Comment


            • #7
              Oops
              Last edited by Stuart McLachlan; 11 Nov 2013, 08:51 AM.

              Comment


              • #8
                Don't know. I don't use it. Just translated the headers. Maybe using UnzipOpenFile to get an handle of the zipped file and then using ZipAddFile? Or maybe it is not supported?

                The code and coumentation are available at:
                http://www.codeproject.com/Articles/...LiteUnzip#xxxx
                Forum: http://www.jose.it-berater.org/smfforum/index.php

                Comment


                • #9
                  This does seem to work - NOT!
                  Code:
                  #IF %DEF(%PB_CC32)
                    #BREAK ON
                   '  #CONSOLE OFF
                  #ENDIF
                  #COMPILE EXE
                  #DIM ALL
                  #INCLUDE "WIN32API.INC"
                  #INCLUDE "LITEZIP.INC"
                   
                  FUNCTION PBMAIN () AS LONG
                   LOCAL hUnzip AS DWORD
                   LOCAL ze AS ZIPENTRY
                   LOCAL numitems AS DWORD
                   LOCAL idx AS DWORD
                   Local sList As String
                   
                     UnzipOpenFile(hUnzip, "test.zip", BYVAL %NULL)
                     IF hUnZip THEN
                        ZipAddFile(hUnZip, "vb.txt", "vb.txt")   ' Your filename, internalfilename (same)
                        UnZipClose(hUnZip)
                     END IF
                   
                     UnzipOpenFile(hUnzip, "test.zip", BYVAL %NULL)
                     IF hUnzip THEN
                        ze.Index = &HFFFFFFFF
                        UnzipGetItem(hUnzip, ze)
                        numitems = ze.Index
                        FOR idx = 0 TO numitems - 1
                           ze.Index = idx
                           UnzipGetItem(hUnzip, ze)
                           sList += ze.szName + $CRLF
                   '         UnzipItemToFile(hUnzip, ze.szName, ze)
                        NEXT
                        UnzipClose(hUnzip)
                     END IF
                    sList = "numitems" + Str$(numitems)+ $CRLF + sList
                    #IF %DEF(%PB_CC32)
                     STDOUT sList
                     WaitKey$
                    #ELSE
                     ? sList
                    #ENDIF
                  END FUNCTION
                  Thanks José
                  Last edited by Dave Biggs; 15 Nov 2013, 09:06 AM. Reason: Revisited - NOT working after all - see post #11
                  Rgds, Dave

                  Comment


                  • #10
                    Thank you, José and Dave.

                    Hello Dave,

                    I tried your program, but unfortunately it doesn't work. Probably "UnzipOpenFile()" can open "Test.zip" only for reading, not for writing.
                    I was working with PBWIN 10.03 when I tried the program. Did you work with a drifferent version?

                    Unfortunately, also José's link doesn't say anything about "ZipAddOpen()".

                    Helmut

                    from Germany

                    Comment


                    • #11
                      Hi Helmut,

                      Sorry, the code I posted did not add to the zipped file after all.
                      My testing was faulty somehow (I think I used explorer to add a file to the archive by click and drag at some stage and forgot to start over with a fresh copy ).

                      It seems that simple adding is not supported. You may need to extract all the files to a temporary folder, add more files and re-zip
                      Rgds, Dave

                      Comment


                      • #12
                        Hello,

                        OK, return to PKZIP .... ! unfortunate!

                        Thanks again, Dave

                        Comment


                        • #13
                          Helmut, you could try using the built-in Windows API "zip" functionality... see Larry's code at:

                          http://www.powerbasic.com/support/pb...ad.php?t=51433
                          3.14159265358979323846264338327950
                          "Ok, yes... I like pie... um, I meant, pi."

                          Comment


                          • #14
                            And here's an UNZIP example using Windows "zip" API by Theo:

                            Code:
                            Sub Unzip1()
                                Dim FSO As Object
                                Dim oApp As Object
                                Dim Fname As Variant
                                Dim FileNameFolder As Variant
                                Dim DefPath As String
                                Dim strDate As String
                            
                                Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                                                    MultiSelect:=False)
                                If Fname = False Then
                                    'Do nothing
                                Else
                                    'Root folder for the new folder.
                                    'You can also use DefPath = "C:\Users\Ron\test\"
                                    DefPath = Application.DefaultFilePath
                                    If Right(DefPath, 1) <> "\" Then
                                        DefPath = DefPath & "\"
                                    End If
                            
                                    'Create the folder name
                                    strDate = Format(Now, " dd-mm-yy h-mm-ss")
                                    FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
                            
                                    'Make the normal folder in DefPath
                                    MkDir FileNameFolder
                            
                                    'Extract the files into the newly created folder
                                    Set oApp = CreateObject("Shell.Application")
                            
                                    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
                            
                                    'If you want to extract only one file you can use this:
                                    'oApp.Namespace(FileNameFolder).CopyHere _
                                     'oApp.Namespace(Fname).items.Item("test.txt")
                            
                                    MsgBox "You find the files here: " & FileNameFolder
                            
                                    On Error Resume Next
                                    Set FSO = CreateObject("scripting.filesystemobject")
                                    FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
                                End If
                            End Sub
                            3.14159265358979323846264338327950
                            "Ok, yes... I like pie... um, I meant, pi."

                            Comment


                            • #15
                              Another example, don't know where this came from:

                              Code:
                              #COMPILE EXE
                              #DIM ALL
                              #DEBUG ERROR ON
                              #DEBUG DISPLAY ON
                              
                              #INCLUDE "win32api.inc"
                              #INCLUDE "winshell.inc"
                              
                              FUNCTION PBMAIN() AS LONG
                                 DIM fList(1) AS STRING
                                 fList(0) = "c:\test\arguments.txt"                     '<--------- use your own  --------
                                 fList(1) = "c:\test\unicode.txt"                       '<--------- use your own  --------
                              
                                 CreateZipFileFromList fList(), "c:\test\allfiles.zip"  '<--------- use your own  --------
                              END FUNCTION
                              
                              '==================================================
                              '  CreateZipFile - creates a zip file
                              '==================================================
                              FUNCTION CreateZipFileFromList(fList() AS STRING, BYVAL sTo AS STRING) AS 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
                                 DIM i                AS LONG          '-----------new---------------------------
                              
                                 'First we create an 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
                              
                              
                              FOR i = 0 TO UBOUND(fList)                  '-----------new----------------------
                              
                              
                                 'assign the source folder we want to zip up
                                 vSourceFolder = RTRIM$(PATHNAME$(PATH, fList(i)),"\")    '--------modified------------
                                 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, fList(i))                '-----------modified for PBWin10 -----
                              
                              '------------> fixed part --------------------------->
                              ' ---> change "oItem" with "sSourceFolder" and the example will work.
                              ' ---> You will find in new created zipfolder the textfile ! :)
                              
                                 'assign the file item
                                 oItem = oSourceFolder.ParseName(sFile)
                              '   oSourceFolder = oShellClass.NameSpace(vSourceFolder)
                                 IF ISFALSE ISOBJECT(oSourceFolder) OR ERR THEN 'change oItem
                                    ? "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(oSourceFolder, vOptions) 'change oItem
                              
                                 IF ERR THEN
                                    ? "Got an Error during the CopyHere method.  Error:" & STR$(ERR)
                                    GOTO TerminateZip
                                 END IF
                              
                              '------------> fixed part end --------------------------->
                              
                              NEXT i                                      '-----------new----------------------
                              
                                 '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
                              Code:
                              ' Generated by: PowerBASIC COM Browser v.2.00.0058
                              ' DateTime    : 9/3/2008 at 7:48 PM
                              ' ------------------------------------------------
                              ' Library Name: Shell32
                              ' Library File: C:\WINDOWS\system32\SHELL32.dll
                              ' Description : Microsoft Shell Controls And Automation
                              ' GUID : {50A7E9B0-70EF-11D1-B75A-00A0C90564FE}
                              ' LCID : 0
                              ' Version : 1.0
                              
                              ' Version Dependant ProgID's
                              $PROGID_Shell32_ShellFolderViewOC1 = "Shell.FolderView.1"
                              $PROGID_Shell32_Shell1 = "Shell.Application.1"
                              
                              ' Version Independant ProgID's
                              $PROGID_Shell32_ShellFolderViewOC = "Shell.FolderView"
                              $PROGID_Shell32_Shell = "Shell.Application"
                              
                              ' Class Indentifiers
                              $CLSID_Shell32_ShellFolderViewOC = GUID$("{9BA05971-F6A8-11CF-A442-00A0C90A8F39}")
                              $CLSID_Shell32_Event_DShellFolderViewEvents = GUID$("{98902208-269E-4518-AA56-325D7488F20D}")
                              $CLSID_Shell32_ShellFolderItem = GUID$("{2FE352EA-FD1F-11D2-B1F4-00C04F8EEB3E}")
                              $CLSID_Shell32_ShellLinkObject = GUID$("{11219420-1768-11D1-95BE-00609797EA4F}")
                              $CLSID_Shell32_ShellFolderView = GUID$("{62112AA1-EBE4-11CF-A5FB-0020AFE7292D}")
                              $CLSID_Shell32_Shell = GUID$("{13709620-C279-11CE-A49E-444553540000}")
                              $CLSID_Shell32_ShellDispatchInproc = GUID$("{0A89A860-D7B1-11CE-8350-444553540000}")
                              $CLSID_Shell32_WebViewFolderContents = GUID$("{1820FED0-473E-11D0-A96C-00C04FD705A2}")
                              $CLSID_Shell32_SearchCommand = GUID$("{B005E690-678D-11D1-B758-00A0C90564FE}")
                              $CLSID_Shell32_Event_DSearchCommandEvents = GUID$("{BF273C84-D95B-4AEA-9D91-EB63DCD0073F}")
                              $CLSID_Shell32_FileSearchBand = GUID$("{C4EE31F3-4768-11D2-BE5C-00A0C9A83DA1}")
                              $CLSID_Shell32_PassportClientServices = GUID$("{2D2307C8-7DB4-40D6-9100-D52AF4F97A5B}")
                              
                              ' Interface Indentifiers
                              $IID_Shell32_IFolderViewOC = GUID$("{9BA05970-F6A8-11CF-A442-00A0C90A8F39}")
                              $IID_Shell32_DShellFolderViewEvents = GUID$("{62112AA2-EBE4-11CF-A5FB-0020AFE7292D}")
                              $IID_Shell32_DFConstraint = GUID$("{4A3DF050-23BD-11D2-939F-00A0C91EEDBA}")
                              $IID_Shell32_ISearchCommandExt = GUID$("{1D2EFD50-75CE-11D1-B75A-00A0C90564FE}")
                              $IID_Shell32_FolderItem = GUID$("{FAC32C80-CBE4-11CE-8350-444553540000}")
                              $IID_Shell32_FolderItemVerbs = GUID$("{1F8352C0-50B0-11CF-960C-0080C7F4EE85}")
                              $IID_Shell32_FolderItemVerb = GUID$("{08EC3E00-50B0-11CF-960C-0080C7F4EE85}")
                              $IID_Shell32_FolderItems = GUID$("{744129E0-CBE5-11CE-8350-444553540000}")
                              $IID_Shell32_Folder = GUID$("{BBCBDE60-C3FF-11CE-8350-444553540000}")
                              $IID_Shell32_Folder2 = GUID$("{F0D2D8EF-3890-11D2-BF8B-00C04FB93661}")
                              $IID_Shell32_Folder3 = GUID$("{A7AE5F64-C4D7-4D7F-9307-4D24EE54B841}")
                              $IID_Shell32_FolderItem2 = GUID$("{EDC817AA-92B8-11D1-B075-00C04FC33AA5}")
                              $IID_Shell32_FolderItems2 = GUID$("{C94F0AD0-F363-11D2-A327-00C04F8EEC7F}")
                              $IID_Shell32_FolderItems3 = GUID$("{EAA7C309-BBEC-49D5-821D-64D966CB667F}")
                              $IID_Shell32_IShellLinkDual = GUID$("{88A05C00-F000-11CE-8350-444553540000}")
                              $IID_Shell32_IShellLinkDual2 = GUID$("{317EE249-F12E-11D2-B1E4-00C04F8EEB3E}")
                              $IID_Shell32_IShellFolderViewDual = GUID$("{E7A1AF80-4D96-11CF-960C-0080C7F4EE85}")
                              $IID_Shell32_IShellFolderViewDual2 = GUID$("{31C147B6-0ADE-4A3C-B514-DDF932EF6D17}")
                              $IID_Shell32_IShellDispatch = GUID$("{D8F015C0-C278-11CE-A49E-444553540000}")
                              $IID_Shell32_IShellDispatch2 = GUID$("{A4C6892C-3BA9-11D2-9DEA-00C04FB16162}")
                              $IID_Shell32_IShellDispatch3 = GUID$("{177160CA-BB5A-411C-841D-BD38FACDEAA0}")
                              $IID_Shell32_IShellDispatch4 = GUID$("{EFD84B2D-4BCF-4298-BE25-EB542A59FBDA}")
                              $IID_Shell32_DSearchCommandEvents = GUID$("{60890160-69F0-11D1-B758-00A0C90564FE}")
                              $IID_Shell32_IFileSearchBand = GUID$("{2D91EEA1-9932-11D2-BE86-00A0C9A83DA1}")
                              $IID_Shell32_IWebWizardHost = GUID$("{18BCC359-4990-4BFB-B951-3C83702BE5F9}")
                              $IID_Shell32_INewWDEvents = GUID$("{0751C551-7568-41C9-8E5B-E22E38919236}")
                              $IID_Shell32_IPassportClientServices = GUID$("{B30F7305-5967-45D1-B7BC-D6EB7163D770}")
                              
                              ' SearchCommandExecuteErrors enumeration
                              %SCEE_PATHNOTFOUND = 1
                              %SCEE_MAXFILESFOUND = 2
                              %SCEE_INDEXSEARCH = 3
                              %SCEE_CONSTRAINT = 4
                              %SCEE_SCOPEMISMATCH = 5
                              %SCEE_CASESENINDEX = 6
                              %SCEE_INDEXNOTCOMPLETE = 7
                              
                              ' OfflineFolderStatus enumeration
                              %OFS_INACTIVE = -1
                              %OFS_ONLINE = 0
                              %OFS_OFFLINE = 1
                              %OFS_SERVERBACK = 2
                              %OFS_DIRTYCACHE = 3
                              
                              ' ShellFolderViewOptions enumeration
                              %SFVVO_SHOWALLOBJECTS = 1
                              %SFVVO_SHOWEXTENSIONS = 2
                              %SFVVO_SHOWCOMPCOLOR = 8
                              %SFVVO_SHOWSYSFILES = 32
                              %SFVVO_WIN95CLASSIC = 64
                              %SFVVO_DOUBLECLICKINWEBVIEW = 128
                              %SFVVO_DESKTOPHTML = 512
                              
                              ' ShellSpecialFolderConstants enumeration
                              %ssfDESKTOP = 0
                              %ssfPROGRAMS = 2
                              %ssfCONTROLS = 3
                              %ssfPRINTERS = 4
                              %ssfPERSONAL = 5
                              %ssfFAVORITES = 6
                              %ssfSTARTUP = 7
                              %ssfRECENT = 8
                              %ssfSENDTO = 9
                              %ssfBITBUCKET = 10
                              %ssfSTARTMENU = 11
                              %ssfDESKTOPDIRECTORY = 16
                              %ssfDRIVES = 17
                              %ssfNETWORK = 18
                              %ssfNETHOOD = 19
                              %ssfFONTS = 20
                              %ssfTEMPLATES = 21
                              %ssfCOMMONSTARTMENU = 22
                              %ssfCOMMONPROGRAMS = 23
                              %ssfCOMMONSTARTUP = 24
                              %ssfCOMMONDESKTOPDIR = 25
                              %ssfAPPDATA = 26
                              %ssfPRINTHOOD = 27
                              %ssfLOCALAPPDATA = 28
                              %ssfALTSTARTUP = 29
                              %ssfCOMMONALTSTARTUP = 30
                              %ssfCOMMONFAVORITES = 31
                              %ssfINTERNETCACHE = 32
                              %ssfCOOKIES = 33
                              %ssfHISTORY = 34
                              %ssfCOMMONAPPDATA = 35
                              %ssfWINDOWS = 36
                              %ssfSYSTEM = 37
                              %ssfPROGRAMFILES = 38
                              %ssfMYPICTURES = 39
                              %ssfPROFILE = 40
                              %ssfSYSTEMx86 = 41
                              %ssfPROGRAMFILESx86 = 48
                              
                              
                              ' Interface Name  : IFolderViewOC
                              ' Description     : Folder View Events Forwarder Object
                              ' ClassID         : $CLSID_Shell32_ShellFolderViewOC
                              ' ProgID          : $PROGID_Shell32_ShellFolderViewOC
                              ' Version ProgID  : $PROGID_Shell32_ShellFolderViewOC1
                              INTERFACE IFolderViewOC $IID_Shell32_IFolderViewOC
                                  INHERIT IDISPATCH
                              
                                  METHOD SetFolderView <1610743808> (BYVAL pdisp AS IDISPATCH)
                              END INTERFACE
                              
                              ' Interface Name  : DShellFolderViewEvents
                              ' Description     : Event interface for ShellFolderView
                              ' ClassID         : $CLSID_Shell32_Event_DShellFolderViewEvents
                              ' ProgID          : $PROGID_Shell32_ShellFolderViewOC
                              ' Version ProgID  : $PROGID_Shell32_ShellFolderViewOC1
                              CLASS Class_DShellFolderViewEvents $CLSID_Shell32_Event_DShellFolderViewEvents AS EVENT
                                  INTERFACE DShellFolderViewEvents $IID_Shell32_DShellFolderViewEvents
                                      INHERIT IDISPATCH
                              
                                      METHOD SelectionChanged <200> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD EnumDone <201> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD VerbInvoked <202> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD DefaultVerbInvoked <203> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD BeginDrag <204> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                  END INTERFACE
                              END CLASS
                              
                              ' Interface Name  : DFConstraint
                              ' Description     : Constraint used in search command
                              INTERFACE DFConstraint $IID_Shell32_DFConstraint
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET NAME <1610743808> () AS STRING
                                  PROPERTY GET Value <1610743809> () AS VARIANT
                              END INTERFACE
                              
                              ' Interface Name  : ISearchCommandExt
                              ' Description     : DocFind automation interface
                              INTERFACE ISearchCommandExt $IID_Shell32_ISearchCommandExt
                                  INHERIT IDISPATCH
                              
                                  METHOD ClearResults <1> ()
                                  METHOD NavigateToSearchResults <2> ()
                                  PROPERTY GET ProgressText <3> () AS STRING
                                  METHOD SaveSearch <4> ()
                                  METHOD GetErrorInfo <5> (BYREF pbs AS STRING) AS LONG
                                  METHOD SearchFor <6> (BYVAL iFor AS LONG)
                                  METHOD GetScopeInfo <7> (BYVAL bsScope AS STRING, BYREF pdwScopeInfo AS LONG)
                                  METHOD RestoreSavedSearch <8> (BYREF IN pvarFile AS VARIANT)
                                  METHOD Execute <100> (OPT BYREF IN RecordsAffected AS VARIANT, OPT BYREF IN Parameters AS VARIANT, OPT BYVAL Options AS _
                                      LONG)
                                  METHOD AddConstraint <101> (BYVAL PB_Name AS STRING, BYVAL Value AS VARIANT)
                                  METHOD GetNextConstraint <102> (BYVAL fReset AS INTEGER) AS DFConstraint
                              END INTERFACE
                              
                              ' Interface Name  : FolderItem
                              ' Description     : Definition of interface FolderItem
                              INTERFACE FolderItem $IID_Shell32_FolderItem
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  PROPERTY GET NAME <0> () AS STRING
                                  PROPERTY SET NAME <0> (BYVAL pbs AS STRING)
                                  PROPERTY GET PATH <1610743812> () AS STRING
                                  PROPERTY GET GetLink <1610743813> () AS IDISPATCH
                                  PROPERTY GET GetFolder <1610743814> () AS IDISPATCH
                                  PROPERTY GET IsLink <1610743815> () AS INTEGER
                                  PROPERTY GET ISFOLDER <1610743816> () AS INTEGER
                                  PROPERTY GET IsFileSystem <1610743817> () AS INTEGER
                                  PROPERTY GET IsBrowsable <1610743818> () AS INTEGER
                                  PROPERTY GET ModifyDate <1610743819> () AS DOUBLE
                                  PROPERTY SET ModifyDate <1610743819> (BYVAL pdt AS DOUBLE)
                                  PROPERTY GET SIZE <1610743821> () AS LONG
                                  PROPERTY GET TYPE <1610743822> () AS STRING
                                  METHOD Verbs <1610743823> () AS FolderItemVerbs
                                  METHOD InvokeVerb <1610743824> (OPT BYVAL vVerb AS VARIANT)
                              END INTERFACE
                              
                              ' Interface Name  : FolderItemVerbs
                              ' Description     : Definition of interface FolderItemVerbs
                              INTERFACE FolderItemVerbs $IID_Shell32_FolderItemVerbs
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET COUNT <1610743808> () AS LONG
                                  PROPERTY GET Application <1610743809> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743810> () AS IDISPATCH
                                  METHOD ITEM <1610743811> (OPT BYVAL index AS VARIANT) AS FolderItemVerb
                                  METHOD Meth__NewEnum <-4> () AS IUNKNOWN
                              END INTERFACE
                              
                              ' Interface Name  : FolderItemVerb
                              ' Description     : Definition of interface FolderItemVerb
                              INTERFACE FolderItemVerb $IID_Shell32_FolderItemVerb
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  PROPERTY GET NAME <0> () AS STRING
                                  METHOD DoIt <1610743811> ()
                              END INTERFACE
                              
                              ' Interface Name  : FolderItems
                              ' Description     : Definition of interface FolderItems
                              INTERFACE FolderItems $IID_Shell32_FolderItems
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET COUNT <1610743808> () AS LONG
                                  PROPERTY GET Application <1610743809> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743810> () AS IDISPATCH
                                  METHOD ITEM <1610743811> (OPT BYVAL index AS VARIANT) AS FolderItem
                                  METHOD Meth__NewEnum <-4> () AS IUNKNOWN
                              END INTERFACE
                              
                              ' Interface Name  : Folder
                              ' Description     : Definition of interface Folder
                              INTERFACE Folder $IID_Shell32_Folder
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Title <0> () AS STRING
                                  PROPERTY GET Application <1610743809> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743810> () AS IDISPATCH
                                  PROPERTY GET ParentFolder <1610743811> () AS Folder
                                  METHOD Items <1610743812> () AS FolderItems
                                  METHOD ParseName <1610743813> (BYVAL bName AS STRING) AS FolderItem
                                  METHOD NewFolder <1610743814> (BYVAL bName AS STRING, OPT BYVAL vOptions AS VARIANT)
                                  METHOD MoveHere <1610743815> (BYVAL vItem AS VARIANT, OPT BYVAL vOptions AS VARIANT)
                                  METHOD CopyHere <1610743816> (BYVAL vItem AS VARIANT, OPT BYVAL vOptions AS VARIANT)
                                  METHOD GetDetailsOf <1610743817> (BYVAL vItem AS VARIANT, BYVAL iColumn AS LONG) AS STRING
                              END INTERFACE
                              
                              ' Interface Name  : Folder2
                              ' Description     : Definition of interface Folder2
                              INTERFACE Folder2 $IID_Shell32_Folder2
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Title <0> () AS STRING
                                  PROPERTY GET Application <1610743809> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743810> () AS IDISPATCH
                                  PROPERTY GET ParentFolder <1610743811> () AS Folder
                                  METHOD Items <1610743812> () AS FolderItems
                                  METHOD ParseName <1610743813> (BYVAL bName AS STRING) AS FolderItem
                                  METHOD NewFolder <1610743814> (BYVAL bName AS STRING, OPT BYVAL vOptions AS VARIANT)
                                  METHOD MoveHere <1610743815> (BYVAL vItem AS VARIANT, OPT BYVAL vOptions AS VARIANT)
                                  METHOD CopyHere <1610743816> (BYVAL vItem AS VARIANT, OPT BYVAL vOptions AS VARIANT)
                                  METHOD GetDetailsOf <1610743817> (BYVAL vItem AS VARIANT, BYVAL iColumn AS LONG) AS STRING
                                  PROPERTY GET Self <1610809344> () AS FolderItem
                                  PROPERTY GET OfflineStatus <1610809345> () AS LONG
                                  METHOD Synchronize <1610809346> ()
                                  PROPERTY GET HaveToShowWebViewBarricade <1> () AS INTEGER
                                  METHOD DismissedWebViewBarricade <1610809348> ()
                              END INTERFACE
                              
                              ' Interface Name  : Folder3
                              ' Description     : Definition of interface Folder version 3
                              INTERFACE Folder3 $IID_Shell32_Folder3
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Title <0> () AS STRING
                                  PROPERTY GET Application <1610743809> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743810> () AS IDISPATCH
                                  PROPERTY GET ParentFolder <1610743811> () AS Folder
                                  METHOD Items <1610743812> () AS FolderItems
                                  METHOD ParseName <1610743813> (BYVAL bName AS STRING) AS FolderItem
                                  METHOD NewFolder <1610743814> (BYVAL bName AS STRING, OPT BYVAL vOptions AS VARIANT)
                                  METHOD MoveHere <1610743815> (BYVAL vItem AS VARIANT, OPT BYVAL vOptions AS VARIANT)
                                  METHOD CopyHere <1610743816> (BYVAL vItem AS VARIANT, OPT BYVAL vOptions AS VARIANT)
                                  METHOD GetDetailsOf <1610743817> (BYVAL vItem AS VARIANT, BYVAL iColumn AS LONG) AS STRING
                                  PROPERTY GET Self <1610809344> () AS FolderItem
                                  PROPERTY GET OfflineStatus <1610809345> () AS LONG
                                  METHOD Synchronize <1610809346> ()
                                  PROPERTY GET HaveToShowWebViewBarricade <1> () AS INTEGER
                                  METHOD DismissedWebViewBarricade <1610809348> ()
                                  PROPERTY GET ShowWebViewBarricade <2> () AS INTEGER
                                  PROPERTY SET ShowWebViewBarricade <2> (BYVAL pbShowWebViewBarricade AS INTEGER)
                              END INTERFACE
                              
                              ' Interface Name  : FolderItem2
                              ' Description     : Definition of interface FolderItem Version 2
                              ' ClassID         : $CLSID_Shell32_ShellFolderItem
                              INTERFACE FolderItem2 $IID_Shell32_FolderItem2
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  PROPERTY GET NAME <0> () AS STRING
                                  PROPERTY SET NAME <0> (BYVAL Rhs AS STRING)
                                  PROPERTY GET PATH <1610743812> () AS STRING
                                  PROPERTY GET GetLink <1610743813> () AS IDISPATCH
                                  PROPERTY GET GetFolder <1610743814> () AS IDISPATCH
                                  PROPERTY GET IsLink <1610743815> () AS INTEGER
                                  PROPERTY GET ISFOLDER <1610743816> () AS INTEGER
                                  PROPERTY GET IsFileSystem <1610743817> () AS INTEGER
                                  PROPERTY GET IsBrowsable <1610743818> () AS INTEGER
                                  PROPERTY GET ModifyDate <1610743819> () AS DOUBLE
                                  PROPERTY SET ModifyDate <1610743819> (BYVAL Rhs AS DOUBLE)
                                  PROPERTY GET SIZE <1610743821> () AS LONG
                                  PROPERTY GET TYPE <1610743822> () AS STRING
                                  METHOD Verbs <1610743823> () AS FolderItemVerbs
                                  METHOD InvokeVerb <1610743824> (OPT BYVAL vVerb AS VARIANT)
                                  METHOD InvokeVerbEx <1610809344> (OPT BYVAL vVerb AS VARIANT, OPT BYVAL vArgs AS VARIANT)
                                  METHOD ExtendedProperty <1610809345> (BYVAL bstrPropName AS STRING) AS VARIANT
                              END INTERFACE
                              
                              ' Interface Name  : FolderItems2
                              ' Description     : Definition of interface FolderItems Version 2
                              INTERFACE FolderItems2 $IID_Shell32_FolderItems2
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET COUNT <1610743808> () AS LONG
                                  PROPERTY GET Application <1610743809> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743810> () AS IDISPATCH
                                  METHOD ITEM <1610743811> (OPT BYVAL index AS VARIANT) AS FolderItem
                                  METHOD Meth__NewEnum <-4> () AS IUNKNOWN
                                  METHOD InvokeVerbEx <1610809344> (OPT BYVAL vVerb AS VARIANT, OPT BYVAL vArgs AS VARIANT)
                              END INTERFACE
                              
                              ' Interface Name  : FolderItems3
                              ' Description     : Definition of interface FolderItems Version 3
                              INTERFACE FolderItems3 $IID_Shell32_FolderItems3
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET COUNT <1610743808> () AS LONG
                                  PROPERTY GET Application <1610743809> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743810> () AS IDISPATCH
                                  METHOD ITEM <1610743811> (OPT BYVAL index AS VARIANT) AS FolderItem
                                  METHOD Meth__NewEnum <-4> () AS IUNKNOWN
                                  METHOD InvokeVerbEx <1610809344> (OPT BYVAL vVerb AS VARIANT, OPT BYVAL vArgs AS VARIANT)
                                  METHOD Filter <1610874880> (BYVAL grfFlags AS LONG, BYVAL bstrFileSpec AS STRING)
                                  PROPERTY GET Verbs <0> () AS FolderItemVerbs
                              END INTERFACE
                              
                              ' Interface Name  : IShellLinkDual
                              ' Description     : Definition of Shell Link IDispatch interface
                              ' ClassID         : $CLSID_Shell32_ShellLinkObject
                              INTERFACE IShellLinkDual $IID_Shell32_IShellLinkDual
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET PATH <1610743808> () AS STRING
                                  PROPERTY SET PATH <1610743808> (BYVAL pbs AS STRING)
                                  PROPERTY GET Description <1610743810> () AS STRING
                                  PROPERTY SET Description <1610743810> (BYVAL pbs AS STRING)
                                  PROPERTY GET WorkingDirectory <1610743812> () AS STRING
                                  PROPERTY SET WorkingDirectory <1610743812> (BYVAL pbs AS STRING)
                                  PROPERTY GET Arguments <1610743814> () AS STRING
                                  PROPERTY SET Arguments <1610743814> (BYVAL pbs AS STRING)
                                  PROPERTY GET Hotkey <1610743816> () AS LONG
                                  PROPERTY SET Hotkey <1610743816> (BYVAL piHK AS LONG)
                                  PROPERTY GET ShowCommand <1610743818> () AS LONG
                                  PROPERTY SET ShowCommand <1610743818> (BYVAL piShowCommand AS LONG)
                                  METHOD Resolve <1610743820> (BYVAL fFlags AS LONG)
                                  METHOD GetIconLocation <1610743821> (BYREF pbs AS STRING) AS LONG
                                  METHOD SetIconLocation <1610743822> (BYVAL bs AS STRING, BYVAL iIcon AS LONG)
                                  METHOD SAVE <1610743823> (OPT BYVAL vWhere AS VARIANT)
                              END INTERFACE
                              
                              ' Interface Name  : IShellLinkDual2
                              ' Description     : Shell Link2 IDispatch interface
                              INTERFACE IShellLinkDual2 $IID_Shell32_IShellLinkDual2
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET PATH <1610743808> () AS STRING
                                  PROPERTY SET PATH <1610743808> (BYVAL Rhs AS STRING)
                                  PROPERTY GET Description <1610743810> () AS STRING
                                  PROPERTY SET Description <1610743810> (BYVAL Rhs AS STRING)
                                  PROPERTY GET WorkingDirectory <1610743812> () AS STRING
                                  PROPERTY SET WorkingDirectory <1610743812> (BYVAL Rhs AS STRING)
                                  PROPERTY GET Arguments <1610743814> () AS STRING
                                  PROPERTY SET Arguments <1610743814> (BYVAL Rhs AS STRING)
                                  PROPERTY GET Hotkey <1610743816> () AS LONG
                                  PROPERTY SET Hotkey <1610743816> (BYVAL Rhs AS LONG)
                                  PROPERTY GET ShowCommand <1610743818> () AS LONG
                                  PROPERTY SET ShowCommand <1610743818> (BYVAL Rhs AS LONG)
                                  METHOD Resolve <1610743820> (BYVAL fFlags AS LONG)
                                  METHOD GetIconLocation <1610743821> (BYREF pbs AS STRING) AS LONG
                                  METHOD SetIconLocation <1610743822> (BYVAL bs AS STRING, BYVAL iIcon AS LONG)
                                  METHOD SAVE <1610743823> (OPT BYVAL vWhere AS VARIANT)
                                  PROPERTY GET Target <1610809344> () AS FolderItem
                              END INTERFACE
                              
                              ' Interface Name  : IShellFolderViewDual
                              ' Description     : definition of interface IShellFolderViewDual
                              ' ClassID         : $CLSID_Shell32_WebViewFolderContents
                              INTERFACE IShellFolderViewDual $IID_Shell32_IShellFolderViewDual
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  PROPERTY GET Folder <1610743810> () AS Folder
                                  METHOD SelectedItems <1610743811> () AS FolderItems
                                  PROPERTY GET FocusedItem <1610743812> () AS FolderItem
                                  METHOD SelectItem <1610743813> (BYREF IN pvfi AS VARIANT, BYVAL dwFlags AS LONG)
                                  METHOD PopupItemMenu <1610743814> (BYVAL pfi AS FolderItem, OPT BYVAL vx AS VARIANT, OPT BYVAL vy AS VARIANT) AS STRING
                                  PROPERTY GET Script <1610743815> () AS IDISPATCH
                                  PROPERTY GET ViewOptions <1610743816> () AS LONG
                              END INTERFACE
                              
                              ' Interface Name  : IShellFolderViewDual2
                              ' Description     : definition of interface IShellFolderViewDual2
                              ' ClassID         : $CLSID_Shell32_ShellFolderView
                              INTERFACE IShellFolderViewDual2 $IID_Shell32_IShellFolderViewDual2
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  PROPERTY GET Folder <1610743810> () AS Folder
                                  METHOD SelectedItems <1610743811> () AS FolderItems
                                  PROPERTY GET FocusedItem <1610743812> () AS FolderItem
                                  METHOD SelectItem <1610743813> (BYREF IN pvfi AS VARIANT, BYVAL dwFlags AS LONG)
                                  METHOD PopupItemMenu <1610743814> (BYVAL pfi AS FolderItem, OPT BYVAL vx AS VARIANT, OPT BYVAL vy AS VARIANT) AS STRING
                                  PROPERTY GET Script <1610743815> () AS IDISPATCH
                                  PROPERTY GET ViewOptions <1610743816> () AS LONG
                                  PROPERTY GET CurrentViewMode <1610809344> () AS DWORD
                                  PROPERTY SET CurrentViewMode <1610809344> (BYVAL pViewMode AS DWORD)
                                  METHOD SelectItemRelative <1610809346> (BYVAL iRelative AS LONG)
                              END INTERFACE
                              
                              ' Interface Name  : IShellDispatch
                              ' Description     : Definition of interface IShellDispatch
                              ' ClassID         : $CLSID_Shell32_Shell
                              ' ProgID          : $PROGID_Shell32_Shell
                              ' Version ProgID  : $PROGID_Shell32_Shell1
                              INTERFACE IShellDispatch $IID_Shell32_IShellDispatch
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  METHOD NameSpace <1610743810> (BYVAL vDir AS VARIANT) AS Folder
                                  METHOD BrowseForFolder <1610743811> (BYVAL Hwnd AS LONG, BYVAL Title AS STRING, BYVAL Options AS LONG, OPT BYVAL _
                                      RootFolder AS VARIANT) AS Folder
                                  METHOD Windows <1610743812> () AS IDISPATCH
                                  METHOD OPEN <1610743813> (BYVAL vDir AS VARIANT)
                                  METHOD Explore <1610743814> (BYVAL vDir AS VARIANT)
                                  METHOD MinimizeAll <1610743815> ()
                                  METHOD UndoMinimizeALL <1610743816> ()
                                  METHOD FileRun <1610743817> ()
                                  METHOD CascadeWindows <1610743818> ()
                                  METHOD TileVertically <1610743819> ()
                                  METHOD TileHorizontally <1610743820> ()
                                  METHOD ShutdownWindows <1610743821> ()
                                  METHOD SUSPEND <1610743822> ()
                                  METHOD EjectPC <1610743823> ()
                                  METHOD SetTime <1610743824> ()
                                  METHOD TrayProperties <1610743825> ()
                                  METHOD HELP <1610743826> ()
                                  METHOD FindFiles <1610743827> ()
                                  METHOD FindComputer <1610743828> ()
                                  METHOD RefreshMenu <1610743829> ()
                                  METHOD ControlPanelItem <1610743830> (BYVAL szDir AS STRING)
                              END INTERFACE
                              
                              ' Interface Name  : IShellDispatch2
                              ' Description     : Updated IShellDispatch
                              INTERFACE IShellDispatch2 $IID_Shell32_IShellDispatch2
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  METHOD NameSpace <1610743810> (BYVAL vDir AS VARIANT) AS Folder
                                  METHOD BrowseForFolder <1610743811> (BYVAL Hwnd AS LONG, BYVAL Title AS STRING, BYVAL Options AS LONG, OPT BYVAL _
                                      RootFolder AS VARIANT) AS Folder
                                  METHOD Windows <1610743812> () AS IDISPATCH
                                  METHOD OPEN <1610743813> (BYVAL vDir AS VARIANT)
                                  METHOD Explore <1610743814> (BYVAL vDir AS VARIANT)
                                  METHOD MinimizeAll <1610743815> ()
                                  METHOD UndoMinimizeALL <1610743816> ()
                                  METHOD FileRun <1610743817> ()
                                  METHOD CascadeWindows <1610743818> ()
                                  METHOD TileVertically <1610743819> ()
                                  METHOD TileHorizontally <1610743820> ()
                                  METHOD ShutdownWindows <1610743821> ()
                                  METHOD SUSPEND <1610743822> ()
                                  METHOD EjectPC <1610743823> ()
                                  METHOD SetTime <1610743824> ()
                                  METHOD TrayProperties <1610743825> ()
                                  METHOD HELP <1610743826> ()
                                  METHOD FindFiles <1610743827> ()
                                  METHOD FindComputer <1610743828> ()
                                  METHOD RefreshMenu <1610743829> ()
                                  METHOD ControlPanelItem <1610743830> (BYVAL szDir AS STRING)
                                  METHOD IsRestricted <1610809344> (BYVAL Group AS STRING, BYVAL Restriction AS STRING) AS LONG
                                  METHOD ShellExecute <1610809345> (BYVAL File AS STRING, OPT BYVAL vArgs AS VARIANT, OPT BYVAL vDir AS VARIANT, OPT BYVAL _
                                      vOperation AS VARIANT, OPT BYVAL vShow AS VARIANT)
                                  METHOD FindPrinter <1610809346> (OPT BYVAL PB_Name AS STRING, OPT BYVAL location AS STRING, OPT BYVAL model AS STRING)
                                  METHOD GetSystemInformation <1610809347> (BYVAL PB_Name AS STRING) AS VARIANT
                                  METHOD ServiceStart <1610809348> (BYVAL ServiceName AS STRING, BYVAL Persistent AS VARIANT) AS VARIANT
                                  METHOD ServiceStop <1610809349> (BYVAL ServiceName AS STRING, BYVAL Persistent AS VARIANT) AS VARIANT
                                  METHOD IsServiceRunning <1610809350> (BYVAL ServiceName AS STRING) AS VARIANT
                                  METHOD CanStartStopService <1610809351> (BYVAL ServiceName AS STRING) AS VARIANT
                                  METHOD ShowBrowserBar <1610809352> (BYVAL bstrClsid AS STRING, BYVAL bShow AS VARIANT) AS VARIANT
                              END INTERFACE
                              
                              ' Interface Name  : IShellDispatch3
                              ' Description     : Updated IShellDispatch
                              INTERFACE IShellDispatch3 $IID_Shell32_IShellDispatch3
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  METHOD NameSpace <1610743810> (BYVAL vDir AS VARIANT) AS Folder
                                  METHOD BrowseForFolder <1610743811> (BYVAL Hwnd AS LONG, BYVAL Title AS STRING, BYVAL Options AS LONG, OPT BYVAL _
                                      RootFolder AS VARIANT) AS Folder
                                  METHOD Windows <1610743812> () AS IDISPATCH
                                  METHOD OPEN <1610743813> (BYVAL vDir AS VARIANT)
                                  METHOD Explore <1610743814> (BYVAL vDir AS VARIANT)
                                  METHOD MinimizeAll <1610743815> ()
                                  METHOD UndoMinimizeALL <1610743816> ()
                                  METHOD FileRun <1610743817> ()
                                  METHOD CascadeWindows <1610743818> ()
                                  METHOD TileVertically <1610743819> ()
                                  METHOD TileHorizontally <1610743820> ()
                                  METHOD ShutdownWindows <1610743821> ()
                                  METHOD SUSPEND <1610743822> ()
                                  METHOD EjectPC <1610743823> ()
                                  METHOD SetTime <1610743824> ()
                                  METHOD TrayProperties <1610743825> ()
                                  METHOD HELP <1610743826> ()
                                  METHOD FindFiles <1610743827> ()
                                  METHOD FindComputer <1610743828> ()
                                  METHOD RefreshMenu <1610743829> ()
                                  METHOD ControlPanelItem <1610743830> (BYVAL szDir AS STRING)
                                  METHOD IsRestricted <1610809344> (BYVAL Group AS STRING, BYVAL Restriction AS STRING) AS LONG
                                  METHOD ShellExecute <1610809345> (BYVAL File AS STRING, OPT BYVAL vArgs AS VARIANT, OPT BYVAL vDir AS VARIANT, OPT BYVAL _
                                      vOperation AS VARIANT, OPT BYVAL vShow AS VARIANT)
                                  METHOD FindPrinter <1610809346> (OPT BYVAL PB_Name AS STRING, OPT BYVAL location AS STRING, OPT BYVAL model AS STRING)
                                  METHOD GetSystemInformation <1610809347> (BYVAL PB_Name AS STRING) AS VARIANT
                                  METHOD ServiceStart <1610809348> (BYVAL ServiceName AS STRING, BYVAL Persistent AS VARIANT) AS VARIANT
                                  METHOD ServiceStop <1610809349> (BYVAL ServiceName AS STRING, BYVAL Persistent AS VARIANT) AS VARIANT
                                  METHOD IsServiceRunning <1610809350> (BYVAL ServiceName AS STRING) AS VARIANT
                                  METHOD CanStartStopService <1610809351> (BYVAL ServiceName AS STRING) AS VARIANT
                                  METHOD ShowBrowserBar <1610809352> (BYVAL bstrClsid AS STRING, BYVAL bShow AS VARIANT) AS VARIANT
                                  METHOD AddToRecent <1610874880> (BYVAL varFile AS VARIANT, OPT BYVAL bstrCategory AS STRING)
                              END INTERFACE
                              
                              ' Interface Name  : IShellDispatch4
                              ' Description     : Updated IShellDispatch
                              INTERFACE IShellDispatch4 $IID_Shell32_IShellDispatch4
                                  INHERIT IDISPATCH
                              
                                  PROPERTY GET Application <1610743808> () AS IDISPATCH
                                  PROPERTY GET PARENT <1610743809> () AS IDISPATCH
                                  METHOD NameSpace <1610743810> (BYVAL vDir AS VARIANT) AS Folder
                                  METHOD BrowseForFolder <1610743811> (BYVAL Hwnd AS LONG, BYVAL Title AS STRING, BYVAL Options AS LONG, OPT BYVAL _
                                      RootFolder AS VARIANT) AS Folder
                                  METHOD Windows <1610743812> () AS IDISPATCH
                                  METHOD OPEN <1610743813> (BYVAL vDir AS VARIANT)
                                  METHOD Explore <1610743814> (BYVAL vDir AS VARIANT)
                                  METHOD MinimizeAll <1610743815> ()
                                  METHOD UndoMinimizeALL <1610743816> ()
                                  METHOD FileRun <1610743817> ()
                                  METHOD CascadeWindows <1610743818> ()
                                  METHOD TileVertically <1610743819> ()
                                  METHOD TileHorizontally <1610743820> ()
                                  METHOD ShutdownWindows <1610743821> ()
                                  METHOD SUSPEND <1610743822> ()
                                  METHOD EjectPC <1610743823> ()
                                  METHOD SetTime <1610743824> ()
                                  METHOD TrayProperties <1610743825> ()
                                  METHOD HELP <1610743826> ()
                                  METHOD FindFiles <1610743827> ()
                                  METHOD FindComputer <1610743828> ()
                                  METHOD RefreshMenu <1610743829> ()
                                  METHOD ControlPanelItem <1610743830> (BYVAL szDir AS STRING)
                                  METHOD IsRestricted <1610809344> (BYVAL Group AS STRING, BYVAL Restriction AS STRING) AS LONG
                                  METHOD ShellExecute <1610809345> (BYVAL File AS STRING, OPT BYVAL vArgs AS VARIANT, OPT BYVAL vDir AS VARIANT, OPT BYVAL _
                                      vOperation AS VARIANT, OPT BYVAL vShow AS VARIANT)
                                  METHOD FindPrinter <1610809346> (OPT BYVAL PB_Name AS STRING, OPT BYVAL location AS STRING, OPT BYVAL model AS STRING)
                                  METHOD GetSystemInformation <1610809347> (BYVAL PB_Name AS STRING) AS VARIANT
                                  METHOD ServiceStart <1610809348> (BYVAL ServiceName AS STRING, BYVAL Persistent AS VARIANT) AS VARIANT
                                  METHOD ServiceStop <1610809349> (BYVAL ServiceName AS STRING, BYVAL Persistent AS VARIANT) AS VARIANT
                                  METHOD IsServiceRunning <1610809350> (BYVAL ServiceName AS STRING) AS VARIANT
                                  METHOD CanStartStopService <1610809351> (BYVAL ServiceName AS STRING) AS VARIANT
                                  METHOD ShowBrowserBar <1610809352> (BYVAL bstrClsid AS STRING, BYVAL bShow AS VARIANT) AS VARIANT
                                  METHOD AddToRecent <1610874880> (BYVAL varFile AS VARIANT, OPT BYVAL bstrCategory AS STRING)
                                  METHOD WindowsSecurity <1610940416> ()
                                  METHOD ToggleDesktop <1610940417> ()
                                  METHOD ExplorerPolicy <1610940418> (BYVAL bstrPolicyName AS STRING) AS VARIANT
                                  METHOD GetSetting <1610940419> (BYVAL lSetting AS LONG) AS INTEGER
                              END INTERFACE
                              
                              ' Interface Name  : DSearchCommandEvents
                              ' Description     : Event interface for command events
                              ' ClassID         : $CLSID_Shell32_Event_DSearchCommandEvents
                              CLASS Class_DSearchCommandEvents $CLSID_Shell32_Event_DSearchCommandEvents AS EVENT
                                  INTERFACE DSearchCommandEvents $IID_Shell32_DSearchCommandEvents
                                      INHERIT IDISPATCH
                              
                                      METHOD SearchStart <1> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD SearchComplete <2> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD SearchAbort <3> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD RecordsetUpdate <4> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD ProgressTextChanged <5> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD SearchError <6> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                      METHOD SearchRestored <7> ()
                                          ' Insert your code here
                                      END METHOD
                              
                                  END INTERFACE
                              END CLASS
                              
                              ' Interface Name  : IFileSearchBand
                              ' Description     : IFileSearchBand Interface
                              ' ClassID         : $CLSID_Shell32_FileSearchBand
                              INTERFACE IFileSearchBand $IID_Shell32_IFileSearchBand
                                  INHERIT IDISPATCH
                              
                                  METHOD SetFocus <1> ()
                                  METHOD SetSearchParameters <2> (BYREF IN pbstrSearchID AS STRING, BYVAL bNavToResults AS INTEGER, OPT BYREF IN pvarScope _
                                      AS VARIANT, OPT BYREF IN pvarQueryFile AS VARIANT)
                                  PROPERTY GET SearchID <3> () AS STRING
                                  PROPERTY GET Scope <4> () AS VARIANT
                                  PROPERTY GET QueryFile <5> () AS VARIANT
                              END INTERFACE
                              
                              ' Interface Name  : IWebWizardHost
                              ' Description     : IWebWizardHost interface
                              INTERFACE IWebWizardHost $IID_Shell32_IWebWizardHost
                                  INHERIT IDISPATCH
                              
                                  METHOD FinalBack <0> ()
                                  METHOD FinalNext <1> ()
                                  METHOD CANCEL <2> ()
                                  PROPERTY SET CAPTION <3> (BYVAL pbstrCaption AS STRING)
                                  PROPERTY GET CAPTION <3> () AS STRING
                                  PROPERTY SET PROPERTY <4> (BYVAL bstrPropertyName AS STRING, BYREF IN pvProperty AS VARIANT)
                                  PROPERTY GET PROPERTY <4> (BYVAL bstrPropertyName AS STRING) AS VARIANT
                                  METHOD SetWizardButtons <5> (BYVAL vfEnableBack AS INTEGER, BYVAL vfEnableNext AS INTEGER, BYVAL vfLastPage AS INTEGER)
                                  METHOD SetHeaderText <6> (BYVAL bstrHeaderTitle AS STRING, BYVAL bstrHeaderSubtitle AS STRING)
                              END INTERFACE
                              
                              ' Interface Name  : INewWDEvents
                              ' Description     : INewWDEvents interface
                              INTERFACE INewWDEvents $IID_Shell32_INewWDEvents
                                  INHERIT IDISPATCH
                              
                                  METHOD FinalBack <0> ()
                                  METHOD FinalNext <1> ()
                                  METHOD CANCEL <2> ()
                                  PROPERTY SET CAPTION <3> (BYVAL Rhs AS STRING)
                                  PROPERTY GET CAPTION <3> () AS STRING
                                  PROPERTY SET PROPERTY <4> (BYVAL bstrPropertyName AS STRING, BYREF IN Rhs AS VARIANT)
                                  PROPERTY GET PROPERTY <4> (BYVAL bstrPropertyName AS STRING) AS VARIANT
                                  METHOD SetWizardButtons <5> (BYVAL vfEnableBack AS INTEGER, BYVAL vfEnableNext AS INTEGER, BYVAL vfLastPage AS INTEGER)
                                  METHOD SetHeaderText <6> (BYVAL bstrHeaderTitle AS STRING, BYVAL bstrHeaderSubtitle AS STRING)
                                  METHOD PassportAuthenticate <7> (BYVAL bstrSignInUrl AS STRING) AS INTEGER
                              END INTERFACE
                              
                              ' Interface Name  : IPassportClientServices
                              ' Description     : IPassportClientServices
                              ' ClassID         : $CLSID_Shell32_PassportClientServices
                              INTERFACE IPassportClientServices $IID_Shell32_IPassportClientServices
                                  INHERIT IDISPATCH
                              
                                  METHOD MemberExists <0> (BYVAL bstrUser AS STRING, BYVAL bstrPassword AS STRING) AS INTEGER
                              END INTERFACE
                              3.14159265358979323846264338327950
                              "Ok, yes... I like pie... um, I meant, pi."

                              Comment


                              • #16
                                And, there's also ZLIB.DLL and ZLIB1.DLL (www.zlib.net and http://www.zlib.net/DLL_FAQ.txt)

                                Code:
                                #COMPILE EXE
                                #DIM ALL
                                #DEBUG ERROR ON
                                
                                #INCLUDE "Win32API.inc"
                                #INCLUDE "ShlObj.inc"
                                
                                '=========================<[ Zip and UnZip File Maintanence ]>==========================
                                '  These ruts will create and retreive compressed data files in the standard Zip format
                                '  using ZLib.Dll.
                                
                                ' ==========>>> Equates
                                   %prZipFileFileLength = 30
                                   %prZipFileDirLength = 46
                                   %prZipFileEndDirLength = 22
                                   %ZLibZip_NO_COMPRESSION         = 0
                                   %ZLibZip_BEST_SPEED             = 1
                                   %ZLibZip_BEST_COMPRESSION       = 9
                                   %ZLibZip_DEFAULT_COMPRESSION    = (-1)
                                   %ZLibZip_DEFLATED               = 8
                                   %MaxPath = 260
                                   $WrdMrk = CHR$(&HF2)    'Word Mark(Words)       - &HF2
                                   $SegMrk = CHR$(&HFB)    'Segment Mark(Segments) - &HFB
                                
                                ' ==========>>> Types
                                TYPE DateTime_TYPE
                                  hSecond      AS DWORD
                                  hMinute      AS DWORD
                                  hHour            AS DWORD
                                  hDay          AS DWORD
                                  hMonth       AS DWORD
                                  hYear         AS DWORD
                                END TYPE
                                TYPE FileInfo_TYPE
                                  uDateTime    AS DateTime_TYPE
                                  hDosDate     AS DWORD
                                  hAttribute   AS DWORD
                                  hAttribute2  AS DWORD
                                END TYPE
                                TYPE FileInfoX_TYPE
                                  version               AS DWORD
                                  version_needed        AS DWORD
                                  flag                  AS DWORD
                                  compression_method    AS DWORD
                                  dosDate               AS DWORD
                                  crc                   AS DWORD
                                  compressed_size       AS DWORD
                                  uncompressed_size     AS DWORD
                                  size_filename         AS DWORD
                                  size_file_extra       AS DWORD
                                  size_file_comment     AS DWORD
                                  disk_num_start        AS DWORD
                                  internal_fa           AS DWORD
                                  external_fa           AS DWORD
                                  tmu_date              AS DateTime_TYPE
                                END TYPE
                                
                                ' ==========>>> Declares
                                DECLARE FUNCTION ZLibUnzOpen LIB "ZLib.Dll" ALIAS "unzOpen" (rsFileName AS ASCIZ) AS DWORD
                                DECLARE FUNCTION ZLibUnzClose LIB "ZLib.Dll" ALIAS "unzClose" (BYVAL rhFileHand AS DWORD) AS DWORD
                                DECLARE FUNCTION ZLibUnzGoToFirstFile LIB "ZLib.dll" ALIAS "unzGoToFirstFile"(BYVAL rhFileHand AS DWORD) AS LONG
                                DECLARE FUNCTION ZLibUnzGoToNextFile LIB "ZLib.dll" ALIAS "unzGoToNextFile"(BYVAL rhFileHand AS DWORD) AS LONG
                                DECLARE FUNCTION ZLibUnzGetCurrentFileInfo LIB "ZLib.dll" ALIAS "unzGetCurrentFileInfo"(BYVAL rhFileHand AS DWORD, BYREF pFile_Info AS FileInfoX_TYPE, BYREF szFileName AS ASCIIZ, _
                                	BYVAL FileNameBufLen AS DWORD, BYREF pExtra AS ANY, BYVAL pExtraLen AS DWORD, BYREF szComment AS ASCIIZ, BYVAL szCommentLen AS DWORD) AS LONG
                                DECLARE FUNCTION ZLibUnzOpenCurrentFile LIB "ZLib.dll" ALIAS "unzOpenCurrentFile"(BYVAL fh AS DWORD) AS LONG
                                DECLARE FUNCTION ZLibUnzCloseCurrentFile LIB "ZLib.dll" ALIAS "unzCloseCurrentFile"(BYVAL fh AS DWORD) AS LONG
                                DECLARE FUNCTION ZLibUnzReadCurrentFile LIB "ZLib.dll" ALIAS "unzReadCurrentFile"(BYVAL fh AS LONG, BYREF buf AS ANY, BYVAL bufLen AS DWORD) AS LONG
                                DECLARE FUNCTION ZLibZipOpen LIB "ZLib.Dll" ALIAS "zipOpen" (rsFileName AS ASCIZ, BYVAL rlAppend AS LONG) AS DWORD
                                DECLARE FUNCTION ZLibZipClose LIB "ZLib.Dll" ALIAS "zipClose" (BYVAL rhFileHand AS DWORD, rsGlobalComment AS ASCIZ) AS LONG
                                DECLARE FUNCTION ZLibZipOpenNewFileInZip LIB "ZLib.Dll" ALIAS "zipOpenNewFileInZip" ( _
                                	BYVAL rhFileHand AS DWORD, _
                                	BYREF rsFileName AS ASCIZ, _
                                	BYREF ruFileInfo AS FileInfo_TYPE, _
                                	BYREF rsExtraLocal AS ANY, _
                                	BYVAL rlExtraSize  AS LONG, _
                                	BYREF rsExtraGlobal AS ANY, _
                                	BYVAL rlExtraSize   AS LONG, _
                                	BYREF rsComment AS ASCIZ, _
                                	BYVAL rlMethod AS LONG, _
                                	BYVAL rlLevel AS LONG) _
                                	AS LONG
                                DECLARE FUNCTION ZLibZipWriteInFileInZip LIB "ZLib.Dll" ALIAS "zipWriteInFileInZip"(BYVAL rhFileHand AS DWORD, BYREF rsBuffer AS ANY, BYVAL rlBufferSize AS LONG)AS LONG
                                DECLARE FUNCTION ZLibZipCloseFileInZip LIB "ZLib.Dll" ALIAS "zipCloseFileInZip"(BYVAL rhFileHand AS DWORD)AS LONG
                                DECLARE FUNCTION FileTimeToSystemTimeMine LIB "KERNEL32.DLL" ALIAS "FileTimeToSystemTime" (lpFileTime AS QUAD, lpSystemTime AS SYSTEMTIME) AS LONG
                                DECLARE FUNCTION SystemTimeToFileTimeMine LIB "KERNEL32.DLL" ALIAS "SystemTimeToFileTime" (lpSystemTime AS SYSTEMTIME, lpFileTime AS QUAD) AS LONG
                                
                                '=======================<[ Auxiliary Routines ]>=======================
                                FUNCTION axIsFileThere ALIAS "axIsFileThere" (rsFileName AS STRING) EXPORT AS LONG
                                ' Returns %True if file exists
                                
                                   LOCAL llA AS LONG
                                
                                   llA = GETATTR(rsFileName)
                                   IF ERR THEN EXIT FUNCTION
                                   FUNCTION = %True
                                
                                END FUNCTION
                                
                                SUB axGetTempFileName ALIAS "axGetTempFileName" (rsIn AS STRING, wsOut AS STRING) EXPORT
                                '   In is 2 words as follows:
                                '      1 = Optional 3 chars or less file prefex. If empty will use Tmp.
                                '      2 = Optional path name for the temp file.  If empty will get Temp path.
                                
                                   LOCAL lsA AS STRING
                                   LOCAL lzPathName AS ASCIZ * %MaxPath
                                   LOCAL lzTempFileName AS ASCIZ * %MaxPath
                                   LOCAL lsPrefix AS STRING
                                
                                   ' Path name
                                   lzPathName = PARSE$(rsIn, $WrdMrk, 2)
                                   IF LEN(lzPathName) = 0 OR ISFALSE axIsFileThere(BYCOPY lzPathName) THEN
                                	  axGetPathName "T", lsA
                                	  lzPathName = lsA
                                   END IF
                                
                                   ' Prefix
                                   lsPrefix = PARSE$(rsIn, $WrdMrk, 1)
                                   IF LEN(lsPrefix) = 0 THEN lsPrefix = "Tmp:
                                
                                   ' Get it.
                                   IF GetTempFileName(lzPathName, BYCOPY lsPrefix, 0, lzTempFileName) THEN
                                	  wsOut = lzTempFileName
                                   ELSE
                                	  wsOut = ""
                                   END IF
                                
                                END SUB
                                
                                SUB axGetPathName ALIAS "axGetPathName" (rsIn AS STRING, wsOut AS STRING) EXPORT
                                '   In will be one of the following.  Out will contain fully pathed name.
                                '      S = System
                                '      T = User Temp
                                '      W = Windows
                                '     38 = Program Files
                                '     16 = User Desktop
                                '      5 = User My Documents
                                '     26 = User Application Data
                                '     11 = User Start Menu
                                '      2 = User Start Menu\Programs
                                '      7 = User Start Menu\Programs\Startup
                                '      9 = User Start Menu\Sendto
                                '     22 = All Users Start Menu
                                '     23 = All Users Start Menu\Programs
                                '     24 = All Users Start Menu\Programs\Startup
                                '     25 = All Users Desktop
                                '     35 = All Users Application Data
                                '     other all numeric = CSIDL used in shGetSpecialFolderPath API.
                                '              These values provide a unique system-independent way to identify special
                                '              folders used frequently by applications, but which may not have the same
                                '              name or location on any given system.
                                '   Notes: The folder will be created if it doesn't exist.
                                
                                   LOCAL lzPathName AS ASCIZ * %MaxPath
                                
                                   SELECT CASE rsIn
                                   CASE "T"
                                	  GetTempPath SIZEOF(lzPathName), lzPathName
                                   CASE "W"
                                	  GetWindowsDirectory lzPathName , SIZEOF(lzPathName)
                                   CASE "S"
                                	  GetSystemDirectory lzPathName, SIZEOF(lzPathName)
                                   CASE ELSE
                                	  shGetSpecialFolderPath 0, lzPathName, VAL(rsIN), 1
                                   END SELECT
                                   IF RIGHT$(lzPathName, 1) = "\" THEN
                                	  wsOut = LEFT$(lzPathName, LEN(lzPathName) - 1)
                                   ELSE
                                	  wsOut = lzPathName
                                   END IF
                                
                                END SUB
                                
                                FUNCTION axParseDrivePathFile ALIAS "axParseDrivePathFile" (rsName AS STRING, rsReq AS STRING)EXPORT AS STRING
                                '   Assume rsName is "C:\Folder1\Name.Ext1.Ext2" then if rsReq is:
                                '     D = Drive = C:                P = Path       = C:\Folder1 (must have a \)
                                '     F = File  = Name.Ext1.Ext2    N = Name       = Name.Ext1
                                '     E = Ext   = Ext2              Q = Path\Name  = C:\Folder1\Name.Ext1
                                
                                   LOCAL lsName AS STRING
                                   LOCAL lsReq AS STRING
                                
                                   lsName = REMOVE$(rsName, $DQ)
                                   lsReq = UCASE$(rsReq)
                                   IF ISFALSE LEN(lsName) THEN EXIT FUNCTION
                                   SELECT CASE lsReq
                                	  CASE "P"       'path
                                		 IF ISFALSE INSTR(lsName, "\") THEN EXIT FUNCTION
                                		 lsName = LEFT$(lsName, INSTR(-1, lsName, "\") - 1)
                                	  CASE "Q"       'path\name
                                		 IF INSTR(lsName, ".") THEN lsName = LEFT$(lsName, INSTR(-1, lsName, ".") - 1)
                                	  CASE "D"       'drive
                                		 IF MID$(lsName,2,1) = ":" THEN
                                			lsName = LEFT$(lsName, 2)
                                		 ELSE
                                			RESET lsName
                                		 END IF
                                	  CASE "F", "N", "E"  'file or name or .ext
                                		 lsName = MID$(lsName, INSTR(-1, lsName, "\") + 1)
                                		 IF INSTR(lsName, ".") THEN
                                			IF lsReq = "N" THEN
                                			   lsName = LEFT$(lsName, LEN(lsName) - (LEN(lsName) - INSTR(-1, lsName, ".") + 1))
                                			ELSEIF lsReq = "E" THEN
                                			   lsName = RIGHT$(lsName, LEN(lsName) - INSTR(-1, lsName, "."))
                                			END IF
                                		 ELSE
                                			IF lsReq = "E" THEN lsName = ""
                                		 END IF
                                	  CASE ELSE
                                		 lsName = ""
                                   END SELECT
                                   FUNCTION = lsName
                                END FUNCTION
                                
                                FUNCTION axParseInsert ALIAS "axParseInsert" (bsMain AS STRING, rsInsertValue AS STRING, _
                                	  OPTIONAL BYVAL rsDelimit AS STRING, BYVAL rsModChars AS STRING, _
                                	  BYVAL rlFieldNumber AS LONG) Export AS STRING
                                '   Will insert the InsertValue into Main at FieldNumber.  If FieldNumber
                                '   is omitted or is zero then InsertValue will be appended to the end of
                                '   Main.  This is the primary purpose (append at end) for this rut.  You
                                '   would normally use ParseUpdate when you have an explicit FieldNumber.
                                '   An error will occure if Main and InsertValue are both empty and
                                '   FieldNumber is omitted or <=1.  There is no way to represent a single
                                '   empty field as being present.  Note that if ANY option in ModChars
                                '   then only the first char of Delimit will be used.
                                '   ModChars: A=ANY, W=Write back Main, return value will be empty
                                '   If FieldNumber is negative works from right to left. -1 is the last field,
                                '   -2 is the second to last field, etc.
                                
                                   LOCAL llA AS LONG
                                   LOCAL llInsertPosition AS LONG
                                   LOCAL lsDelimit AS STRING
                                   LOCAL lsInsertDelimitEnd AS STRING
                                   LOCAL lsAddedDelimiters AS STRING
                                
                                   ' Init stuff
                                   lsDelimit = IIF$(LEN(rsDelimit), rsDelimit, ",")
                                
                                   ' If rlFieldNumber is minus then set to field number from right
                                   IF rlFieldNumber < 0 THEN rlFieldNumber = axParseCount(bsMain, rsDelimit, rsModChars) + rlFieldNumber + 1
                                
                                   ' There can be a problem if the insert field is empty and main is
                                   ' also empty cause the returning string will be empty which can
                                   ' be very bad.  The following will prevent it.
                                   IF ISFALSE LEN(rsInsertValue) AND ISFALSE LEN(bsMain) AND _
                                	  rlFieldNumber <= 1 THEN axErrorAt 233
                                
                                   ' determine the insert position if field number is > 0
                                   IF rlFieldNumber > 0 THEN
                                	  llInsertPosition = axParsePosition(bsMain, rlFieldNumber, rsDelimit, rsModChars, 0)
                                   ELSE
                                	  llInsertPosition = 0
                                   END IF
                                
                                   ' If insert possition is zero then insert at end
                                   IF llInsertPosition = 0 THEN
                                	  llInsertPosition = LEN(bsMain) + 1
                                	  ' Compute number of delimiters to add before insert value
                                	  IF ISFALSE LEN(bsMain) THEN
                                		 llA = IIF&(rlFieldNumber,  rlFieldNumber - 1, 0)
                                	  ELSE
                                		 llA = IIF&(rlFieldNumber,  rlFieldNumber - axParseCount(bsMain, rsDelimit, rsModChars), 1)
                                	  END IF
                                	  lsAddedDelimiters = REPEAT$(llA, IIF$(INSTR(rsModChars, "A"), LEFT$(lsDelimit, 1), lsDelimit))
                                   ELSE
                                	  lsInsertDelimitEnd = IIF$(INSTR(rsModChars, "A"), LEFT$(lsDelimit, 1), lsDelimit)
                                   END IF
                                
                                   ' Write result back in Main or return it
                                   IF INSTR(rsModChars, "W") THEN
                                	  bsMain = LEFT$(bsMain, llInsertPosition - 1) & lsAddedDelimiters & rsInsertValue & lsInsertDelimitEnd & MID$(bsMain, llInsertPosition)
                                   ELSE
                                	  FUNCTION = LEFT$(bsMain, llInsertPosition - 1) & lsAddedDelimiters & rsInsertValue & lsInsertDelimitEnd & MID$(bsMain, llInsertPosition)
                                   END IF
                                
                                END FUNCTION
                                
                                FUNCTION axParseCount ALIAS "axParseCount" (rsMain AS STRING, _
                                   OPTIONAL BYVAL rsDelimit AS STRING, BYVAL rsModChars AS STRING)Export AS LONG
                                '   Returns the parse count in Main. Will return 0 if string is empty while
                                '   PB parsecount will return 1.
                                '   Possible ModChars:  A=ANY
                                
                                   IF LEN(rsMain) THEN
                                	  IF INSTR(rsModChars, "A") THEN
                                		 FUNCTION = PARSECOUNT(rsMain, ANY IIF$(LEN(rsDelimit), rsDelimit, ","))
                                	  ELSE
                                		 FUNCTION = PARSECOUNT(rsMain, rsDelimit)
                                	  END IF
                                   END IF
                                
                                END FUNCTION
                                
                                FUNCTION axParsePosition ALIAS "axParsePosition" (rsMain AS STRING, BYVAL rlFieldNumber AS LONG, _
                                   OPTIONAL BYVAL rsDelimit AS STRING, BYVAL rsModChars AS STRING, wlLength AS LONG) Export AS LONG
                                '   Will return the begin position and set the length of a field.
                                '   Returns zero position if field not present. May return zero length
                                '   when present. Delimit will default to a comma.
                                '   Possible rsModChars:  A=ANY
                                '   If FieldNumber is negative works from right to left. -1 is the last field,
                                '   -2 is the second to last field, etc.
                                
                                   LOCAL llX AS LONG
                                   LOCAL llCurrentPosition AS LONG
                                   LOCAL lsA AS STRING
                                   LOCAL lsDelimit AS STRING
                                   LOCAL llDelimitLength AS LONG
                                   LOCAL llPosition AS LONG
                                   LOCAL llExtraCommasBeforeField AS LONG
                                   LOCAL llExtraCommasInField AS LONG
                                
                                   ' Init stuff.
                                   lsDelimit = IIF$(LEN(rsDelimit), rsDelimit, ",")
                                   llDelimitLength = IIF&(INSTR(rsModChars, "A"), 1, LEN(lsDelimit))
                                   IF VARPTR(wlLength) THEN wlLength = 0
                                
                                   ' If rlFieldNumber is minus then set to field number from right
                                   IF rlFieldNumber < 0 THEN rlFieldNumber = axParseCount(rsMain, rsDelimit, rsModChars) + rlFieldNumber + 1
                                
                                   ' if field length is zero the no fields present so return zero.
                                   IF LEN(rsMain) = 0 THEN EXIT FUNCTION
                                
                                   ' There is a problem if the delimiter is a comma and there
                                   ' are commas enclosed in quotes. The following will count then
                                   ' extra commas and those counts will be used to adjust loops.
                                   ' We only want to do this extra work if the delimiter is really a
                                   ' comma and the string contains a quote.
                                   IF lsDelimit = ","  AND INSTR(rsMain, """") THEN
                                
                                	  ' There may be one or more enclosed commas so count them
                                	  DO WHILE axParseNext(rsMain, llX, lsA, "", rsModChars)
                                		 IF llX < rlFieldNumber THEN
                                			llExtraCommasBeforeField = llExtraCommasBeforeField + TALLY(lsA, ",")
                                		 ELSEIF llX = rlFieldNumber THEN
                                			llExtraCommasInField = TALLY(lsA, ",")
                                		 END IF
                                	  LOOP
                                
                                	  ' Adjust field number by count of extras before our field
                                	  rlFieldNumber = rlfieldnumber + llExtraCommasBeforeField
                                   END IF
                                
                                   ' find begin position
                                   FOR llX = 1 TO rlFieldNumber - 1
                                	  IF llX = 1 THEN
                                		 llCurrentPosition = 1
                                	  ELSE
                                		 llCurrentPosition = llCurrentPosition + llDelimitLength
                                	  END IF
                                	  IF INSTR(rsModChars, "A") THEN
                                		 llCurrentPosition = INSTR(llCurrentPosition, rsMain, ANY lsDelimit)
                                	  ELSE
                                		 llCurrentPosition = INSTR(llCurrentPosition, rsMain, lsDelimit)
                                	  END IF
                                	  IF llCurrentPosition = 0  THEN EXIT FOR
                                   NEXT
                                
                                   ' if no current position and field number not first then they
                                   ' requested a field number byond end of main string
                                   IF llCurrentPosition = 0 AND rlFieldNumber <> 1 THEN EXIT FUNCTION
                                
                                   ' set begin position
                                   IF llCurrentPosition THEN
                                	  llPosition = llCurrentPosition + llDelimitLength
                                   ELSE
                                	  llPosition = 1
                                	  llCurrentPosition = 1 - llDelimitLength
                                   END IF
                                
                                   ' find end position and compute the length
                                   FOR llX = 0 TO llExtraCommasInField
                                	  IF INSTR(rsModChars, "A") THEN
                                		 llCurrentPosition = INSTR(llCurrentPosition + llDelimitLength, rsMain, ANY lsDelimit)
                                	  ELSE
                                		 llCurrentPosition = INSTR(llCurrentPosition + llDelimitLength, rsMain, lsDelimit)
                                	  END IF
                                   NEXT
                                   IF llCurrentPosition = 0 THEN llCurrentPosition = LEN(rsMain) + 1
                                   IF VARPTR(wlLength) THEN wlLength = llCurrentPosition - llPosition
                                   FUNCTION = llPosition
                                
                                END FUNCTION
                                
                                FUNCTION axParseNext ALIAS "axParseNext" (rsMain AS STRING, wlPosition AS LONG, _
                                   wsValue AS STRING, OPTIONAL BYVAL rsDelimit AS STRING, _
                                   OPTIONAL BYVAL rsModChars AS STRING) Export AS LONG
                                '   Will return the next Value from Main starting at Position.  If there
                                '   is a next value then it is set in Value and returns %True and updates
                                '   Position(1 = first, 2 = second, etc). If there is no next value sets
                                '   Value to empty and returns %False and updates Position to -1.  Position
                                '   should be passed as zero or -1 to get the first sub string.  Delimit
                                '   will default to comma and normal parse$ command rules apply.
                                '   ModChars are: A=ANY.
                                '   Note!!!
                                '      Main is parsed to a static array on first call(Position is <= 0).
                                '      This static array is deleted on last call.  Main is ignored on all
                                '      calls except the first.
                                '   Caution!!!  #1
                                '      DO NOT NEST CALLS TO THIS RUT.  You can save position and restart
                                '      and then reset position but you better "know what you do".
                                '   Caution!!!  #2
                                '      If for any reason you will not be getting all the Values(want to
                                '      quit early) then make one last "Close" call with Position set
                                '      to -2.  This will delete the static array(return code will be zero).
                                
                                   DIM ssaA() AS STATIC STRING
                                
                                   ' If we have no valid position then will parse into new array
                                   IF wlPosition <= 0 THEN
                                	  ' If positon is -2 then they are quitting early
                                	  IF wlPosition = -2 THEN
                                		 ERASE ssaA     'delete array
                                		 EXIT FUNCTION
                                	  END IF
                                	  ' Dim array
                                	  REDIM ssaA(1 TO axParseCount(rsMain, rsDelimit, rsModChars))
                                	  ' Load it if have anything
                                	  IF UBOUND(ssaA) > 0 THEN
                                		 IF INSTR(rsModChars, "A") THEN
                                			PARSE rsMain, ssaA(), ANY rsDelimit
                                		 ELSE
                                			PARSE rsMain, ssaA(), rsDelimit
                                		 END IF
                                	  END IF
                                	  wlPosition = 0
                                   END IF
                                
                                   ' Get next
                                   INCR wlPosition
                                   IF wlPosition <= UBOUND(ssaA) THEN
                                	  ' Return true and the next one
                                	  wsValue = ssaA(wlPosition)
                                	  FUNCTION = %True
                                   ELSE
                                	  ' There are no more so set position to -1 and delete array
                                	  wsValue = ""
                                	  wlPosition = -1
                                	  ERASE ssaA     'delete array
                                   END IF
                                
                                END FUNCTION
                                
                                FUNCTION axFlipDate ALIAS "axFlipDate" (rsDateTime AS STRING)EXPORT AS STRING
                                '   If DataTime is empty then will return current yyyy-mm-dd hh:mm:ss.
                                '   If DataTime is ^ then will return empty.
                                '   If DataTime is - then will return current yyyy-mm-dd.
                                '   If DataTime # then will return current mm-dd-yy hh:mm:ss.
                                '   If DataTime #- then will return current mm-dd-yy.
                                '   If the right most char passed in DateTime is one of the following
                                '   special chars then the date will flip as follows:
                                '        ! = Date is yyyy-mm-dd will return mm-dd-yy and drop any time
                                '        @ = DT is mm-dd-yyyy will return mm-dd-yy and drop any time
                                '        $ = Date is any m-d-yy will return yyyy-mm-dd and drop any time
                                '        ^ = Is removed from DateTime and ignored.  Useful to return empty
                                '            if no date passes (see above).  Note that DateTime is modified.
                                '   else the date is flipped as follows
                                '     If date is yyyy-mm-dd will return mm-dd-yyyy
                                '     If date is mm-dd-yyyy will return yyyy-mm-dd
                                '     If date is mm-dd-yy will return yy-mm-dd
                                '     If date is yy-mm-dd will return dd-yy-mm -- probable not what you want!
                                '     If there is time then it is returned as is.
                                
                                   SELECT CASE CONST$ rsDateTime
                                   CASE ""
                                	  FUNCTION = MID$(DATE$, 7, 4) & "-" & LEFT$(DATE$, 5) & " " & TIME$
                                   CASE "-"
                                	  FUNCTION = MID$(DATE$, 7, 4) & "-" & LEFT$(DATE$, 5)
                                   CASE "#"
                                	  FUNCTION = LEFT$(DATE$, 6) & RIGHT$(DATE$, 2) & " " & TIME$
                                   CASE "#-"
                                	  FUNCTION = LEFT$(DATE$, 6) & RIGHT$(DATE$, 2)
                                   CASE ELSE
                                	  IF RIGHT$(rsDateTime, 1) = "^" THEN rsDateTime = LEFT$(rsDateTime, -1)
                                	  IF LEN(rsDateTime) > 1 THEN
                                		 SELECT CASE CONST$ RIGHT$(rsDateTime, 1)
                                		 CASE "!"
                                			   FUNCTION = MID$(rsDateTime, 6, 5) & MID$(rsDateTime, 5, 1) & MID$(rsDateTime, 3, 2)
                                		 CASE "@"
                                			   FUNCTION = LEFT$(STRDELETE$(rsDateTime, 7, 2) , 8)
                                		 CASE "$"
                                			   FUNCTION = axQdtToSdt(axSdtToQdt(LEFT$(rsDateTime, -1) & "@"), &H04)
                                		 CASE ELSE
                                			' Determine which was passed
                                			IF INSTR(rsDateTime, ANY "-/") = 5 THEN
                                			   ' yyyy-mm-dd
                                			   FUNCTION = MID$(rsDateTime, 6, 5) & MID$(rsDateTime, 5, 1) & LEFT$(rsDateTime, 4) & MID$(rsDateTime, 11)
                                			ELSEIF LEN(PARSE$(rsDateTime, " ", 1)) = 10 THEN
                                			   ' mm-dd-yyyy
                                			   FUNCTION = MID$(rsDateTime, 7, 4) & MID$(rsDateTime, 3, 1) & LEFT$(rsDateTime, 5) & MID$(rsDateTime, 11)
                                			ELSE
                                			   ' ww-xx-zz  returns zz-ww-xx
                                			   FUNCTION = MID$(rsDateTime, 7, 2) & MID$(rsDateTime, 3, 1) & LEFT$(rsDateTime, 5) & MID$(rsDateTime, 9)
                                			END IF
                                		 END SELECT
                                	  END IF
                                   END SELECT
                                
                                END FUNCTION
                                
                                FUNCTION axQdtToSdt ALIAS "axQdtToSdt" (BYVAL rQdt AS QUAD, OPTIONAL BYVAL rlFlags AS LONG)EXPORT AS STRING
                                '  Qdt is the number of millisecond intervals that have elapsed since 12:00 A.M. January 1, 1601 (UTC)
                                '  Sdt is date(as yyyy-mm-dd) " " time(as hh:mm:ss or yyyy-mm-dd hh:mm:ss:zzz)
                                '  Flags are as follows:
                                '     &H01 = Append milliseconds as zzz to back of time.
                                '     &H02 = Don't return Date.
                                '     &H04 = Don't return Time. Flag &H01 is ignored.
                                '     &H08 = Don't return Time if it's zero.
                                '     &H10 = Don't return seconds. Ignored if no Time or milliseconds are appended.
                                '     &H20 = Return empty if passed Qdt is zero.
                                '     &H40 = Return empty if Time is zero.
                                
                                   LOCAL luST AS SystemTime
                                   LOCAL lsA AS STRING
                                
                                   ' Convert Quad to System Time.
                                   FileTimeToSystemTimeMine rQdt * 10000, luST
                                
                                   ' Format it to em.
                                   lsA = FORMAT$(luST.wYear) & IIF$(luST.wMonth < 10, "-0", "-") & FORMAT$(luST.wMonth) & IIF$(luST.wDay < 10, "-0", "-") & _
                                		 FORMAT$(luST.wDay) & IIF$(luST.wHour < 10, " 0", " ") & FORMAT$(luST.wHour) & IIF$(luST.wMinute < 10, ":0", ":") & FORMAT$(luST.wMinute) & IIF$(luST.wSecond < 10, ":0", ":") & FORMAT$(luST.wSecond)
                                   IF rlFlags THEN
                                	  IF (rlFlags AND &H01) THEN lsA = lsA & ":" & FORMAT$(luST.wMilliseconds,"000")
                                	  IF (rlFlags AND &H08) AND ISFALSE VAL(REMOVE$(PARSE$(lsA, " ", 2), ":")) THEN  lsA = PARSE$(lsA, " ", 1)
                                	  IF (rlFlags AND &H02) THEN lsA = PARSE$(lsA, " ", 2)
                                	  IF (rlFlags AND &H04) THEN lsA = PARSE$(lsA, " ", 1)
                                	  IF (rlFlags AND &H10) AND LEN(lsA) = 19 THEN lsA = LEFT$(lsA, -3)
                                	  IF (rlFlags AND &H20) AND ISFALSE rQdt THEN RESET lsA
                                	  IF (rlFlags AND &H40) AND ISFALSE VAL(REMOVE$(PARSE$(lsA, " ", 2), ":")) THEN  lsA = ""
                                   END IF
                                   FUNCTION = lsA
                                
                                END FUNCTION
                                
                                FUNCTION axSdtToQdt ALIAS "axSdtToQdt" (rsDT AS STRING)EXPORT AS QUAD
                                '   Converts DT and returns it as Qdt.  If DT is empty then will set
                                '   to current date and time.  DT can be month-day-year but only if the
                                '   year is yyyy or ends with the @ character.  It will be converted to
                                '   year-month-day.  Must be mm-dd-yy if using the @ character.
                                '   Sdt date is year-month-day. Slash may be used in place of dash.
                                '      Year may be absent,1, 2, or 4 digits. If absent or 3 then current
                                '      year is used. If 1 or 2 and >=30 then previous centry.
                                '   Sdt time is optional.  If passed it must be seperated from date by one
                                '     space and be hh:mm:ss:zz or h:m:s:z. h=0-23, m=0-59, s=0-59,
                                '     z=milliseconds 0-100. If time is omitted then 0:0:0:0 is assument.
                                '  Qdt is the number of millisecond intervals that have elapsed since 12:00 A.M. January 1, 1601 (UTC)
                                '  NOTICE:  The passed DT may be modified!
                                
                                   LOCAL luST AS SystemTime
                                   LOCAL lsA AS STRING
                                   LOCAL lqA AS QUAD
                                
                                   ' Convert Date to System Time.
                                   IF ISFALSE LEN(rsDT) THEN
                                	  rsDT = axFlipDate(DATE$) & " " & TIME$
                                   ELSEIF RIGHT$(rsDT, 1) = "@" THEN
                                	  rsDT = MID$(rsDT, 7,2) & "-" & LEFT$(rsDT, 5)
                                   END IF
                                   lsA = PARSE$(rsDT, " ", 1)
                                   IF LEN(PARSE$(lsA, ANY "-/", 3)) = 4 THEN axIsDate lsA, lsA    ' if m-d-yyyy then convert to ymd
                                   IF PARSECOUNT(lsA, ANY "-/") = 2 THEN
                                	  luST.wMonth = VAL(PARSE$(lsA, ANY "-/", 1))
                                	  luST.wDay = VAL(PARSE$(lsA, ANY "-/", 2))
                                	  luST.wYear = VAL(MID$(DATE$,7))
                                   ELSE
                                	  luST.wMonth = VAL(PARSE$(lsA, ANY "-/", 2))
                                	  luST.wDay = VAL(PARSE$(lsA, ANY "-/", 3))
                                	  lsA = PARSE$(lsA, ANY "-/", 1)
                                	  IF LEN(lsA) = 4  THEN
                                		 luST.wYear = VAL(lsA)
                                	  ELSE
                                		 IF LEN(lsA) <= 2 THEN
                                			luST.wYear = (VAL(MID$(DATE$,7))\100)*100 + VAL(lsA)
                                			IF VAL(lsA) >= 30 THEN luST.wYear = luST.wYear - 100
                                		 ELSE
                                			luST.wYear = VAL(MID$(DATE$,7))
                                		 END IF
                                	  END IF
                                   END IF
                                
                                   ' Convert Time to System Time.
                                   lsA = PARSE$(rsDT, " ", 2)
                                   luST.wHour = VAL(PARSE$(lsA, ":", 1))
                                   luST.wMinute = VAL(PARSE$(lsA, ":", 2))
                                   luST.wSecond = VAL(PARSE$(lsA, ":", 3))
                                   luST.wMilliseconds = VAL(PARSE$(lsA, ":", 4))
                                
                                   ' Convert System Time to Quad and then return it.
                                   SystemTimeToFileTimeMine luST, lqA
                                   FUNCTION = lqA / 10000
                                
                                END FUNCTION
                                
                                FUNCTION axReplace ALIAS "axReplace" (rsMainString AS STRING, rsMatchString AS STRING, rsNewString AS STRING, _
                                   OPTIONAL BYVAL rsModChars AS STRING)Export AS STRING
                                '   Does the PB replace but as a function rather than a statement.
                                '   ModChars can be "A" for Any.  Note that this function will be slower
                                '   than the built in statement.
                                
                                   LOCAL lsMainString AS STRING
                                
                                   lsMainString = rsMainString
                                   IF INSTR(rsModChars, "A") THEN
                                	  REPLACE ANY rsMatchString WITH rsNewString IN lsMainString
                                   ELSE
                                	  REPLACE rsMatchString WITH rsNewString IN lsMainString
                                   END IF
                                   FUNCTION = lsMainString
                                END FUNCTION
                                
                                SUB axErrorAt (BYVAL rlLineNumber AS LONG)
                                   MSGBOX "Severe error at line number " & FORMAT$(rlLineNumber)
                                   ExitProcess 8
                                END SUB
                                
                                FUNCTION axIsDate ALIAS "axIsDate" (rsDateTimeIn AS STRING, OPTIONAL wsDateTimeOut AS STRING)EXPORT AS LONG
                                '   DateTimeIn = Passed date and optional time.  Date can be YMD, MDY,
                                '   or MD format and must be delimited by - or /.  If year is absent then
                                '   current year is used. If year is length of 2 and >=30 then previous
                                '   centry. The optional time must be seperated from date by one or more
                                '   spaces.  Time can HMSZ(milliseconds), HMS, or HM, and be 12 or 24
                                '   hour format. The delimiter must be :.  If 12 hour format them the
                                '   last 2 chars must be AM or PM(case insensitive) preceeded by one
                                '   or more spaces.
                                '
                                '   [DateTimeOut] = Optional. Returns yyyy-mm-dd hh:mm. Time is
                                '   returned as 24 hour format.  Seconds and milliseconds are only
                                '   returned if they are passed(ss:zz).
                                '
                                '   ReturnCode = False(0) if invalid. The DateTimeOut if asked for, will
                                '   be empty.  True if valid. The true value will be -1 if YMD was passed
                                '   or 1 if MD or MDY was passed.
                                
                                   LOCAL llA AS LONG
                                   LOCAL lsA AS STRING
                                   LOCAL llDateType AS LONG               '-1 = YMD, 1 = MD or MDY
                                   LOCAL lsDateTimeIn AS STRING
                                   LOCAL lsDateTimeOut AS STRING
                                   LOCAL lsDateOrTime AS STRING
                                   LOCAL lsOutDelimiter AS STRING
                                
                                   ' Init. Replace all multi spaces with one space
                                   lsDateTimeIn = rsDateTimeIn
                                   llA = 0
                                   DO
                                	  REGREPL " *" IN lsDateTimeIn WITH " " AT llA TO llA, lsDateTimeIn
                                   LOOP UNTIL llA = 0
                                   IF VARPTR(wsDateTimeOut) THEN wsDateTimeOut = ""
                                
                                   ' ==========>>>    Convert Date
                                   ' Copy date to
                                   lsDateOrTime = TRIM$(PARSE$(lsDateTimeIn, " ", 1))
                                   ' Determine date type -- MDY or YMD
                                   llDateType = 1          'assume MDY
                                   IF PARSECOUNT(lsDateTimeIn, ANY "-/") = 3 THEN
                                	  IF LEN(PARSE$(lsDateTimeIn, ANY "-/", 1)) = 4 THEN llDateType = -1
                                   ELSEIF PARSECOUNT(lsDateTimeIn, ANY "-/") <> 2 THEN
                                	  EXIT FUNCTION        ' error
                                   END IF
                                   lsOutDelimiter = "-"
                                   IF llDateType = 1 THEN     ' MDY
                                	  lsA = PARSE$(lsDateOrTime, ANY "-/", 3)
                                	  GOSUB MakeYear
                                	  lsA = PARSE$(lsDateOrTime, ANY "-/", 1)
                                	  GOSUB Make2
                                	  lsA = PARSE$(lsDateOrTime, ANY "-/", 2)
                                	  GOSUB Make2
                                   ELSE                       ' YMD
                                	  lsA = PARSE$(lsDateOrTime, ANY "-/", 1)
                                	  GOSUB MakeYear
                                	  lsA = PARSE$(lsDateOrTime, ANY "-/", 2)
                                	  GOSUB Make2
                                	  lsA = PARSE$(lsDateOrTime, ANY "-/", 3)
                                	  GOSUB Make2
                                   END IF
                                
                                   ' ==========>>> Convert optional Time
                                   lsDateOrTime = TRIM$(PARSE$(lsDateTimeIn, " ", 2))
                                   IF LEN(lsDateOrTime) THEN
                                	  lsA = PARSE$(lsDateOrTime, ":", 1)
                                	  IF UCASE$(RIGHT$(RTRIM$(lsDateTimeIn), 1)) = "M" THEN
                                		 IF UCASE$(RIGHT$(RTRIM$(lsDateTimeIn), 2)) = "PM" AND VAL(lsa) <> 12 THEN lsA = FORMAT$(VAL(lsa) + 12)
                                	  END IF
                                	  lsOutDelimiter = " "
                                	  GOSUB Make2
                                	  lsA = PARSE$(lsDateOrTime, ":", 2)
                                	  lsOutDelimiter = ":"
                                	  GOSUB Make2
                                	  lsA = PARSE$(lsDateOrTime, ":", 3)
                                	  IF LEN(lsA) THEN GOSUB Make2
                                	  lsA = PARSE$(lsDateOrTime, ":", 4)
                                	  IF LEN(lsA) THEN GOSUB Make3
                                   END IF
                                
                                   ' Is it valid
                                   IF axSdtToQdt(lsDateTimeOut) THEN
                                	  FUNCTION = llDateType
                                	  IF VARPTR(wsDateTimeOut) THEN wsDateTimeOut = lsDateTimeOut
                                   END IF
                                   EXIT FUNCTION
                                
                                MakeYear:
                                   IF LEN(lsA) = 3 OR LEN(lsA) > 4 OR ISFALSE axIsNumeric(lsA) THEN EXIT FUNCTION
                                   IF LEN(lsA) = 0 THEN
                                	  lsA = MID$(DATE$, 7)
                                   ELSEIF LEN(lsA) <= 2 THEN
                                	  IF VAL(lsA) >=30 THEN
                                		 lsA = FORMAT$(VAL(MID$(DATE$, 7, 2)) - 1) & FORMAT$(VAL(lsA), "00")
                                	  ELSE
                                		 lsA = MID$(DATE$, 7, 2) & FORMAT$(VAL(lsA), "00")
                                	  END IF
                                   END IF
                                   lsDateTimeOut = lsA
                                   RETURN
                                
                                Make2:
                                   IF LEN(lsA) = 0 OR LEN(lsA) > 2 OR ISFALSE axIsNumeric(lsA) THEN EXIT FUNCTION
                                   lsDateTimeOut = lsDateTimeOut & lsOutDelimiter & RSET$(lsA, 2 USING "0")
                                   RETURN
                                
                                Make3:
                                   IF LEN(lsA) = 0 OR LEN(lsA) > 3 OR ISFALSE axIsNumeric(lsA) THEN EXIT FUNCTION
                                   lsDateTimeOut = lsDateTimeOut & lsOutDelimiter & RSET$(lsA, 3 USING "0")
                                   RETURN
                                
                                END FUNCTION
                                
                                FUNCTION axIsNumeric ALIAS "axIsNumeric" (rsIn AS STRING, OPTIONAL BYVAL rtFlags AS BYTE) EXPORT AS LONG
                                '   In contains the string to test for 0-9 chars and optionally sepcial chars as allowed
                                '   by Flags. Returns %True if OK.  Note that an empty or blank In defaults to OK.
                                '   Flags values:
                                '     &H01 = May contain a sign("+" or "-") in position 1.
                                '     &H02 = May contain a single decimal(".")
                                '     &H04 = May contain one or more commas
                                '     &H08 = Empty and blank are not OK.
                                
                                   LOCAL lsA AS STRING
                                
                                   IF VERIFY(rsIn, "0123456789") OR LEN(rsIn) = 0 THEN
                                	  lsA = TRIM$(rsIn)
                                	  IF (rtFlags AND &H08) AND ISFALSE LEN(lsA) THEN EXIT FUNCTION
                                	  IF (rtFlags AND &H02) THEN IF TALLY(rsIn, ".") = 1 THEN lsA = REMOVE$(lsA, ".")
                                	  IF (rtFlags AND &H01) THEN IF INSTR(lsA, ANY "+-") = 1 THEN  lsA = STRDELETE$(lsA, 1, 1)
                                	  IF (rtFlags AND &H04) THEN lsA = REMOVE$(lsA, ",")
                                	  IF VERIFY(lsA, "0123456789") THEN EXIT FUNCTION
                                   END IF
                                   FUNCTION = %True
                                
                                END FUNCTION
                                
                                '==========================<[ Zip Routines ]>==========================
                                ' ==========>>> Zip File Insert Open
                                SUB arZipFileInsertOpen(rsZipFileName AS STRING, wsZipControlBlock AS STRING)
                                '   Will prepare for multiple zip file inserting.  A ZipControlBlock(ZCB) will
                                '   be returned.  This ZCB must be passed, untouched, to subsequent insert
                                '   calls(Put and Close).  Multiple InsertPut's(or chunking) may be called
                                '   while one InsertClose must be closed.  ZCB will contain the handle
                                '   and names of the temp file and zip file.  If ZipFileName already exists
                                '   then it must be a valid .Zip file.  If the zip file exists then all
                                '   inserts are zipped into a temp file and then added to the back of the
                                '   zip file by merging the zip file with the temp to yet another temp
                                '   file and then renaming that second temp file to the zip file.
                                
                                   LOCAL lhA AS DWORD
                                   LOCAL lsA AS STRING
                                
                                   ' If zip file exists them must open temp file
                                   IF axIsFileThere(rsZipFileName) THEN
                                	  axGetTempFileName $WrdMrk & axParseDrivePathFile(rsZipFileName, "P"), lsA
                                   ELSE
                                	  lsA = rsZipFileName
                                   END IF
                                   lhA = ZLibZipOpen(BYCOPY lsA, 0)
                                
                                   ' Save zip file name, handle, and temp file name in ZCB
                                   wsZipControlBlock = rsZipFileName
                                   wsZipControlBlock = axParseInsert(wsZipControlBlock, FORMAT$(lhA), $WrdMrk, "", 2)
                                   wsZipControlBlock = axParseInsert(wsZipControlBlock, lsA, $WrdMrk, "", 3)
                                
                                END SUB
                                
                                ' ==========>>> Zip File Insert Put
                                SUB arZipFileInsertPut(wsZipControlBlock AS STRING, _
                                					rsName AS STRING, _
                                					rsData AS STRING, _
                                					OPTIONAL rsModChars AS STRING, _
                                					OPTIONAL rsDateTime AS STRING, _
                                					OPTIONAL BYVAL rhAttribure AS DWORD, _
                                					OPTIONAL BYVAL rsComment AS STRING)
                                
                                '   Will compress the passed Data and insert it into the zip file.
                                '   ZipControlBlock(ZCB) must be a variable obtianed from call to InsertOpen.
                                '   DateTime is the SDT, if omitted then will use current date-time.
                                '   ModChars are:  c = %ZLibZip_NO_COMPRESSION
                                '   If error then does ErrorAt.  Note that the passed Data must be the
                                '   entire file.  If a file is "too" big then use the Chunking ruts.
                                
                                   LOCAL lhA AS DWORD
                                   LOCAL lsModChars AS STRING
                                   LOCAL lsDateTime AS STRING
                                   LOCAL ruFileInfo AS FileInfo_TYPE
                                
                                   ' Init stuff
                                   lhA = VAL(PARSE$(wsZipControlBlock, $WrdMrk, 2))
                                   IF VARPTR(rsModChars) THEN lsModChars = rsModChars
                                   IF VARPTR(rsDateTime) THEN lsDateTime = rsDateTime ELSE lsDateTime = axFlipDate(DATE$) & " " & TIME$
                                
                                   ' Build file info
                                   ruFileInfo.uDateTime.hYear = VAL(MID$(lsDateTime, 1, 4))
                                   ruFileInfo.uDateTime.hMonth = VAL(MID$(lsDateTime, 6, 2)) - 1
                                   ruFileInfo.uDateTime.hDay     = VAL(MID$(lsDateTime, 9, 2))
                                   ruFileInfo.uDateTime.hHour    = VAL(MID$(lsDateTime, 12, 2))
                                   ruFileInfo.uDateTime.hMinute = VAL(MID$(lsDateTime, 15, 2))
                                   ruFileInfo.uDateTime.hSecond      = VAL(MID$(lsDateTime, 18, 2))
                                   ruFileInfo.hAttribute2 = rhAttribure
                                
                                   ' Add file to zip and close
                                   IF ZLibZipOpenNewFileInZip(lhA, BYCOPY rsName, ruFileInfo, BYVAL 0, 0, BYVAL 0, 0, BYCOPY rsComment, %ZLibZip_DEFLATED, IIF&(INSTR(lsModChars, "c"), %ZLibZip_NO_COMPRESSION, %ZLibZip_DEFAULT_COMPRESSION)) THEN axErrorAt 804
                                   IF ZLibZipWriteInFileInZip(lhA, BYVAL STRPTR(rsData), LEN(rsData)) THEN axErrorAt 805
                                   IF ZLibZipCloseFileInZip(lhA) THEN axErrorAt 806
                                
                                END SUB
                                
                                ' ==========>>> Zip File Insert Chunk Begin
                                SUB arZipFileInsertChunkBegin(wsZipControlBlock AS STRING, _
                                					rsName AS STRING, _
                                					OPTIONAL rsModChars AS STRING, _
                                					OPTIONAL rsDateTime AS STRING, _
                                					OPTIONAL BYVAL rhAttribure AS DWORD, _
                                					OPTIONAL BYVAL rsComment AS STRING)
                                '   Will prepare for multiple chunk file writing.   Multiple
                                '   InsertChunkWrite's may be called while one InsertChunkEnd must be
                                '   called.  ZipControlBlock(ZCB) must be a variable obtianed from call
                                '   to InsertOpen. DateTime is the SDT, if omitted then will use current
                                '   date-time. ModChars are:  c = %ZLibZip_NO_COMPRESSION. If error then
                                '   does ErrorAt.
                                
                                   LOCAL lhA AS DWORD
                                   LOCAL lsModChars AS STRING
                                   LOCAL lsDateTime AS STRING
                                   LOCAL ruFileInfo AS FileInfo_TYPE
                                
                                   ' Init stuff
                                   lhA = VAL(PARSE$(wsZipControlBlock, $WrdMrk, 2))
                                   IF VARPTR(rsModChars) THEN lsModChars = rsModChars
                                   IF VARPTR(rsDateTime) THEN lsDateTime = rsDateTime ELSE lsDateTime = axFlipDate(DATE$) & " " & TIME$
                                
                                   ' Build file info
                                   ruFileInfo.uDateTime.hYear = VAL(MID$(lsDateTime, 1, 4))
                                   ruFileInfo.uDateTime.hMonth = VAL(MID$(lsDateTime, 6, 2)) - 1
                                   ruFileInfo.uDateTime.hDay     = VAL(MID$(lsDateTime, 9, 2))
                                   ruFileInfo.uDateTime.hHour    = VAL(MID$(lsDateTime, 12, 2))
                                   ruFileInfo.uDateTime.hMinute = VAL(MID$(lsDateTime, 15, 2))
                                   ruFileInfo.uDateTime.hSecond      = VAL(MID$(lsDateTime, 18, 2))
                                   ruFileInfo.hAttribute2 = rhAttribure
                                
                                   ' Open file for writing
                                   IF ZLibZipOpenNewFileInZip(lhA, BYCOPY rsName, ruFileInfo, BYVAL 0, 0, BYVAL 0, 0, BYCOPY rsComment, %ZLibZip_DEFLATED, IIF&(INSTR(lsModChars, "c"), %ZLibZip_NO_COMPRESSION, %ZLibZip_DEFAULT_COMPRESSION)) THEN axErrorAt 844
                                
                                END SUB
                                
                                ' ==========>>> Zip File Insert Chunk Write
                                SUB arZipFileInsertChunkWrite(wsZipControlBlock AS STRING, _
                                					rsData AS STRING)
                                '   Will compress the passed Data and insert it into the zip file.
                                '   ZipControlBlock(ZCB) must be a variable obtianed from call to InsertOpen.
                                '   If error then does ErrorAt.  Note that this rut can be called multiple
                                '   times and is normally used for "big" files.
                                
                                   LOCAL lhA AS DWORD
                                
                                   ' Init stuff
                                   lhA = VAL(PARSE$(wsZipControlBlock, $WrdMrk, 2))
                                
                                   ' Write the data
                                   IF ZLibZipWriteInFileInZip(lhA, BYVAL STRPTR(rsData), LEN(rsData)) THEN axErrorAt 862
                                
                                END SUB
                                
                                ' ==========>>> Zip File Insert Chunk End
                                SUB arZipFileInsertChunkEnd(wsZipControlBlock AS STRING)
                                '   Will end a file opened for multiple chunk file writing
                                '   ZipControlBlock(ZCB) must be a variable obtianed from call to InsertOpen.
                                '   If error then does ErrorAt.
                                
                                   LOCAL lhA AS DWORD
                                
                                   ' Init stuff
                                   lhA = VAL(PARSE$(wsZipControlBlock, $WrdMrk, 2))
                                
                                   ' Close it
                                   IF ZLibZipCloseFileInZip(lhA) THEN axErrorAt 878
                                
                                END SUB
                                
                                ' ==========>>> Zip File Insert Close
                                SUB arZipFileInsertClose(wsZipControlBlock AS STRING)
                                '   Closes the file we have been zipping into.  If we
                                '   have been zipping into a temp file then will rebuild
                                '   the zip file, including the inserted files.
                                '   ZipControlBlock(ZCB) must be a variable obtianed
                                '   from call to InsertOpen. If error then does ErrorAt.
                                
                                   LOCAL lhA AS DWORD
                                
                                   ' Init stuff
                                   lhA = VAL(PARSE$(wsZipControlBlock, $WrdMrk, 2))
                                
                                   ' Close zipping file
                                   IF ZLibZipClose(lhA, BYVAL 0) THEN axErrorAt 896
                                
                                   ' Rebuild it if been zipping into temp
                                   IF PARSE$(wsZipControlBlock, $WrdMrk, 1) <> PARSE$(wsZipControlBlock, $WrdMrk, 3) THEN
                                	  CALL arZipFileRebuild(PARSE$(wsZipControlBlock, $WrdMrk, 1), PARSE$(wsZipControlBlock, $WrdMrk, 3), "")
                                   END IF
                                
                                END SUB
                                
                                ' ==========>>> Zip File Delete
                                SUB arZipFileDelete(rsZipFileName AS STRING, rsDeletes AS STRING, BYVAL rlDeletesType AS LONG)
                                '   Deletes is a DTS(fields) of either positions numbers or names depending on
                                '   DeletesType.  If deleting by name beware that a zip file may contain
                                '   duplicate names so only the first one found is deleted, if that won't work
                                '   use position numbers.  Enclose the names in quotes if they may contain a
                                '   comma.
                                '   DeleteType is as follows:
                                '      0 = Position numbers -- 1,4,8 would delete the first, fourth, and eighth file.
                                '      1 = Names -- case sensitive.
                                '      2 = Names -- case insensitive.
                                '   The zip file is rewritten to a temp file without the deleted files and
                                '   then renamed.
                                
                                   LOCAL llA AS LONG
                                   LOCAL llB AS LONG
                                   LOCAL llZipFileNumber AS LONG
                                   LOCAL lhA AS DWORD
                                   LOCAL lsA AS STRING
                                   LOCAL lsB AS STRING
                                   LOCAL lsFilePositions AS STRING
                                
                                   ' Open zip file
                                   IF ISFALSE axIsFileThere(rsZipFileName) THEN axErrorAt 928
                                   llZipFileNumber = FREEFILE
                                   ERRCLEAR
                                   OPEN rsZipFileName FOR BINARY AS llZipFileNumber
                                   IF ERR THEN axErrorAt 932
                                
                                   ' Seek to Central Dir(CD).  The End Central Dir(ECD) record is
                                   ' always at the end of a zip file and it contains the CD position.
                                   ' The problem is that the ECD may contain a comment which makes it
                                   ' poistion variable.  We will get hunks backward until we find
                                   ' the ECD.
                                   llA = LOF(llZipFileNumber) + 1
                                   DO
                                	  llA = llA - 22
                                	  IF llA < 0 THEN axErrorAt 942
                                	  SEEK llZipFileNumber, llA
                                	  GET$ llZipFileNumber, LOF(llZipFileNumber), lsA
                                	  llB = 1
                                	  DO
                                		 llB = INSTR(llB, lsA, "PK")
                                		 IF llB THEN
                                			' Is this a real begin of ECD.  We add where we are -1 plus
                                			' position in string we found "PK" - 1 plus length of
                                			' ECB which is 22 plus length of comment and if total is
                                			' equal to length of file then we know we have the real thing.
                                			IF llA - 1 + llB - 1 + 22 + CVWRD(lsA, 21 + llB - 1) = LOF(llZipFileNumber) THEN
                                			   ' We found real one so seek to CD and exit both do's
                                			   SEEK llZipFileNumber, CVDWD(lsA, 17 + llB - 1) + 1
                                			   EXIT, EXIT
                                			END IF
                                			INCR llB
                                		 ELSE
                                			EXIT
                                		 END IF
                                	  LOOP
                                   LOOP
                                
                                   ' Build the positions string
                                   llA = 0
                                   DO
                                	  GET$ llZipFileNumber, %prZipFileDirLength, lsA
                                	  IF LEFT$(lsA, 4) = "PK" THEN
                                		 INCR llA
                                		 IF rlDeletesType >= 1 THEN
                                			' Doing name delete
                                			GET$ llZipFileNumber, CVWRD(lsA, 29), lsB    'get name
                                			SEEK llZipFileNumber, SEEK(llZipFileNumber) - CVWRD(lsA, 29)    'seek back
                                			llB = axParseFind(rsDeletes, lsB, "", IIF$(rlDeletesType = 2, "U", ""))
                                		 ELSE
                                			' Doing position number delete
                                			llB = axParseFind(rsDeletes, FORMAT$(llA))
                                		 END IF
                                		 ' Found one if llB has a value so add to file positions
                                		 IF llB THEN lsFilePositions = axParseInsert(lsFilePositions, FORMAT$(CVDWD(lsA, 43) + 1))
                                
                                		 ' Bump to next CD
                                		 lhA = CVWRD(lsA, 29) + CVWRD(lsA, 31)  + CVWRD(lsA, 33) + SEEK(llZipFileNumber)
                                		 SEEK llZipFileNumber, lhA
                                
                                	  ELSE
                                
                                		 ' Not CD so exit
                                		 EXIT
                                	  END IF
                                   LOOP
                                
                                   ' Close and rebuild it if there is something to delete
                                   CLOSE llZipFileNumber
                                   IF LEN(lsFilePositions) THEN arZipFileRebuild rsZipFileName, "", lsFilePositions
                                
                                END SUB
                                
                                ' ==========>>> Zip File Rebuild
                                SUB arZipFileRebuild(rsZipFileName AS STRING, rsInsertZipFileName AS STRING, _
                                					 rsDeleteFilePositions AS STRING)
                                '   Will rebuild ZipFileName by copying all non deleted files and dirs along with
                                '   all files and dir from InsertZipFileName to a temp file and will then
                                '   kill ZipFileName and rename the temp file to ZipFileName.  InsertZipName
                                '   is killed.  If ZipFileName does not exist then will just rename
                                '   InsertZipName to ZipFileName.  If error then does ErrorAt.
                                
                                   LOCAL llDo AS LONG
                                   LOCAL llA AS LONG
                                   LOCAL lhA AS DWORD
                                   LOCAL llFileNumber AS LONG
                                   LOCAL llZipFileNumber AS LONG
                                   LOCAL llInsertZipFileNumber AS LONG
                                   LOCAL llTempFileNumber AS LONG
                                   LOCAL lsTempFileName AS STRING
                                   LOCAL lsOldToNewFilePosition AS STRING
                                   LOCAL lsA AS STRING
                                   LOCAL llFileCount AS LONG
                                   LOCAL lhDirStart AS DWORD
                                   LOCAL lhDirLength AS DWORD
                                
                                   ' Open a temp file to contain the merge
                                   llTempFileNumber = FREEFILE
                                   axGetTempFileName $WrdMrk & axParseDrivePathFile(rsZipFileName, "P"), lsTempFileName
                                   OPEN lsTempFileName FOR BINARY AS llTempFileNumber
                                
                                   ' Open the existing zip file
                                   llZipFileNumber = FREEFILE
                                   ERRCLEAR
                                   OPEN rsZipFileName FOR BINARY AS llZipFileNumber
                                   IF ERR THEN axErrorAt 1032
                                
                                   ' Open the insert zip file if passed name
                                   IF LEN(rsInsertZipFileName) THEN
                                	  llInsertZipFileNumber = FREEFILE
                                	  ERRCLEAR
                                	  OPEN rsInsertZipFileName FOR BINARY AS llInsertZipFileNumber
                                	  IF ERR THEN axErrorAt 1039
                                   END IF
                                
                                   ' Process each file in zip file
                                   llFileNumber = llZipFileNumber
                                   GOSUB ProcessFiles
                                
                                   ' Process each file in insert zip file if its open
                                   IF llInsertZipFileNumber THEN
                                	  llFileNumber = llInsertZipFileNumber
                                	  GOSUB ProcessFiles
                                   END IF
                                
                                   ' Process each dir in zip file
                                   lhDirStart = SEEK(llTempFileNumber)
                                   llFileNumber = llZipFileNumber
                                   GOSUB ProcessDirs
                                
                                   ' Process each dir in insert zip file if open
                                   IF llInsertZipFileNumber THEN
                                	  llFileNumber = llInsertZipFileNumber
                                	  GOSUB ProcessDirs
                                   END IF
                                
                                   ' Process end dir
                                   GET$ llZipFileNumber, %prZipFileEndDirLength, lsA
                                   IF LEFT$(lsA, 4) <> "PK" THEN axErrorAt 1065
                                   MID$(lsA, 9, 12) = MKWRD$(llFileCount) & MKWRD$(llFileCount) & MKDWD$(lhDirLength) & MKDWD$(lhDirStart - 1)
                                   PUT$ llTempFileNumber, lsA
                                   lhA = CVWRD(lsA, 21)
                                   GET$ llZipFileNumber, lhA, lsA
                                   PUT$ llTempFileNumber, lsA
                                
                                   ' Close files and kill and rename
                                   CLOSE llZipFileNumber, llTempFileNumber, llInsertZipFileNumber
                                   KILL rsZipFileName
                                   IF llInsertZipFileNumber THEN KILL rsInsertZipFileName
                                   NAME lsTempFileName AS rsZipFileName
                                
                                   EXIT SUB
                                
                                ProcessFiles:
                                   DO
                                	  GET$ llFileNumber, %prZipFileFileLength, lsA
                                	  IF LEFT$(lsA, 4) <> "PK" THEN
                                		 ' Not file so seek back
                                		 SEEK llFileNumber, SEEK(llFileNumber) - LEN(lsA)
                                		 EXIT DO
                                	  END IF
                                
                                	  ' If processing zip file then must check for deletes
                                	  IF llFileNumber = llZipFileNumber AND axParseFind(rsDeleteFilePositions, FORMAT$(SEEK(llFileNumber) - %prZipFileFileLength)) THEN
                                		 lhA = CVDWD(lsA, 19) + CVWRD(lsA, 27)  + CVWRD(lsA, 29)
                                		 SEEK llFileNumber, SEEK(llFileNumber) + lhA
                                		 ITERATE DO
                                	  END IF
                                
                                	  lsOldToNewFilePosition = lsOldToNewFilePosition & MKDWD$(SEEK(llFileNumber) - %prZipFileFileLength - 1) & MKDWD$(SEEK(llTempFileNumber) - 1)
                                	  PUT$ llTempFileNumber, lsA
                                	  lhA = CVDWD(lsA, 19) + CVWRD(lsA, 27)  + CVWRD(lsA, 29)
                                	  GET$ llFileNumber, lhA, lsA
                                	  PUT$ llTempFileNumber, lsA
                                   LOOP
                                   RETURN
                                ProcessDirs:
                                   DO
                                	  GET$ llFileNumber, %prZipFileDirLength, lsA
                                	  IF LEFT$(lsA, 4) <> "PK" THEN
                                		 ' Not dir so seek back
                                		 SEEK llFileNumber, SEEK(llFileNumber) - LEN(lsA)
                                		 EXIT DO
                                	  END IF
                                
                                	  ' If processing zip file then must check for deletes
                                	  IF llFileNumber = llZipFileNumber AND axParseFind(rsDeleteFilePositions, FORMAT$(CVDWD(lsA, 43) + 1)) THEN
                                		 lhA = CVWRD(lsA, 29) + CVWRD(lsA, 31)  + CVWRD(lsA, 33)
                                		 SEEK llFileNumber, SEEK(llFileNumber) + lhA
                                		 ITERATE DO
                                	  END IF
                                	  INCR llFileCount
                                
                                	  ' Update file position
                                	  llA = LEN(lsOldToNewFilePosition)
                                	  FOR llDo = 1 TO llA STEP 8
                                		 IF MID$(lsOldToNewFilePosition, llDo, 4) = MID$(lsA, 43, 4) THEN
                                			MID$(lsA, 43, 4) = MID$(lsOldToNewFilePosition, llDo + 4, 4)
                                			lsOldToNewFilePosition = LEFT$(lsOldToNewFilePosition, llDo - 1) & MID$(lsOldToNewFilePosition, llDo + 8)
                                			EXIT FOR
                                		 END IF
                                	  NEXT
                                	  IF llDo > llA THEN axErrorAt 1129
                                
                                	  PUT$ llTempFileNumber, lsA
                                	  lhA = CVWRD(lsA, 29) + CVWRD(lsA, 31)  + CVWRD(lsA, 33)
                                	  lhDirLength = lhDirLength + %prZipFileDirLength + lhA
                                	  GET$ llFileNumber, lhA, lsA
                                	  PUT$ llTempFileNumber, lsA
                                   LOOP
                                   RETURN
                                
                                END SUB
                                
                                ' ==========>>> Zip File Get Dir
                                SUB arZipFileGetDir(rsZipFileName AS STRING, wsFiles AS STRING)
                                '   Returns, in Files, data about each file in ZipFileName.
                                '   Files is a DTS(segments and words). There is a segment for each
                                '   file with words as follows:
                                '      1 = Name
                                '      2 = Date-time
                                '      3 = Attributes
                                '      4 = Compressed size
                                '      5 = Uncompressed size
                                '      6 = Comment
                                
                                   LOCAL lhUnZipFileHandle AS DWORD
                                   LOCAL luFI AS FileInfoX_TYPE
                                   LOCAL lzName AS ASCIZ * 1000
                                   LOCAL lzComment AS ASCIZ * 2500
                                   LOCAL lzA AS ASCIZ * 1
                                   LOCAL lsA AS STRING
                                
                                   wsFiles = ""
                                   lhUnZipFileHandle = ZLibUnzOpen(BYCOPY rsZipFileName)
                                   IF ISFALSE lhUnZipFileHandle THEN EXIT SUB      ' empty file or error
                                   DO
                                	  ZLibUnzGetCurrentFileInfo lhUnZipFileHandle, luFI, lzName, SIZEOF(lzName), lzA, 0, lzComment, SIZEOF(lzComment)
                                	  lsA = FORMAT$(luFI.tmu_Date.hYear, "0000") & "-" & FORMAT$(luFI.tmu_Date.hMonth + 1, "00") & "-" & FORMAT$(luFI.tmu_Date.hDay, "00") & " " & FORMAT$(luFI.tmu_Date.hHour, "00") & ":" & _
                                			FORMAT$(luFI.tmu_Date.hMinute, "00") & ":" & FORMAT$(luFI.tmu_Date.hSecond, "00")
                                	  wsFiles = axParseInsert(wsFiles, axReplace(PARSE$(lzName, $NUL, 1), "/", "\") & $WrdMrk & _
                                							  lsA & $WrdMrk & _
                                							  FORMAT$(luFI.external_fa) & $WrdMrk & _
                                							  FORMAT$(luFI.compressed_size) & $WrdMrk & _
                                							  FORMAT$(luFI.uncompressed_size) & $WrdMrk & _
                                							  lzComment, $SegMrk)
                                
                                   LOOP WHILE ZLibUnzGoToNextFile(lhUnZipFileHandle) = 0
                                
                                   ' Close it and were done
                                   ZLibUnzClose lhUnZipFileHandle
                                
                                END SUB
                                
                                ' ==========>>> Zip File Get Data
                                SUB arZipFileGetData(rsZipFileName AS STRING, rsFile AS STRING, rlFileType AS LONG, wsData AS STRING)
                                '   Returns, in Data the following DTS of Words.
                                '      1 = Name
                                '      2 = Date-time
                                '      3 = Attributes
                                '      4 = Compressed size
                                '      5 = Uncompressed size
                                '      6 = Comment
                                '   Passed File contains one of the following depeding on FileType:
                                '      0 = Position number.
                                '      1 = Name -- case sensitive.
                                '      2 = Name -- case insensitive.
                                '   If File contains name then beware that a zip file may contain duplicate names
                                '   so only the first one found is used, if that won't work use position numbers.
                                '   Enclose the names in quotes if they may contain a comma.
                                
                                   LOCAL llDo AS LONG
                                   LOCAL lsZipDats AS STRING
                                
                                   ' Get data for all files
                                   arZipFileGetDir rsZipFileName, lsZipDats
                                   FOR llDo = 1 TO axParseCount(lsZipDats, $SegMrk)
                                	  wsData = PARSE$(lsZipDats, $SegMrk, llDo)
                                	  SELECT CASE LONG rlFileType
                                	  CASE 0
                                		 IF VAL(rsFile) = llDo THEN EXIT SUB
                                	  CASE 1
                                		 IF PARSE$(wsData, $WrdMrk, 1) = rsFile THEN EXIT SUB
                                	  CASE 2
                                		 IF UCASE$(PARSE$(wsData, $WrdMrk, 1)) = UCASE$(rsFile) THEN EXIT SUB
                                	  END SELECT
                                   NEXT
                                   wsData = ""
                                
                                END SUB
                                
                                ' ==========>>> Zip File Get File
                                SUB arZipFileGetFile(rsZipFileName AS STRING, BYVAL rlFileNumber AS LONG, wsFileData AS STRING)
                                '   Returns, in FileData, uncompressed data from FileNumber in ZipFileName.
                                
                                   LOCAL lhUnZipFileHandle AS DWORD
                                   LOCAL luFI AS FileInfoX_TYPE
                                   LOCAL lzA AS ASCIZ * 1
                                
                                   lhUnZipFileHandle = ZLibUnzOpen(BYCOPY rsZipFileName)
                                   DO
                                	  DECR rlFileNumber
                                	  IF rlFileNumber = 0 THEN
                                
                                		 ' This is the file they want
                                		 ZLibUnzGetCurrentFileInfo lhUnZipFileHandle, luFI, lzA, 0, lzA, 0, lzA, 0
                                		 ZLibUnzOpenCurrentFile lhUnZipFileHandle
                                
                                		 wsFileData = SPACE$(luFI.uncompressed_size)
                                		 IF ZLibUnzReadCurrentFile(lhUnZipFileHandle, BYVAL STRPTR(wsFileData), LEN(wsFileData)) <> LEN(wsFileData) THEN axErrorAt 1236
                                		 ZLibUnzCloseCurrentFile lhUnZipFileHandle
                                		 EXIT DO
                                
                                	  END IF
                                   LOOP WHILE ZLibUnzGoToNextFile(lhUnZipFileHandle) = 0
                                   IF rlFileNumber THEN axErrorAt 1242
                                
                                   ' Close it and were done
                                   ZLibUnzClose lhUnZipFileHandle
                                
                                END SUB
                                
                                ' ==========>>> Zip File Comment
                                SUB arZipFileComment(rsZipFileName AS STRING, bsComment AS STRING)
                                '   Gets or puts the zip file comment.  If Comment is empty then
                                '   will get.  If Comment is not empty then will put.  If Comment
                                '   contains $NUL then will delete.
                                
                                   LOCAL llA, llB AS LONG
                                   LOCAL liA AS INTEGER
                                   LOCAL llZipFileNumber AS LONG
                                   LOCAL lsA AS STRING
                                
                                   ' Open zip file
                                   IF ISFALSE axIsFileThere(rsZipFileName) THEN axErrorAt 1261
                                   llZipFileNumber = FREEFILE
                                   ERRCLEAR
                                   OPEN rsZipFileName FOR BINARY AS llZipFileNumber
                                   IF ERR THEN axErrorAt 1265
                                
                                   ' Seek to Central Dir(CD).  The End Central Dir(ECD) record is
                                   ' always at the end of a zip file and it contains the CD position.
                                   ' The problem is that the ECD may contain a comment which makes it's
                                   ' poistion variable.  We will get hunks backward until we find
                                   ' the ECD.
                                   llA = LOF(llZipFileNumber) + 1
                                   DO
                                	  llA = llA - 22
                                	  IF llA < 0 THEN axErrorAt 1275
                                	  SEEK llZipFileNumber, llA
                                	  GET$ llZipFileNumber, LOF(llZipFileNumber), lsA
                                	  llB = 1
                                	  DO
                                		 llB = INSTR(llB, lsA, "PK")
                                		 IF llB THEN
                                			' Is this a real begin of ECD.  We add where we are -1 plus
                                			' position in string we found "PK" - 1 plus length of
                                			' ECB which is 22 plus length of comment and if total is
                                			' equal to length of file then we know we have the real thing.
                                			IF llA - 1 + llB - 1 + 22 + CVWRD(lsA, 21 + llB - 1) = LOF(llZipFileNumber) THEN
                                			   ' We found real one so seek to ECD comment length and exit both do's
                                			   SEEK llZipFileNumber, llA + llB - 3 + 22
                                			   EXIT, EXIT
                                			END IF
                                			INCR llB
                                		 ELSE
                                			EXIT
                                		 END IF
                                	  LOOP
                                   LOOP
                                
                                   ' Want to get or put
                                   IF ISFALSE LEN(bsComment) THEN
                                
                                	  ' Get comment
                                	  GET llZipFileNumber, , liA
                                	  GET$ llZipFileNumber, lia, bsComment
                                   ELSE
                                
                                	  ' Put comment
                                	  IF bsComment = $NUL THEN
                                		 PUT$ llZipFileNumber, MKI$(0)
                                	  ELSE
                                		 PUT$ llZipFileNumber, MKI$(LEN(bsComment)) & bsComment
                                	  END IF
                                	  SETEOF llZipFileNumber
                                
                                   END IF
                                
                                   ' Close zip file
                                   CLOSE llZipFileNumber
                                
                                END SUB
                                
                                ' ==========>>> Zipp File Update File
                                FUNCTION arZipFileUpdateFile(rsZipFileName AS STRING, rsFile AS STRING, rsModChars AS STRING, _
                                							 OPTIONAL rsNewName AS STRING, OPTIONAL rsNewDate AS STRING, _
                                							 OPTIONAL rsNewAttirbutes AS STRING, OPTIONAL rsNewComments AS STRING) AS LONG
                                '   Updates the zip file passed in ZipFileName containing
                                '   the zipped file passed in File.  Can change the file
                                '   name, date, attributes, and/or comments.
                                '   ModChars:  P = File is position -- defaults to name
                                '              U = File is case insensitive
                                '              N = Change name -- NewName must be passed.
                                '              D = Change date -- NewDate must be passed.
                                '              A = Change attributes -- NewAttributes must be passed.
                                '              C = Change comments -- NewComments must be passed.
                                '   Beware that a zip file may contain duplicate names so
                                '   if using names then the first one found is updated, if
                                '   that won't work use position number.
                                '   Returns %True if updated OK.
                                
                                   LOCAL llDo AS LONG
                                   LOCAL llPosition AS LONG
                                   LOCAL lsA AS STRING
                                   LOCAL lsZCB AS STRING
                                   LOCAL lsNewName AS STRING
                                   LOCAL lsFileData AS STRING
                                   LOCAL lsDirData AS STRING
                                
                                   ' Get file number, if not passed, and get dir data
                                   arZipFileGetDir rsZipFileName, lsA
                                   IF ISFALSE INSTR(rsModChars, "P") THEN
                                	  FOR llDo = 1 TO axParseCount(lsA, $SegMrk)
                                		 IF IIF$(INSTR(rsModChars, "U"), UCASE$(rsFile), rsFile) = IIF$(INSTR(rsModChars, "U"), UCASE$(PARSE$(PARSE$(lsA, $SegMrk, llDo), $WrdMrk, 1)), PARSE$(PARSE$(lsA, $SegMrk, llDo), $WrdMrk, 1)) THEN
                                			llPosition = llDo
                                			EXIT FOR
                                		 END IF
                                	  NEXT
                                   ELSE
                                	  llPosition = VAL(rsFile)
                                   END IF
                                   IF ISFALSE llPosition THEN EXIT FUNCTION
                                   lsDirData = PARSE$(lsA, $SegMrk, llPosition)
                                   lsNewName = PARSE$(lsDirData, $WrdMrk, 1)
                                
                                   ' Set new file name
                                   IF INSTR(rsModChars, "N") THEN lsNewName = rsNewName
                                
                                   ' Get file data
                                   arZipFileGetFile rsZipFileName, llPosition, lsFileData
                                
                                   ' Delete old file
                                   arZipFileDelete rsZipFileName, FORMAT$(llPosition), 0
                                
                                   ' Insert new
                                   CALL arZipFileInsertOpen(rsZipFileName, lsZCB)
                                   CALL arZipFileInsertPut(lsZCB, lsNewName, lsFileData, "", IIF$(INSTR(rsModChars, "D"), rsNewDate, PARSE$(lsDirData, $WrdMrk, 2)), _
                                						   IIF&(INSTR(rsModChars, "A"), VAL(rsNewAttirbutes), VAL(PARSE$(lsDirData, $WrdMrk, 3))), IIF$(INSTR(rsModChars, "C"), rsNewComments, PARSE$(lsDirData, $WrdMrk, 6)))
                                   CALL arZipFileInsertClose(lsZCB)
                                
                                   ' Exit OK
                                   FUNCTION = %True
                                
                                END FUNCTION
                                
                                FUNCTION axParseFind ALIAS "axParseFind" (rsMain AS STRING, rsFindValue AS STRING, _
                                   OPTIONAL BYVAL rsDelimit AS STRING, BYVAL rsModChars AS STRING, BYVAL rlStartingField AS LONG) Export AS LONG
                                '   Will try to find the FindValue string in the Main string.  Returns
                                '   the field number if found.  Usese the PB Parse command comparing each
                                '   field from the starting one and stops on the first equal. Delimit will
                                '   default to a comma.
                                '   ModChars are: U=compares in uppercase(slower)
                                '                 *=will compare only for the length of theFindValue
                                '                 A=ANY
                                '                 S=Main is in ascending so quit on high
                                
                                   LOCAL llPosition AS LONG
                                   LOCAL llFieldNumber AS LONG
                                   LOCAL lsField AS STRING
                                   LOCAL llAny AS LONG
                                
                                   ' If the starting field is zero make it one.
                                   IF rlStartingField = 0 THEN rlStartingField = 1
                                   ' Init the ANY.
                                   IF INSTR(rsModChars, "A") THEN llAny = %True
                                
                                   ' Position to starting field if > 1
                                   DO WHILE rlStartingField - 1 > llFieldNumber AND axParseNext(rsMain, llPosition, "", rsDelimit, IIF$(llAny, "A", ""))
                                	  INCR llFieldNumber
                                   LOOP
                                
                                   ' Loop thru each field comparing for ours or if sorted then greater than.
                                   IF llPosition >= 0 THEN
                                	  DO WHILE axParseNext(rsMain, llPosition, lsField, rsDelimit, IIF$(llAny, "A", ""))
                                		 INCR llFieldNumber
                                		 IF INSTR(rsModChars, "U") THEN
                                			IF INSTR(rsModChars, "*") THEN
                                			   IF UCASE$(LEFT$(lsField, LEN(rsFindValue))) = UCASE$(rsFindValue) THEN GOTO FoundIt
                                			   IF INSTR(rsModChars, "S") AND UCASE$(LEFT$(lsField, LEN(rsFindValue))) > UCASE$(rsFindValue) THEN GOTO NotFound
                                			ELSE
                                			   IF UCASE$(lsField) = UCASE$(rsFindValue) THEN GOTO FoundIt
                                			   IF INSTR(rsModChars, "S") AND UCASE$(lsField) > UCASE$(rsFindValue) THEN GOTO NotFound
                                			END IF
                                		 ELSE
                                			IF INSTR(rsModChars, "*") THEN
                                			   IF LEFT$(lsField, LEN(rsFindValue)) = rsFindValue THEN GOTO FoundIt
                                			   IF INSTR(rsModChars, "S") AND LEFT$(lsField, LEN(rsFindValue)) > rsFindValue THEN GOTO NotFound
                                			ELSE
                                			   IF lsField = rsFindValue THEN GOTO FoundIt
                                			   IF INSTR(rsModChars, "S") AND lsField > rsFindValue THEN GOTO NotFound
                                			END IF
                                		 END IF
                                	  LOOP
                                   END IF
                                   GOTO NotFound
                                
                                FoundIt:
                                   FUNCTION = llFieldNumber
                                
                                NotFound:
                                   ' Close parse next
                                   axParseNext "", -2, ""
                                
                                END FUNCTION
                                
                                '==============================<[ Main ]>==============================
                                FUNCTION PBMAIN
                                
                                   LOCAL lsA, lsB AS STRING
                                   LOCAL lsZCB AS STRING
                                
                                   ' zip it
                                   arZipFileInsertOpen "Text.Zip", lsZCB
                                   lsA = "This is some data to put in zip file."
                                   arZipFileInsertPut lsZCB, "MyFile.Txt", lsA
                                   arZipFileInsertClose lsZCB
                                
                                   ' unzip it
                                   arZipFileGetFile "Text.Zip", 1, lsB
                                   ? lsB
                                END FUNCTION
                                3.14159265358979323846264338327950
                                "Ok, yes... I like pie... um, I meant, pi."

                                Comment


                                • #17
                                  More ZLIB info, from José's forum:

                                  http://www.jose.it-berater.org/smffo...79.0;topicseen

                                  zLib is a compression library written by Jean-Loup Gailly (compression) and Mark Adler (decompression).

                                  Home Page: http://www.zlib.net/

                                  The calling convention used in zlib1.dll is CDECL.

                                  zLibWapi.dll is a library that merges the standard zLib library with the functions written with Gilles Volant to compress and uncompress .zip files using zLib. It uses the STDCALL calling convention.

                                  Home Page: http://www.winimage.com/zLibDll/

                                  The attached file contains my translation of the headers to PowerBASIC of both zLib and zLibWapi, as well as zLibWapi.dll. In addition, zLibWapi.inc also contains some wrapper functions to compress and uncompress strings and to add files to a .zip file.
                                  3.14159265358979323846264338327950
                                  "Ok, yes... I like pie... um, I meant, pi."

                                  Comment


                                  • #18
                                    Thank you José Roca for the LiteZip/LiteUnzip headers and sample codes. Worked well for me.
                                    Fredrick Ughimi
                                    www.meganetsoft.com

                                    Comment

                                    Working...
                                    X