From f34b6c419067ff2f7a494f7b2b9b98b306bf950d Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 20 Oct 2011 13:22:12 +0000 Subject: [PATCH] 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. --- harbour/ChangeLog | 22 + harbour/contrib/hbmzip/mzip.c | 5 +- harbour/contrib/hbpgsql/hbpgsql.hbp | 1 - harbour/contrib/hbpgsql/hbpgsql.hbx | 6 - harbour/contrib/hbpgsql/hdbcpg.prg | 769 ---------------------------- harbour/contrib/hbziparc/ziparc.prg | 23 +- 6 files changed, 43 insertions(+), 783 deletions(-) delete mode 100644 harbour/contrib/hbpgsql/hdbcpg.prg 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