diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d66c3ab534..9391e583e2 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,28 @@ The license applies to all entries newer than 2009-04-28. */ +2011-10-20 15:21 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) + * contrib/hbpgsql/hbpgsql.hbx + * contrib/hbpgsql/hbpgsql.hbp + - contrib/hbpgsql/hdbcpg.prg + - Deleted HDBC class layer due references to deprecated + wrapper function which caused link errors in dynamic builds + or HDBC apps. Please readd the file if interested in making + this technially simple fix. + + * contrib/hbmzip/mzip.c + % eliminated one local variable in HB_UNZIPFILEREAD() + + * contrib/hbziparc/ziparc.prg + + HB_UNZIPFILE(): added progress bar support. + Patch by Leandro Damasio, with following changes: + ! refixed to use cPath when forming target filename + ! missing hHandle declaration + % FERASE() removed, FCREATE() will recreate it + % Left() eliminated from FWRITE() call + * minor symbol casing + ; I didn't test this code, so please do it. + 2011-10-20 12:56 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/src/rtl/transfrm.c % eliminated hb_charUpper() called for picture clauses and minor diff --git a/harbour/contrib/hbmzip/mzip.c b/harbour/contrib/hbmzip/mzip.c index 63759d4e2b..2a89986ffd 100644 --- a/harbour/contrib/hbmzip/mzip.c +++ b/harbour/contrib/hbmzip/mzip.c @@ -550,8 +550,6 @@ HB_FUNC( HB_UNZIPFILEREAD ) if( hUnzip ) { - int iResult; - if( HB_ISNUM( 3 ) ) { HB_SIZE nRead = hb_parns( 3 ); @@ -559,8 +557,7 @@ HB_FUNC( HB_UNZIPFILEREAD ) nSize = nRead; } - iResult = unzReadCurrentFile( hUnzip, buffer, ( unsigned ) nSize ); - hb_retnl( iResult ); + hb_retnl( unzReadCurrentFile( hUnzip, buffer, ( unsigned ) nSize ) ); } } else diff --git a/harbour/contrib/hbpgsql/hbpgsql.hbp b/harbour/contrib/hbpgsql/hbpgsql.hbp index f39598dc99..a04c499814 100644 --- a/harbour/contrib/hbpgsql/hbpgsql.hbp +++ b/harbour/contrib/hbpgsql/hbpgsql.hbp @@ -33,4 +33,3 @@ postgres.c rddcopy.c tpostgre.prg -hdbcpg.prg diff --git a/harbour/contrib/hbpgsql/hbpgsql.hbx b/harbour/contrib/hbpgsql/hbpgsql.hbx index 9d0a05eb01..328e273f6a 100644 --- a/harbour/contrib/hbpgsql/hbpgsql.hbx +++ b/harbour/contrib/hbpgsql/hbpgsql.hbx @@ -26,12 +26,6 @@ #endif DYNAMIC HB_PQCOPYFROMWA -DYNAMIC HDBCPGCONNECTION -DYNAMIC HDBCPGDATABASEMETADATA -DYNAMIC HDBCPGPREPAREDSTATEMENT -DYNAMIC HDBCPGRESULTSET -DYNAMIC HDBCPGRESULTSETMETADATA -DYNAMIC HDBCPGSTATEMENT DYNAMIC LO_EXPORT DYNAMIC LO_IMPORT DYNAMIC LO_UNLINK diff --git a/harbour/contrib/hbpgsql/hdbcpg.prg b/harbour/contrib/hbpgsql/hdbcpg.prg deleted file mode 100644 index f2634a6987..0000000000 --- a/harbour/contrib/hbpgsql/hdbcpg.prg +++ /dev/null @@ -1,769 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * PostgreSQL RDBMS JDBC like interface code. - * - * Copyright 2008 Lorenzo Fiorini lorenzo.fiorini@gmail.com - * www - http://harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - * See doc/license.txt for licensing terms. - * - */ - -#include "common.ch" -#include "hbclass.ch" -#include "error.ch" -#include "postgres.ch" - -create class hdbcPGConnection - - PROTECTED: - - var pDb - var lTrans - var lTrace INIT .F. - var pTrace - - EXPORTED: - - method new( cHost, cDatabase, cUser, cPass, nPort ) - method close() - - method startTransaction() - method transactionStatus() INLINE PQtransactionstatus( ::pDb ) - method commit() - method rollback() - - method createStatement() - method prepareStatement( cSql ) - - method getMetadata() - -endclass - -method new( cHost, cDatabase, cUser, cPass, nPort ) class hdbcPGConnection - - DEFAULT nPort TO 5432 - - ::pDB := PQconnectDB( "dbname = " + cDatabase + " host = " + cHost + " user = " + cUser + " password = " + cPass + " port = " + hb_ntos( nPort ) ) - - if PQstatus( ::pDb ) != CONNECTION_OK - raiseError( PQerrormessage( ::pDb ) ) - endif - - return Self - -method close() class hdbcPGConnection - - PQClose( ::pDb ) - - return nil - -method startTransaction() class hdbcPGConnection - - Local pRes := PQexec( ::pDB, "BEGIN" ) - - if PQresultstatus( pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( pRes ) ) - endif - - PQclear( pRes ) - - return nil - - -method commit() class hdbcPGConnection - - Local pRes := PQexec( ::pDB, "COMMIT" ) - - if PQresultstatus( pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( pRes ) ) - endif - - PQclear( pRes ) - - return nil - -method rollback() class hdbcPGConnection - - Local pRes := PQexec( ::pDB, "ROLLBACK" ) - - if PQresultstatus( pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( pRes ) ) - endif - - PQclear( pRes ) - - return nil - -method createStatement() class hdbcPGConnection - - return hdbcPGStatement():new( ::pDB ) - -method prepareStatement( cSql ) class hdbcPGConnection - - return hdbcPGPreparedStatement():new( ::pDB, cSql ) - -method getMetadata() class hdbcPGConnection - - return hdbcPGDatabaseMetaData():new( ::pDB ) - -create class hdbcPGStatement - - PROTECTED: - - var pDB - var cSql - var oRs - - EXPORTED: - - var pRes - - method new( pDB, cSql ) - method executeQuery( cSql ) - method executeUpdate( cSql ) - method Close() - -endclass - -method new( pDB, cSql ) class hdbcPGStatement - - ::pDB := pDB - ::cSql := cSql - - return self - -method executeQuery( cSql ) class hdbcPGStatement - - ::pRes := PQexec( ::pDB, cSql ) - - if PQresultstatus( ::pRes ) != PGRES_TUPLES_OK - raiseError( PQresultErrormessage( ::pRes ) ) - else - ::oRs := hdbcPGResultSet():new( ::pDB, Self ) - endif - - return ::oRs - -method executeUpdate( cSql ) class hdbcPGStatement - - Local nRows - - ::pRes := PQexec( ::pDB, cSql ) - - if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( ::pRes ) ) - else - nRows := val( PQcmdTuples( ::pRes ) ) - endif - - return nRows - -method Close() class hdbcPGStatement - - if !ISNIL( ::pRes ) - - PQclear( ::pRes ) - - ::pRes := nil - - endif - - return nil - -create class hdbcPGPreparedStatement - - PROTECTED: - - var pDB - var cSql - var pRes - var oRs - var cName INIT "hdbcpg11" - - var lPrepared INIT .F. - var nParams INIT 0 - var aParams INIT array( 128 ) - - EXPORTED: - - method new( pDB, cSql ) - method executeQuery() - method executeUpdate() - method Close() - - method setString( nParam, xValue ) - method SetNumber( n, x ) INLINE ::setString( n, str( x ) ) - method SetDate( n, x ) INLINE ::setString( n, dtos( x ) ) - method SetBoolean( n, x ) INLINE ::setString( n, iif( x, "t", "f" ) ) - -endclass - -method new( pDB, cSql ) class hdbcPGPreparedStatement - - ::pDB := pDB - ::cSql := cSql - - return self - -method executeQuery() class hdbcPGPreparedStatement - - Local pRes - - if !::lPrepared - ::aParams := asize( ::aParams, ::nParams ) - pRes := PQprepare( ::pDB, ::cName, ::cSql, ::nParams ) - if PQresultstatus( pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( pRes ) ) - else - ::lPrepared := .T. - endif - PQClear( pRes ) - endif - - if ::lPrepared - ::pRes := PQexecPrepared( ::pDB, ::cName, ::aParams ) - if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK .and. PQresultstatus( ::pRes ) != PGRES_TUPLES_OK - raiseError( PQresultErrormessage( ::pRes ) ) - else - ::oRs := hdbcPGResultSet():new( ::pDB, Self ) - ::aParams := array( ::nParams ) - endif - endif - - return ::oRs - -method executeUpdate() class hdbcPGPreparedStatement - - Local nRows - - if !::lPrepared - ::aParams := asize( ::aParams, ::nParams ) - ::pRes := PQprepare( ::pDB, ::cName, ::cSql, ::nParams ) - if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( ::pRes ) ) - else - ::lPrepared := .T. - endif - PQClear( ::pRes ) - endif - - if ::lPrepared - ::pRes := PQexecPrepared( ::pDB, ::cName, ::aParams ) - if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( ::pRes ) ) - else - nRows := val( PQcmdTuples( ::pRes ) ) - ::aParams := array( ::nParams ) - endif - endif - - return nRows - -method setString( nParam, xValue ) class hdbcPGPreparedStatement - - ::aParams[ nParam ] := xValue - - if !::lPrepared - if nParam > ::nParams - ::nParams := nParam - endif - endif - - return nil - -method Close() class hdbcPGPreparedStatement - - if !ISNIL( ::pRes ) - - PQclear( ::pRes ) - - ::pRes := nil - - endif - - ::pRes := PQexec( ::pDB, "DEALLOCATE " + ::cName ) - - PQclear( ::pRes ) - - ::pRes := nil - - return nil - -create class hdbcPGResultSet - - PROTECTED: - - var pDB - var pStmt - var pRes - - var lBeforeFirst INIT .T. - var lAfterLast INIT .F. - - var nRow INIT 0 - - var cTableName - var aPrimaryKeys - var cPrimaryWhere - var aBuffer - var nCurrentRow - - EXPORTED: - - var nRows INIT 0 - - method new( pDB, pStmt ) - method Close() - - method beforeFirst() - method first() INLINE ::absolute( 1 ) - method previous() INLINE ::relative( -1 ) - method next() INLINE ::relative( 1 ) - method last() INLINE ::absolute( ::nRows ) - method afterLast() - - method relative( nMove ) - method absolute( nMove ) - - method isBeforeFirst() INLINE ::lBeforeFirst - method isFirst() INLINE ( ::nRow == 1 ) - method isLast() INLINE ( ::nRow == ::nRows ) - method isAfterLast() INLINE ::lAfterLast - method getRow() INLINE ::nRow - method findColumn( cField ) - - method getString( nField ) - method getNumber( nField ) INLINE val( ::getString( nField ) ) - method getDate( nField ) INLINE StoD( strtran( ::getString( nField ), "-" ) ) - method getBoolean( nField ) INLINE ( ::getString( nField ) == "t" ) - - method getMetaData() - - method setTableName( cTable ) INLINE ::cTableName := cTable - method setPrimaryKeys( aKeys ) INLINE ::aPrimaryKeys := aKeys - - method moveToInsertRow() - method moveToCurrentRow() - method insertRow() - method updateRow() - method deleteRow() - - method updateBuffer( nField, xValue, cType ) - method updateString( nField, cValue ) INLINE ::updateBuffer( nField, cValue, "C" ) - method updateNumber( nField, nValue ) INLINE ::updateBuffer( nField, hb_ntos( nValue ), "N" ) - method updateDate( nField, dValue ) INLINE ::updateBuffer( nField, dtos( dValue ), "D" ) - method updateBoolean( nField, lValue ) INLINE ::updateBuffer( nField, iif( lValue, "t", "f" ), "L" ) - -endclass - -method new( pDB, pStmt ) class hdbcPGResultSet - - ::pDB := pDB - ::pStmt := pStmt - ::pRes := pStmt:pRes - - ::nRows := PQlastrec( ::pRes ) - - if ::nRows != 0 - ::nRow := 0 - ::lBeforeFirst := .T. - ::lAfterLast := .F. - endif - - return Self - -method Close() class hdbcPGResultSet - - return nil - -method beforeFirst() class hdbcPGResultSet - - ::nRow := 0 - ::lBeforeFirst := .T. - ::lAfterLast := .F. - - return nil - -method afterLast() class hdbcPGResultSet - - ::nRow := ::nRows + 1 - ::lBeforeFirst := .F. - ::lAfterLast := .T. - - return nil - -method relative( nMove ) class hdbcPGResultSet - - Local nRowNew := ::nRow + nMove - - if nRowNew >= 1 .and. nRowNew <= ::nRows - - ::nRow := nRowNew - ::lBeforeFirst := .F. - ::lAfterLast := .F. - - return .T. - - else - - if nRowNew < 1 - ::nRow := 0 - ::lBeforeFirst := .T. - else - ::nRow := ::nRows + 1 - ::lAfterLast := .T. - endif - - endif - - return .F. - -method absolute( nMove ) class hdbcPGResultSet - - if nMove > 0 - if nMove <= ::nRows - ::nRow := nMove - ::lBeforeFirst := .F. - ::lAfterLast := .F. - return .T. - endif - elseif nMove < 0 - if -nMove <= ::nRows - ::nRow := ::nRows + nMove - ::lBeforeFirst := .F. - ::lAfterLast := .F. - return .T. - endif - endif - - return .F. - -method findColumn( cField ) class hdbcPGResultSet - - return PQFNumber( ::pRes, cField ) - -method getString( nField ) class hdbcPGResultSet - - if ISCHARACTER( nField ) - nField := PQFNumber( ::pRes, nField ) - endif - - return PQgetvalue( ::pRes, ::nRow, nField ) - -method getMetaData() class hdbcPGResultSet - - return hdbcPGResultSetMetaData():new( ::pRes ) - -method moveToInsertRow() class hdbcPGResultSet - - ::nCurrentRow := ::nRow - - ::aBuffer := array( PQnfields( ::pRes ) ) - - return nil - -method moveToCurrentRow() class hdbcPGResultSet - - ::nRow := ::nCurrentRow - - return nil - -method updateBuffer( nField, xValue, cType ) class hdbcPGResultSet - - if ISCHARACTER( nField ) - nField := ::findColumn( nField ) - endif - - if ::aBuffer == nil - ::aBuffer := array( PQnfields( ::pRes ) ) - endif - - ::aBuffer[ nField ] := { xValue, cType } - - return nil - -method insertRow() class hdbcPGResultSet - - local pRes := ::pRes - local aBuffer := ::aBuffer - local cSqlFields - local cSqlValues - local nField - - local nFields := len( aBuffer ) - - if !empty( ::cTableName ) - cSqlFields := "" - cSqlValues := "" - for nField := 1 to nFields - if aBuffer[ nField ] != nil - cSqlFields += "," + PQfname( pRes, nField ) - cSqlValues += "," + iif( aBuffer[ nField ][ 2 ] == "N", aBuffer[ nField ][ 1 ], "'" + aBuffer[ nField ][ 1 ] + "'" ) - endif - next - - pRes := PQexec( ::pDB, "INSERT INTO " + ::cTableName + " (" + substr( cSqlFields, 2 ) + ") VALUES (" + substr( cSqlValues, 2 ) + ")" ) - - if PQresultstatus( pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( pRes ) ) - endif - - PQclear( pRes ) - - else - - raiseError( "Table name is not set" ) - - endif - - ::aBuffer := nil - - return nil - -method updateRow() class hdbcPGResultSet - - local pRes := ::pRes - local aBuffer := ::aBuffer - local aKeys := ::aPrimaryKeys - local nKeys := len( aKeys ) - local cSql - local cSqlWhere - local nField - local nFields := len( aBuffer ) - - if !empty( ::cTableName ) .and. !empty( aKeys ) - cSql := "" - for nField := 1 to nFields - if aBuffer[ nField ] != nil - cSql += "," + PQfname( pRes, nField ) + "=" + iif( aBuffer[ nField ][ 2 ] == "N", aBuffer[ nField ][ 1 ], "'" + aBuffer[ nField ][ 1 ] + "'" ) - endif - next - - cSqlWhere := "" - - for nField := 1 to nKeys - cSqlWhere += "AND " + aKeys[ nField ][ 1 ] + "=" + iif( aKeys[ nField ][ 2 ] == "N", ::getString( aKeys[ nField ][ 1 ] ), "'" + ::getString( aKeys[ nField ][ 1 ] ) + "'" ) - next - - pRes := PQexec( ::pDB, "UPDATE " + ::cTableName + " SET " + substr( cSql, 2 ) + " WHERE " + substr( cSqlWhere, 5 ) ) - - if PQresultstatus( pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( pRes ) ) - endif - - PQclear( pRes ) - - endif - - return nil - -method deleteRow() class hdbcPGResultSet - - local pRes - local aKeys := ::aPrimaryKeys - local nField - local nKeys := len( aKeys ) - local cSqlWhere - - if !empty( ::cTableName ) .and. !empty( aKeys ) - - cSqlWhere := "" - - for nField := 1 to nKeys - cSqlWhere += "AND " + aKeys[ nField ][ 1 ] + "=" + iif( aKeys[ nField ][ 2 ] == "N", ::getString( aKeys[ nField ][ 1 ] ), "'" + ::getString( aKeys[ nField ][ 1 ] ) + "'" ) - next - - pRes := PQexec( ::pDB, "DELETE FROM " + ::cTableName + " WHERE " + substr( cSqlWhere, 5 ) ) - - if PQresultstatus( pRes ) != PGRES_COMMAND_OK - raiseError( PQresultErrormessage( pRes ) ) - endif - - PQclear( pRes ) - - endif - - return nil - -create class hdbcPGResultSetMetaData - - PROTECTED: - - var pRes - - EXPORTED: - - method new( pRes ) - method getColumnCount() - method getColumnName( nColumn ) - method getColumnDisplaySize( nColumn ) - -endclass - -method new( pRes ) class hdbcPGResultSetMetaData - - ::pRes := pRes - - return Self - -method getColumnCount() class hdbcPGResultSetMetaData - - return PQnfields( ::pRes ) - -method getColumnName( nColumn ) class hdbcPGResultSetMetaData - - return PQfname( ::pRes, nColumn ) - -method getColumnDisplaySize( nColumn ) class hdbcPGResultSetMetaData - - return PQfsize( ::pRes, nColumn ) - -create class hdbcPGDatabaseMetaData - - PROTECTED: - - var pDB - - EXPORTED: - - method new( pDB ) - method getTables( cCatalog, cSchema, cTableName, cTableType ) - method getPrimaryKeys( cCatalog, cSchema, cTableName ) - -endclass - -method new( pDB ) class hdbcPGDatabaseMetaData - - ::pDB := pDB - - return Self - -method getTables( cCatalog, cSchema, cTableName, cTableType ) class hdbcPGDatabaseMetaData - - Local n, nTables - Local aTables := {} - Local cSql - Local pRes - - default cCatalog to "" - default cSchema to "public" - default cTableName to "%" - default cTableType to "BASE TABLE" - - cSql := "select table_catalog, table_schema, table_name, table_type from information_schema.tables " - cSql += "where table_schema in ('" + cSchema + "') and table_schema not in ('pg_catalog', 'information_schema')" - cSql += " and table_name ilike '" + cTableName + "'" - cSql += " and table_type in ('" + cTableType + "')" - - pRes := PQexec( ::pDB, cSql ) - - if PQresultstatus( pRes ) != PGRES_TUPLES_OK - raiseError( PQresultErrormessage( pRes ) ) - else - nTables := PQlastrec( pRes ) - for n := 1 to nTables - aadd( aTables, { PQgetvalue( pRes, n, 1 ), PQgetvalue( pRes, n, 2 ), PQgetvalue( pRes, n, 3 ), PQgetvalue( pRes, n, 4 ), "" } ) - next - endif - - PQclear( pRes ) - - return aTables - -method getPrimaryKeys( cCatalog, cSchema, cTableName ) class hdbcPGDatabaseMetaData - - Local pRes - Local cQuery - Local nKeys - Local aKeys - Local n - - default cCatalog to "" - default cSchema to "public" - - cQuery := "SELECT c.attname " - cQuery += " FROM pg_class a, pg_class b, pg_attribute c, pg_index d, pg_namespace e " - cQuery += " WHERE a.oid = d.indrelid " - cQuery += " AND a.relname = '" + cTableName + "'" - cQuery += " AND b.oid = d.indexrelid " - cQuery += " AND c.attrelid = b.oid " - cQuery += " AND d.indisprimary " - cQuery += " AND e.oid = a.relnamespace " - cQuery += " AND e.nspname = '" + cSchema + "'" - - pRes := PQexec( ::pDB, cQuery ) - - nKeys := PQlastrec( pRes ) - - if PQresultstatus( pRes ) == PGRES_TUPLES_OK .and. nKeys != 0 - - aKeys := {} - - for n := 1 To nKeys - aadd( aKeys, PQgetvalue( pRes, n, 1 ) ) - next - - endif - - PQclear( pRes ) - - return aKeys - -static procedure raiseError( cErrMsg ) - - Local oErr - - oErr := ErrorNew() - oErr:severity := ES_ERROR - oErr:genCode := EG_OPEN - oErr:subSystem := "HDBCPG" - oErr:SubCode := 1000 - oErr:Description := cErrMsg - - Eval( ErrorBlock(), oErr ) - - return diff --git a/harbour/contrib/hbziparc/ziparc.prg b/harbour/contrib/hbziparc/ziparc.prg index c6c3646da1..8a7f81575b 100644 --- a/harbour/contrib/hbziparc/ziparc.prg +++ b/harbour/contrib/hbziparc/ziparc.prg @@ -411,11 +411,18 @@ FUNCTION hb_UnzipFile( cFileName, bUpdate, lWithPath, cPassword, cPath, acFiles, LOCAL cExt LOCAL lExtract + LOCAL hHandle + LOCAL nSize + LOCAL nRead + LOCAL nLen + LOCAL dDate + LOCAL cTime + LOCAL cBuffer := Space( t_nReadBuffer ) + DEFAULT lWithPath TO .F. /* TODO: Implement. */ HB_SYMBOL_UNUSED( lWithPath ) - HB_SYMBOL_UNUSED( bProgress ) IF Empty( cPassword ) cPassword := NIL @@ -445,7 +452,8 @@ FUNCTION hb_UnzipFile( cFileName, bUpdate, lWithPath, cPassword, cPath, acFiles, nPos++ - IF hb_UnzipFileInfo( hUnzip, @cZipName ) == 0 + IF hb_UnzipFileInfo( hUnzip, @cZipName, @dDate, @cTime, , , , @nSize ) == 0 + /* NOTE: As opposed to original hbziparch we don't do a second match without path. */ IF !Empty( acFiles ) IF AScan( acFiles, nPos ) > 0 .OR. ; @@ -459,10 +467,19 @@ FUNCTION hb_UnzipFile( cFileName, bUpdate, lWithPath, cPassword, cPath, acFiles, ENDIF IF lExtract + hHandle := FCreate( cPath + cZipName ) + DO WHILE ( nLen := hb_unZipFileRead( hUnzip, @cBuffer, Len( cBuffer ) ) ) > 0 + IF hb_isBlock( bProgress ) + nRead += nLen + Eval( bProgress, nRead, nSize ) + ENDIF + FWrite( hHandle, cBuffer, nLen ) + ENDDO + FClose( hHandle ) + hb_FSetDateTime( cZipName, dDate, cTime ) IF hb_isBlock( bUpdate ) Eval( bUpdate, cZipName, nPos ) ENDIF - hb_UnzipExtractCurrentFile( hUnzip, cPath + cZipName, cPassword ) ENDIF ENDIF