/*
 * Xailer source code:
 *
 * ZipArchive.prg
 * Manejo de archivos ZIP
 *
 * Copyright 2003, 2007 Jose Lalin
 * Copyright 2003, 2012 Ignacio Ortiz de Zúñiga (versión Harbour)
 * Copyright 2003, 2012 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"
#include "Directry.ch"


#define HB_ZIP_OPEN_CREATE              0
#define HB_ZIP_OPEN_CREATEAFTER         1
#define HB_ZIP_OPEN_ADDINZIP            2

#define Z_ERRNO                         -1

#define UNZ_OK                          0
#define UNZ_END_OF_LIST_OF_FILE         -100
#define UNZ_ERRNO                       Z_ERRNO
#define UNZ_EOF                         0
#define UNZ_PARAMERROR                  -102
#define UNZ_BADZIPFILE                  -103
#define UNZ_INTERNALERROR               -104
#define UNZ_CRCERROR                    -105

#define ZIP_OK                          0
#define ZIP_EOF                         0
#define ZIP_ERRNO                       Z_ERRNO
#define ZIP_PARAMERROR                  -102
#define ZIP_BADZIPFILE                  -103
#define ZIP_INTERNALERROR               -104

//------------------------------------------------------------------------------

CLASS XZipArchive FROM TComponent

PUBLISHED:
   PROPERTY cFileName        INIT ""     EDITOR PE_BrowseFile
   PROPERTY cPassword        INIT ""     EDITOR PE_StringOrNil
   PROPERTY cComment         INIT ""     EDITOR PE_StringOrNil
   PROPERTY lIncludePath     INIT .T.
   PROPERTY lUniCode         INIT .F.
   PROPERTY nBufferSize      INIT 256

   EVENT OnProgress( oSender, nBytes, nTotal )  // --> Nil
   EVENT OnChangeFile( oSender, cFile ) // --> Nil

PUBLIC:

   DATA cLastError   INIT ""
   DATA nLastError   INIT 0

ENDCLASS

//-----------------------------------------------------------------------------

CLASS XZipFile FROM TZipArchive

PUBLISHED:
   PROPERTY aFileMask  INIT "*.*" EDITOR PE_StringList ;
                       WRITE INLINE ::FaFileMask := Value,;
                                    ::FaFiles := {},;
                                    ::aMasks  := {}

   PROPERTY nCompressionLevel INIT pkDEFLATE ;
                              VALUES pkSTORE, pk1, pk2, pk3, pk4, ;
                                     pkDEFLATE, pk6, pk7, pk8, pkBEST

   PROPERTY lOverwrite     INIT .T.
   PROPERTY lMasksComPath  INIT .F.
   PROPERTY lIncludeDrive  INIT .F. WRITE INLINE ::lMasksComPath := Value // Deprecated
   PROPERTY lRecurse       INIT .F.

PUBLIC:
   PROPERTY aFiles   INIT {}  READONLY READ INLINE ::FaFiles := ::GetFiles()
   METHOD Run() // --> lSuccess
   METHOD Execute()        INLINE ::Run() // --> lSuccess
   METHOD FilesSize() // --> nTotalFileSize
   METHOD AddFile( cFile ) // --> Nil

PROTECTED:
   DATA aMasks   INIT {}

   METHOD GetFiles()
   METHOD CommonMaskPath()

ENDCLASS

//--------------------------------------------------------------------------

METHOD Run() CLASS XZipFile

   LOCAL aFiles
   LOCAL dDate
   LOCAL cFile, cTime, cBuffer, cDir, cPath, cMaskPath
   LOCAL nTotal, nAttr, nSize, nRead, nLen, nPos
   LOCAL hZip, hFile
   LOCAL lOk

   ::nLastError := 0
   ::cLastError := ""

   nLen    := ::nBufferSize * 1024
   cDir    := HB_CurDrive() + ":\" + Curdir()
   cBuffer := Space( nLen )
   nTotal  := 0
   nPos    := 0
   lOk     := .T.
   aFiles  := ::GetFiles()

   IF Len( aFiles ) == 0
      ::cLastError := "Property aFiles empty"
      RETURN .F.
   ENDIF

   IF !::lOverwrite .AND. File( ::cFileName )
      hZip := HB_ZipOpen( ::cFileName, HB_ZIP_OPEN_ADDINZIP )
   ELSE
      hZip := HB_ZipOpen( ::cFileName, HB_ZIP_OPEN_CREATE )
   ENDIF

   IF Empty( hZip )
      ::nLastError := GetLastError()
      ::cLastError := "File creation error (" + ::cFileName + ")"
      RETURN .F.
   ENDIF

   cMaskPath := ::CommonMaskPath()
   nTotal := ::FilesSize()

   FOR EACH cFile IN aFiles

      IF !::lIncludePath
         DirChange( FilePath( cFile ) )
         cFile := FileFullName( cFile )
      ELSE
         cPath := FilePath( ::aMasks[ cFile:__enumIndex ] )
         IF !Empty( cPath )
            IF !::lMasksComPath
               IF !::lIncludePath
                  DirChange( cPath )
                  cFile := SubStr( cFile, Len( cPath ) + 2 )
               ELSE
                  DirChange( cMaskPath )
                  cFile := SubStr( cFile, Len( cMaskPath ) + 1 )
               ENDIF
            ELSE
               IF Empty( cMaskPath ) .OR. Left( cFile, 3) != Left( cMaskPath, 3 )
                 cMaskPath := Left( cFile, 3 )
               ENDIF
               DirChange( cMaskPath )
               cFile := SubStr( cFile, Len( cMaskPath ) + 1 )
            ENDIF
         ENDIF
      ENDIF

      dDate := FileDateTimeLocal( cFile )
      cTime := SubStr( hb_TToC( dDate ), 12, 8 )
      nSize := hb_FSize( cFile )
      nAttr := GetFileAttributes( cFile )

      ::OnChangeFile( cFile )

      IF ( hFile := FOpen( cFile, 32 ) ) <= 0
         ::cLastError := "File open error (" + cFile + ")"
         ::nLastError := GetLastError()
         lOk := .F.
         EXIT
      ENDIF

      IF Empty( ::cPassword )
         HB_ZipFileCreate( hZip, cFile, dDate, cTime, 0, nAttr,, ;
                           ::nCompressionLevel,,,::cComment, ::lUnicode )
      ELSE
         HB_ZipFileCreate( hZip, cFile, dDate, cTime, 0, nAttr,, ;
                           ::nCompressionLevel, ::cPassword, hb_ZipFileCRC32( cFile ), ::cComment, ::lUnicode )
      ENDIF

      DO WHILE nSize > 0
         nRead := FRead( hFile, @cBuffer, Min( nSize, nLen ) )
         IF nRead == 0
            EXIT
         ENDIF
         IF ( ::nLastError := GetLastError() ) != 0
            ::cLastError := "File reading error (" + cFile + ")"
            FClose( hFile )
            lOk := .F.
            EXIT
         ENDIF
         HB_ZipFileWrite( hZip, cBuffer, nRead )
         nSize -= nRead
         nPos  += nRead
         ::OnProgress( nPos, nTotal )
      END DO

      HB_ZipFileClose( hZip )
      FClose( hFile )

      IF !lOk
         EXIT
      ENDIF

   NEXT

   HB_ZipClose( hZip )

   DirChange( cDir )

RETURN lOk

//------------------------------------------------------------------------------

METHOD FilesSize() CLASS XZipFile

   LOCAL nTotal := 0

   AEval( ::aFiles, {| cFile | nTotal += hb_FSize( cFile ) } )

RETURN nTotal

//------------------------------------------------------------------------------

METHOD AddFile( cFile ) CLASS XZipFile

   IF !Empty( cFile ) .AND. AScan( ::FaFiles, {| x | Upper( x ) == Upper( cFile ) } ) == 0
      AAdd( ::FaFiles, cFile )
      AAdd( ::aMasks, NIL )
   ENDIF

RETURN Nil

//------------------------------------------------------------------------------

METHOD GetFiles() CLASS XZipFile

   LOCAL aFiles := {}, aMasks := {}, aTemp
   LOCAL cPath
   LOCAL nLen
   LOCAL i

   IF Len( ::FaFiles ) > 0
      RETURN ::FaFiles
   ENDIF

   IF ValType( ::aFileMask ) == "C"
      ::aFileMask := { ::aFileMask }
   ENDIF

   nLen := Len( ::aFileMask )

   FOR i := 1 TO nLen
      cPath := ::aFileMask[ i ]
      aTemp := RecurseDir( cPath, ::lRecurse )
      AEVal( aTemp, {|cFile| AAdd( aFiles, cFile ), AAdd( aMasks, cPath ) } )
   NEXT

   ::FaFiles := aFiles
   ::aMasks  := aMasks

RETURN aFiles

//------------------------------------------------------------------------------

METHOD CommonMaskPath() CLASS XZipFile

   LOCAL cPath, cMask
   LOCAL nLen, nPos, nFor

   IF ValType( ::FaFileMask ) == "C"
      ::FaFileMask := { ::FaFileMask }
   ENDIF

   cPath := ::FaFileMask[ 1 ]

   FOR nFor := 2 TO Len( ::FaFileMask )
      cMask := ::FaFileMask[ nFor ]
      nPos  := 1
      nLen  := Min( Len( cPath ), Len( cMask ) )
      DO WHILE nPos <= nLen
         IF Upper( Left( cPath, nPos ) ) == Upper( Left( cMask, nPos ) )
            nPos++
         ELSE
            EXIT
         ENDIF
      ENDDO
      cPath := Left( cPath, nPos - 1 )
      IF Empty( cPath )
         EXIT
      ENDIF
   NEXT

   IF Empty( nPos )
      IF ( nPos := Rat( "\", cPath ) ) > 0   // Quitamos la máscara si la hubiese
        cPath := Left( cPath, nPos - 1 )
         IF ( nPos := Rat( "\", cPath ) ) > 0   // Retrocedemos un directorio
           cPath := Left( cPath, nPos )
         ELSE
            cPath += "\"
         ENDIF
      ENDIF
   ELSE
       IF ( nPos := RAt( "\", cPath ) ) > 0
         cPath := Left( cPath, nPos )
       ENDIF
   ENDIF

RETURN cPath

//------------------------------------------------------------------------------

STATIC FUNCTION RecurseDir( cMask, lRecursive, aFiles )

   LOCAL aDir, aFile
   LOCAL cPath, cFile

   DEFAULT aFiles TO {}, lRecursive TO .F.

   aDir  := Directory( cMask )
   cPath := FilePath( cMask )
   cMask := FileFullname( cMask )

   // Primero buscamos en directorio actual

   FOR EACH aFile IN aDir
      cFile := aFile[ F_NAME ]
      AAdd( aFiles, cPath + "\" + cFile )
   NEXT

   // Luego buscamos en directorios inferiores

   IF lRecursive
      aDir := Directory( cPath + "\*.*", "D" )
      FOR EACH aFile IN aDir
         cFile := aFile[ F_NAME ]
         IF "D" $ aFile[ F_ATTR ] .AND. cFile != "." .AND. cFile != ".."
            RecurseDir( cPath + "\" + cFile + "\" + cMask, .T., @aFiles )
         ENDIF
      NEXT
   ENDIF

RETURN aFiles

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

CLASS XUnzipFile FROM TZipArchive

PUBLISHED:
   PROPERTY aFileMask   INIT "*.*" EDITOR PE_StringList
   PROPERTY cDirectory  INIT ""    EDITOR PE_BrowseFolder

PUBLIC:
   PROPERTY nCount      INIT 0 READ INLINE ::FilesCount()

   METHOD Run() // --> lSuccess
   METHOD Execute()     INLINE ::Run() // --> lSuccess
   METHOD FilesInfo()
   METHOD FilesCount()
   METHOD FilesSize()
   METHOD aFiles()      INLINE ::FilesInfo()
   METHOD HasPassword() // --> lValue
   METHOD DeleteFiles( acFiles ) // --> lSuccess

ENDCLASS

//--------------------------------------------------------------------------

METHOD Run() CLASS XUnzipFile

   LOCAL aMasks
   LOCAL dDate
   LOCAL cFile, cMask, cPass, cDir, cBuffer, cPath
   LOCAL nNext, nTotal, nSize, nPos, nLen, nRead
   LOCAL hUnZip, hFile
   LOCAL lOk, lExtract

   ::nLastError := 0
   ::cLastError := ""

   IF !File( ::cFileName )
      ::cLastError := "File not found (" + ::cFileName + ")"
      RETURN .F.
   ENDIF

   nTotal := ::FilesSize()
   hUnZip := HB_UnZipOpen( ::cFileName )

   IF Empty( hUnZip )
      ::nLastError := GetLastError()
      ::cLastError := "File open error (" + ::cFileName + ")"
      RETURN .F.
   ENDIF

   IF Empty( ::cDirectory )
      ::cLastError := "TUnZipFile:cDirectory not set"
      RETURN .F.
   ELSE
      cDir := ::cDirectory
      IF Right( cDir, 1 ) != "\"
         cDir += "\"
      ENDIF
   ENDIF

   IF ValType( ::aFileMask ) == "C"
      aMasks := { ::aFileMask }
   ELSE
      aMasks := ::aFileMask
   ENDIF

   IF !Empty( ::cPassword )
      cPass := ::cPassword
   ENDIF

   nNext   := HB_UnzipFileFirst( hUnZip )
   nPos    := 0
   nLen    := ::nBufferSize * 1024
   lOk     := .T.
   cBuffer := Space( nLen )

   DO WHILE nNext >= 0

      // Recuperamos información

      HB_UnzipFileInfo( hUnZip, @cFile, @dDate,,,,,@nSize )

      IF Empty( cFile )
         lOk := .F.
         EXIT
      ENDIF

      cFile := StrTran( cFile, "/", "\" )

      ::OnChangeFile( cFile )

      // Comprobamos que cumple la mascara
      lExtract := .F.
      FOR EACH cMask IN aMasks
         IF HB_FileMatch( cFile, cMask )
            lExtract := .T.
            EXIT
         ENDIF
      NEXT

      IF !lExtract .OR. nSize == 0 // IOZ: Se trata de un directorio vacío
         nPos += nSize
         ::OnProgress( nPos, nTotal )
         nNext := HB_UnzipFileNext( hUnZip )
         LOOP
      ENDIF

      // Abrimos el subfichero Zip comprimido

      IF HB_UnzipFileOpen( hUnZip, cPass ) < 0
         ::cLastError := "File open error (" + ::cFilename + ")"
         ::nLastError := GetLastError()
         lOk := .F.
         EXIT
      ENDIF

      // Si no hay que incluir Path quitarlo

      IF !::lIncludePath
         cFile := "\" + FileFullname( cFile )
      ENDIF

      // Crear directorios si no existen

      cPath := FilePath( cDir + cFile )

      IF !ForceDir( cPath )
         ::cLastError := "Directory creation error (" + cPath + ")"
         lOk := .F.
         EXIT
      ENDIF

      // Creamos fichero de salida

      IF ( hFile := FCreate( cDir + cFile, 0 ) ) <= 0
         ::cLastError := "File creation error (" + cDir + cFile + ")"
         ::nLastError := GetLastError()
         lOk := .F.
         EXIT
      ENDIF

      // Bucle de descompresión

      DO WHILE ( nRead := HB_UnzipFileRead( hUnZip, @cBuffer, nLen ) ) > 0
         IF FWrite( hFile, cBuffer, nRead ) != nRead
            ::nLastError := FError()
            ::cLastError := "File write error (" + cDir + cFile + ")"
            lOk := .F.
            EXIT
         ENDIF
         nSize -= nRead
         nPos  += nRead
         ::OnProgress( nPos, nTotal )
      END DO

      FClose( hFile )

      // Poner fecha en el fichero descomprimido

      SetFileDateTime( cDir + cFile, dDate )

      nNext := HB_UnzipFileNext( hUnZip )

      IF !lOk
         EXIT
      ENDIF

   ENDDO

   HB_UnzipClose( hUnZip )

RETURN lOk

//------------------------------------------------------------------------------

METHOD FilesCount() CLASS XUnzipFile

   LOCAL nCount
   LOCAL hFile

   IF !File( ::cFileName )
      RETURN 0
   ENDIF

   nCount := 0
   hFile  := HB_UnZipOpen( ::cFileName )

   IF !Empty( hFile )
      HB_UnzipGlobalInfo( hFile, @nCount )
      HB_UnzipClose( hFile )
   ENDIF

RETURN nCount

//------------------------------------------------------------------------------

METHOD FilesSize() CLASS XUnZipFile

   LOCAL aFiles
   LOCAL nTotal

   aFiles := ::FilesInfo()
   nTotal := 0

   AEval( aFiles, {| aFile | nTotal += aFile[ 2 ] } )

RETURN nTotal

//-----------------------------------------------------------------------------

METHOD HasPassword() CLASS XUnZipFile

   LOCAL hFile
   LOCAL lPassword := .F.

   hFile := hb_UnzipOpen( ::cFileName )

   IF ! Empty( hFile )
      IF hb_UnzipFileFirst( hFile ) == 0
         hb_UnzipFileInfo( hFile, Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil, @lPassword )
      ENDIF
      hb_UnzipClose( hFile )
   ENDIF

RETURN lPassword

//-----------------------------------------------------------------------------

METHOD DeleteFiles( acFiles ) CLASS XUnZipFile

   LOCAL lSuccess := .T.
   LOCAL cFile

   IF ValType( acFiles ) == "C"
      acFiles := { acFiles }
   ENDIF

   FOR EACH cFile IN acFiles
      lSuccess := lSuccess .AND. hb_ZipDeleteFile( ::cFileName, cFile )
   NEXT

RETURN lSuccess

//------------------------------------------------------------------------------

METHOD FilesInfo() CLASS XUnzipFile

   LOCAL aFiles
   LOCAL cFile, cTime, cComment
   LOCAL dDate
   LOCAL nNext, nAttr, nMethod, nSize, nComp, nCRC, nRatio
   LOCAL lEncryp
   LOCAL hFile

   IF !File( ::cFileName )
      RETURN {}
   ENDIF

   aFiles := {}
   hFile  := HB_UnZipOpen( ::cFileName )

   IF !Empty( hFile )
      nNext  := HB_UnzipFileFirst( hFile )
      nRatio := 0
      DO WHILE nNext >= 0
         HB_UnzipFileInfo( hFile, @cFile, @dDate, @cTime, @nAttr,, @nMethod,;
                           @nSize, @nComp, @lEncryp, @cComment, @nCRC )

         IF nSize > 0
            nRatio := Max( 0, 100 - ( ( nComp * 100 ) / nSize ) )
         ENDIF
         AAdd( aFiles, { cFile, nSize, nMethod, nComp, nRatio, dDate, cTime,;
                         Hex( nCRC ), nAttr, lEncryp, cComment } )
         nNext := HB_UnzipFileNext( hFile )
      ENDDO
      HB_UnzipClose( hFile )
   ENDIF

RETURN aFiles

//------------------------------------------------------------------------------
#translate IsDir( <cDir> ) => Len( Directory( <cDir>, "D" ) ) > 0

STATIC FUNCTION ForceDir( cDir )

   LOCAL cRootDir
   LOCAL nAt, nOcurr

   IF IsDir( cDir ) .OR. ( MakeDir( cDir ) == 0 )
      RETURN .T.
   ENDIF

   nOcurr := 2
   nAt    := AtNext( "\", cDir, nOcurr++ )

   IF nAt == 0
       RETURN .F.
   ENDIF

   DO WHILE nAt > 0

      cRootDir := Left( cDir, nAt - 1 )
      IF !IsDir( cRootDir ) .AND. ( MakeDir( cRootDir ) != 0 )
          RETURN .F.
      ENDIF
      nAt := AtNext( "\", cDir, nOcurr++ )

   ENDDO

   IF !IsDir( cDir ) .AND. ( MakeDir(cDir) != 0 )
      RETURN .F.
   ENDIF

RETURN .T.

//------------------------------------------------------------------------------

STATIC FUNCTION AtNext( cSearch, cString, nOcurr )

   LOCAL cSubString := cString
   LOCAL nFor, nAt, nPos

   nPos := 0

   FOR nFor := 1 TO nOcurr
       nAt  := At( cSearch, cSubString )
       IF nAt == 0
          nPos := 0
          EXIT
       ELSE
          nPos += nAt
          cSubString := Substr( cSubString, nAt + 1 )
      ENDIF
   NEXT

RETURN nPos

//------------------------------------------------------------------------------