fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2011-10-20 15:21 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2011-10-20 13:22:12 +00:00
parent 040d5b0424
commit f34b6c4190
6 changed files with 43 additions and 783 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
harbour/ChangeLog
View File

@@ -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

5
harbour/contrib/hbmzip/mzip.c
View File

@@ -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

1
harbour/contrib/hbpgsql/hbpgsql.hbp
View File

@@ -33,4 +33,3 @@ postgres.c
rddcopy.c
tpostgre.prg
hdbcpg.prg

6
harbour/contrib/hbpgsql/hbpgsql.hbx
View File

@@ -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

769
harbour/contrib/hbpgsql/hdbcpg.prg
View File

@@ -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

23
harbour/contrib/hbziparc/ziparc.prg
View File

@@ -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