xBackupLite

xBackupLite

Postby juan_arroyo_t » Mon Oct 01, 2018 6:24 pm

Por favor si alguien pudiera ayudarme

Estoy tratando de compilar xBackuLite y no lo consigo

imagen de proyecto
https://1drv.ms/u/s!AgM94kAKnz9CkVTHXK_l2lYzns9A

consola de depuracion
https://1drv.ms/u/s!AgM94kAKnz9CkVWX8bdy-4Oyg-Tr

Codigo de entorno de xmate
Code: Select all  Expand view

[Environment]
Description 1=Xharbour 1.2.1 y FWH 13.01
Description 2=
Description 3=
PRG Compiler ver=1.2.1
C compiler ver=5.82
Subsystem=
Author=
Last update=10/06/2011

[Advanced]
Command types=1,1,1,1,1,1,1,1,1

[Harbour]
HB_INSTALL=p:\32bits\13.01\xHarbour
HB_COMMAND=%HB_BIN_INSTALL%\Harbour.Exe %PRG% /m /n /es2 /i%HB_INC_INSTALL%
Option prefix=/

[C]
C_INSTALL=p:\32bits\Borland\bcc582
C_COMP_COMMAND=%C_BIN_INSTALL%\Bcc32.Exe -M -c -v -O2 -I%HB_INC_INSTALL% -I%C_INC_INSTALL%  -n%HOME%\Obj %C%
C_LIB_COMMAND=%C_BIN_INSTALL%\TLib.Exe %LIB% /P512 @%RSP% , %LST%
C_LINK_COMMAND=%C_BIN_INSTALL%\iLink32.Exe -Gn -aa -Tpe -s -v @%LNK%
C_RC_COMMAND=%C_BIN_INSTALL%\Brc32.Exe -r  -fo%RES%  %RC%
C_DLL_COMMAND=
Option prefix=-

[User]
POSTEXE_COMMAND=
POSTLIB_COMMAND=
POSTDLL_COMMAND=

[Files]
%C_LIB_INSTALL%\C0W32.OBJ=1
P:\32bits\13.01\FWH\lib\Fivehx.lib=2
P:\32bits\13.01\FWH\lib\Fivehc.lib=3
%HB_LIB_INSTALL%\rtl.lib=4
%HB_LIB_INSTALL%\vm.lib=5
%HB_LIB_INSTALL%\gtgui.lib=6
%HB_LIB_INSTALL%\lang.lib=7
%HB_LIB_INSTALL%\macro.lib=8
%HB_LIB_INSTALL%\rdd.lib=9
%HB_LIB_INSTALL%\dbfcdx.lib=10
%HB_LIB_INSTALL%\dbfntx.lib=11
%HB_LIB_INSTALL%\dbffpt.lib=12
%HB_LIB_INSTALL%\hbsix.lib=13
%HB_LIB_INSTALL%\common.lib=14
%HB_LIB_INSTALL%\pp.lib=15
%HB_LIB_INSTALL%\pcrepos.lib=16
%C_LIB_INSTALL%\cw32.lib=17
%C_LIB_INSTALL%\import32.lib=18
%C_LIB_INSTALL%\uuid.lib=19
%C_LIB_INSTALL%\PSDK\odbc32.lib=20
%C_LIB_INSTALL%\PSDK\rasapi32.lib=21
%C_LIB_INSTALL%\PSDK\iphlpapi.lib=22
%C_LIB_INSTALL%\PSDK\msimg32.lib=23
%C_LIB_INSTALL%\PSDK\nddeapi.lib=24
%HB_LIB_INSTALL%\ct.lib=25
%C_LIB_INSTALL%\PSDK\psapi.lib=26
%HB_LIB_INSTALL%\codepage.lib=27


[DLL Files]
%C_LIB_INSTALL%\C0W32.OBJ=1
%HB_LIB_INSTALL%\rtl.lib=2
%HB_LIB_INSTALL%\vm.lib=3
%HB_LIB_INSTALL%\gtgui.lib=4
%HB_LIB_INSTALL%\lang.lib=5
%HB_LIB_INSTALL%\macro.lib=6
%HB_LIB_INSTALL%\rdd.lib=7
%HB_LIB_INSTALL%\dbfntx.lib=8
%HB_LIB_INSTALL%\dbfcdx.lib=9
%HB_LIB_INSTALL%\dbfdbt.lib=10
%HB_LIB_INSTALL%\common.lib=11
%HB_LIB_INSTALL%\ct.lib=12
%HB_LIB_INSTALL%\pp.lib=13
%C_LIB_INSTALL%\CW32.LIB=14
%C_LIB_INSTALL%\IMPORT32.LIB=15
 


xblite.prg
Code: Select all  Expand view
/*-----------------------------------------------------------------------
Fichero : xBLite.prg
Proyecto: XBackupLite (utilidad de compresion para datos de aplicaicones)
Objetivo: Prueba del poder del compilador xHarbour
Fecha   : 2004.03.06
-----------------------------------------------------------------------*/

#include "xblite.ch"
#include "tsbrowse.ch"

#define PAGE1   oFolder:aDialogs[ 1 ]
#define PAGE2   oFolder:aDialogs[ 2 ]
#define PAGE3   oFolder:aDialogs[ 3 ]

/*Procedimiento principal*/
/*PROCEDURE Main
    xblite()   //XBackupLite()
RETURN*/


/**/
FUNCTION xblite() //XBackupLite()
    LOCAL oIcon
    LOCAL oFont
    LOCAL oFontT
    LOCAL oDlg
    LOCAL oFolder
    LOCAL oBrowseZip
    LOCAL oBrowseUnZip

    /*variables de seccion zip*/
    PRIVATE oFolderSourceZip, cFolderSourceZip
    PRIVATE oGetFolderSourceZip
    PRIVATE oIncludeSubFolder, lIncludeSubFolder
    PRIVATE oZipToFloppy, lZipToFloppy
    PRIVATE oFolderTargetZip, cFolderTargetZip
    PRIVATE oGetFolderTargetZip
    PRIVATE oFilesCountZip, nFilesZipped, nTotalFilesToZip
    PRIVATE nSizeFilesToZip
    PRIVATE oDoCompress
    PRIVATE acFilesToZip   := { { "", 0, ctod(""), "" } }

    /*variables de seccion unzip*/
    PRIVATE oSourceUnZip, cSourceUnZip
    PRIVATE oGetSourceUnZip
    PRIVATE oUnZipWithPath, lUnZipWithPath
    PRIVATE oGetFolderTargetUnZip
    PRIVATE oFolderTargetUnZip, cFolderTargetUnZip
    PRIVATE oFilesCountUnZip, nFilesUnZipped, nTotalFilesToUnZip
    PRIVATE nSizeFilesToUnZip,nSizeFilesToUnZipC
    PRIVATE oDoUnCompress
    PRIVATE acFilesToUnZip := { { "", 0, 0, ctod(""),  "" } }

    /*valores inciaiales de seccion zip*/
    cFolderSourceZip    := ""
    cFolderTargetZip    := ""
    lIncludeSubFolder   := FALSE
    lZipToFloppy        := FALSE
    nTotalFilesToZip    := 0
    nSizeFilesToZip     := 0

    /*valores inciaiales de seccion unzip*/
    cSourceUnZip        := ""
    cFolderTargetUnZip  := ""
    lUnZipWhitPath      := TRUE
    nTotalFilesToUnZip  := 0
    nSizeFilesToUnZip   := 0
    nSizeFilesToUnZipC  := 0

    /*definiciones de objetos icon y font*/
    DEFINE FONT oFont  NAME GetSysFont() SIZE 0,-11
    DEFINE FONT oFontT NAME GetSysFont() SIZE 0,-16 BOLD
    DEFINE ICON oIcon NAME "XBACKUPLITE"

    /*definicion de dialogo*/
    DEFINE DIALOG oDlg NAME "XBACKUPLITE" TITLE "xBackup Lite - xHarbour Power" FONT oFont ICON oIcon

    /*logotipo del programa*/
    REDEFINE BITMAP ;
        ID 101 OF oDlg;
        NAME "xbl_logo";
        ADJUST

    /*redefinicion de folder con 2 paginas*/
    REDEFINE FOLDER oFolder;
        ID 102 OF oDlg;
        ITEMS   "Res&paldar","Res&taurar","&Acerca de";
        DIALOGS "PageBackup","PageRestore","PageAbout"

    /*redefinicion de controles de pagina #1*/
    REDEFINE GET oFolderSourceZip;
        VAR cFolderSourceZip;
        ID 101 OF PAGE1;
        READONLY

    REDEFINE BUTTON oGetFolderSourceZip;
        ID 102 OF PAGE1;
        ACTION GetDirToZip( oBrowseZip )

    REDEFINE CHECKBOX oIncludeSubFolder;
        VAR lIncludeSubFolder;
        ID 103 OF PAGE1;
        ON CHANGE GetFilesToZip( cFolderSourceZip, oBrowseZip )

    REDEFINE BROWSE oBrowseZip ;
        ID 104 OF PAGE1 FONT oFont;
        COLOR CLR_BLACK, CLR_YELLOW01

        oBrowseZip:SetArray( acFilesToZip )

        ADD COLUMN TO oBrowseZip ARRAY ELEMENT 1;
            TITLE "Nombre" SIZE 140;
            FOOTER { || transform( nTotalFilesToZip, "99,999 Archivos" ) }

        ADD COLUMN TO oBrowseZip ARRAY ELEMENT 2;
            TITLE "Tamaño" ;
            SIZE 100;
            PICTURE "9,999,999.99 Kb";
            FOOTER { || transform( nSizeFilesToZip, "9,999,999.99 Kb" ) };
            ALIGN DT_RIGHT

        ADD COLUMN TO oBrowseZip ARRAY ELEMENT 3;
            TITLE "Fecha" SIZE 70;
            ALIGN DT_CENTER

        ADD COLUMN TO oBrowseZip ARRAY ELEMENT 4;
            TITLE "Ruta" SIZE 180

        /*propiedades de objeto browse*/
        WITH OBJECT oBrowseZip
            :nFreeze     := 1
            :lNoVScroll  := .F.
            :nHeightHead := 18
            :nHeightCell := 18
            :nHeightFoot := 18
            :SetColor( { CLR_HEADF, CLR_FOOTF }, { {|| CLR_BLUE }, {|| CLR_RED } } )
        END WITH

    REDEFINE CHECKBOX oZipToFloppy;
        VAR lZipToFloppy;
        ID 105 OF PAGE1;
        ON CHANGE ( cFolderTargetZip := "", oFolderTargetZip:Refresh() )

    REDEFINE GET oFolderTargetZip;
        VAR cFolderTargetZip;
        ID 106 OF PAGE1;
        READONLY

    REDEFINE BUTTON oGetFolderTargetZip;
        ID 107 OF PAGE1;
        ACTION SetFileZip()

    oFilesCountZip := TProgress():Redefine( 108, PAGE1 )

    REDEFINE BUTTON oDoCompress;
        ID 109 OF PAGE1;
        ACTION DoMakeZip()

    /*redefinicion de controles de pagina #2*/
    REDEFINE GET oSourceUnZip;
        VAR cSourceUnZip;
        ID 101 OF PAGE2;
        READONLY

    REDEFINE BUTTON oGetSourceUnZip;
        ID 102 OF PAGE2;
        ACTION GetFileToUnZip( oBrowseUnZip )

    REDEFINE BROWSE oBrowseUnZip ;
        ID 103 OF PAGE2 FONT oFont;
        COLOR CLR_BLACK, CLR_YELLOW01

        oBrowseUnZip:SetArray( acFilesToUnZip )

        ADD COLUMN TO oBrowseUnZip ARRAY ELEMENT 1;
            TITLE "Nombre" SIZE 140;
            FOOTER { || transform( nTotalFilesToUnZip, "99,999 Archivos" ) }

        ADD COLUMN TO oBrowseUnZip ARRAY ELEMENT 2;
            TITLE "Tamaño Normal" ;
            SIZE 100;
            PICTURE "9,999,999.99 Kb";
            FOOTER { || transform( nSizeFilesToUnZip, "9,999,999.99 Kb" ) };
            ALIGN DT_RIGHT

        ADD COLUMN TO oBrowseUnZip ARRAY ELEMENT 3;
            TITLE "Tamaño Comp." ;
            SIZE 100;
            PICTURE "9,999,999.99 Kb";
            FOOTER { || transform( nSizeFilesToUnZipC, "9,999,999.99 Kb" ) };
            ALIGN DT_RIGHT

        ADD COLUMN TO oBrowseUnZip ARRAY ELEMENT 4;
            TITLE "Fecha" SIZE 70;
            ALIGN DT_CENTER

        ADD COLUMN TO oBrowseUnZip ARRAY ELEMENT 5;
            TITLE "Ruta" SIZE 180

        /*propiedades de objeto browse*/
        WITH OBJECT oBrowseUnZip
            :nFreeze     := 1
            :lNoVScroll  := .F.
            :nHeightHead := 18
            :nHeightCell := 18
            :nHeightFoot := 18
            :SetColor( { CLR_HEADF, CLR_FOOTF }, { {|| CLR_BLUE }, {|| CLR_RED } } )
        END WITH

    REDEFINE CHECKBOX oUnZipWithPath;
        VAR lUnZipWithPath;
        ID 104 OF PAGE2

    REDEFINE GET oFolderTargetUnZip;
        VAR cFolderTargetUnZip;
        ID 105 OF PAGE2;
        READONLY

    REDEFINE BUTTON oGetFolderTargetUnZip;
        ID 106 OF PAGE2;
        ACTION SetFolderUnZip()

    oFilesCountUnZip := TProgress():Redefine( 107, PAGE2 )

    REDEFINE BUTTON oDoUnCompress;
        ID 108 OF PAGE2;
        ACTION DoMakeUnZip()

    /*redefinicion de controles de pagina #3*/
    REDEFINE SAY ;
        ID 101 OF PAGE3 FONT oFontT COLOR CLR_BLUE

    REDEFINE SAY ;
        ID 102 OF PAGE3 FONT oFontT COLOR CLR_BLUE

    REDEFINE SAY ;
        ID 103 OF PAGE3 FONT oFontT COLOR CLR_BLUE

    REDEFINE SAY ;
        ID 104 OF PAGE3 FONT oFontT COLOR CLR_BLUE

    /*boton de cierre de dialogo*/
    REDEFINE BUTTON oClose;
        ID 103 OF oDlg;
        ACTION oDlg:END()

    /*activacion de dialogo*/
    ACTIVATE DIALOG oDlg CENTER

    /*eilminacion de font usadas*/
    oFont:END()
    oFontT:END()

RETURN  /*Fin*/


PROCEDURE GetDirToZip( oBrowseZip )
    LOCAL cDir := ""
    LOCAL cFiles

    /*solicita directorio origen de ficheros a respaldas*/
    cDir := cGetDir( "Seleccione el directorio de datos a respaldar" )

    /*si se selecciono un directorio*/
    IF !empty( cDir )

        /*obtiene los ficheros a respaldar*/
        GetFilesToZip( cDir, oBrowseZip )

        /*actualiza nombre de directorio fuente*/
        cFolderSourceZip := cDir
        oFolderSourceZip:refresh()

    ENDIF

RETURN

PROCEDURE GetFilesToZip( cDir, oBrowseZip )
    LOCAL aFile
    LOCAL aFiles
    LOCAL nFiles

    /*verifica si se paso el nombre de directorio fuente*/
    IF empty( cDir )
        RETURN
    ENDIF

    /*verifica si se procesaran los subdirectorios, y se obtiene un arreglo on los ficheros a respaldar*/
    IF !lIncludeSubFolder
        aFiles := directory( cDir + "\*.*",,, XBL_FILEWITHPATH )

    ELSE
        aFiles := directoryrecurse( cDir + "\*.*",, XBL_FILEWITHPATH )

    ENDIF

    /*si se obtivo algun fichero a respaldar*/
    nFiles := len( aFiles )
    IF nFiles > 0

        /*asigna el numero de ficheros a respaldar a la var del control meter*/
        nTotalFilesToZip := nFiles
        nFilesZipped     := 0

        /*inicializa arreglo de ficheros y procesa cada uno, acumulando su tamaño*/
        acFilesToZip := {}
        FOR EACH aFile IN aFiles
            aadd( acFilesToZip, { cFileName( aFile[ F_NAME ] )  ,;
                                  aFile[ F_SIZE ] / 1024        ,;
                                  aFile[ F_DATE ]               ,;
                                  cFilePath( aFile[ F_NAME ] )  })

            /*acumula total de tamaños de archivos*/
            nSizeFilesToZip += aFile[ F_SIZE ]

        NEXT

        /*se obtiene la suma de los tamaños de ficheros a respaldar en KB*/
        nSizeFilesToZip /= 1024

    ELSE

        /*por defecto un elemento en el arreglo para que no de problemas el browse*/
        acFilesToZip     := { {"", 0, ctod(""), "" } }
        nSizeFilesToZip  := 0
        nTotalFilesToZip := 0

    ENDIF

    /*pasa el arreglo al browse*/
    oBrowseZip:SetArray( acFilesToZip )
    oBrowseZip:refresh( TRUE )
    oBrowseZip:SetFocus()

    /*limpia arreglo y llama al colecor de basura de xharbour*/
    aFiles := nil
    hb_gcAll()

RETURN

PROCEDURE SetFileZip()
    LOCAL cFile := ""

    /*si fichero de respaldo estara en disco duro y no en floppy*/
    IF !lZipToFloppy
        /*solicita el nombre con la unidad destino incluido*/
        cFile := cGetFile( "ZipFile   | *.zip", "Nombre de archivo de respaldo en Disco Duro", 1, "c:\", XBL_SAVEFILE, XBL_WITHLONGNAME )
        cFile := rtrim( cFile )

        /*agrega la extencion ZIP de ser necesario*/
        IF empty( cFileExt( cFile ) )
            cFile += "
.zip"
        ENDIF

    ELSE
        /*solo pide nombre de archivo*/
        cFile := space(25)
        lOk := BoxGet( "
Introdusca dato", "Nombre del fichero de respaldo en unidad de diskette <A>", @cFile )

        /*agrega al nombre de fichero de respaldo la unidad*/
        IF lOk
            /*TODO: establecer posible malas entradas por parte del usuario*/
            /*agrega unidad de diskette A al nombre de fichero dado, y de ser necesario*/
            cFile := "
A:\" + rtrim( cFile )

            /*agrega la extencion ZIP de ser necesario*/
            IF empty( cFileExt( cFile ) )
                cFile += "
.zip"
            ENDIF

        ENDIF

    ENDIF

    /*actualiza nombre de directorio fuente*/
    cFolderTargetZip := cFile
    oFolderTargetZip:refresh()

RETURN

PROCEDURE DoMakeZip()
    LOCAL lOkZip        := FALSE
    LOCAL acFiles       := {}
    LOCAL bOnZipFile    := { |cFile, nFile| UpdateMeterZip( nFile ) }
    LOCAL bOnSetDiskZip := { |nDisk| MsgInfo( "
Por favor inserte el disco # " + str( nDisk,,, XBL_TRIM ) ) }

    /*verifica que existan ficheros a respaldar y el nombre del fichero de respaldo se haya definido*/
    IF empty( cFolderSourceZip ) .or. empty( cFolderTargetZip ) .or. ( len( acFilesToZip ) = 1 .and. acFilesToZip[1,1] = "
" )
        MsgStop( "
Error, debe definir un nombre para fichero de respaldo, y al menos un fichero a respaldar!")
        RETURN
    ENDIF

    /*se extra solo el nombre de los ficheros a respaldar incuyendo su path*/
    aeval( acFilesToZip, { | aFile | aadd( acFiles, aFile[ XBL_FILEPATH ] + aFile[ XBL_FILENAME ] ) } )

    /*establece limites de valores de control meter*/
    oFilesCountZip:SetRange( 0, nTotalFilesToZip )
    oFilesCountZip:SetPos( 0 )

    /*desactiva botones*/
    oGetFolderSourceZip:disable()
    oGetFolderTargetZip:disable()
    oDoCompress:disable()
    oClose:disable()

    /*realiza la compresion de los ficheros*/
    IF lZipToFloppy
        hb_SetDiskZip( bOnSetDiskZip )
        lOkZip := hb_ZipFileByPKSpan( cFolderTargetZip  ,;
                                      acFiles           ,;
                                      HBL_ZIPLEVEL      ,;
                                      bOnZipFile        ,;
                                      XBL_ZIPOVERWRITE  ,;
                                      NIL               ,;
                                      XBL_ZIPWITHPATH    )
    ELSE
        hb_SetDiskZip( {|| NIL } )
        lOkZip := hb_ZipFile( cFolderTargetZip  ,;
                              acFiles           ,;
                              HBL_ZIPLEVEL      ,;
                              bOnZipFile        ,;
                              XBL_ZIPOVERWRITE  ,;
                              NIL               ,;
                              XBL_ZIPWITHPATH    )
    ENDIF

    /*verifica proceso e informa al usuario*/
    IF lOkZip
        MsgInfo("
La creación del fichero de respaldo fue exitosa!!!")
    ELSE
        MsgStop("
La creación del fichero de respaldo fallo!!!")
    ENDIF

    /*activa botones*/
    oGetFolderSourceZip:enable()
    oGetFolderTargetZip:enable()
    oDoCompress:enable()
    oClose:enable()

    /*reinicia contador de meter*/
    oFilesCountZip:SetPos( 0 )
    oFilesCountZip:refresh()

    /*limpia arreglo y llama al colecor de basura de xharbour*/
    acFiles := NIL
    hb_gcAll()

RETURN

PROCEDURE UpdateMeterZip( nFile )

    /*refresca sistema cada 10 ficheros procesados*/
    IF nFile % 10 = 0
        SysRefresh()
    ENDIF

    oFilesCountZip:SetPos( nFile )

RETURN

PROCEDURE GetFileToUnZip( oBrowseUnZip )
    LOCAL cFile

    /*pide al usuario que seleccione el fichero de respaldo*/
    cFile := cGetFile( "
ZipFile   | *.zip", "Nombre de archivo de respaldo a restaurar", 1, "c:\", XBL_OPENFILE, XBL_WITHLONGNAME )

    /*verifica si realmente se paso el fichero*/
    IF !empty( cFile )

        /*muestra el nombre del fichero en el dialogo*/
        cSourceUnZip := cFile
        oSourceUnZip:refresh()

        /*extrae informacion del fuchero de respaldo*/
        GetFilesFromZip( cFile, oBrowseUnZip )

    ENDIF

RETURN

PROCEDURE GetFilesFromZip( cFile, oBrowseUnZip )
    LOCAL aFiles := hb_GetFilesInZip( cFile, XBL_GETFULL_INFOZIP )
    LOCAL aFile

    /*vereficia el valor retornado por la funcion, si es arreglo y si tiene elementos*/
    IF valtype( aFiles ) = "
A" .and. len( aFiles ) > 0

        /*inicializa arreglo en cero*/
        acFilesToUnZip := {}
        nTotalFilesToUnZip := len( aFiles )

        /*procesa cada fichero extrayendo la informacion que interesa*/
        FOR EACH aFile IN aFiles
            aadd( acFilesToUnZip, { cFileName( aFile[ XBL_IZNAME ] )    ,;
                                    aFile[ XBL_IZSIZEN ] / 1024         ,;
                                    aFile[ XBL_IZSIZEC ] / 1024         ,;
                                    aFile[ XBL_IZDATE ]                 ,;
                                    cFilePath( aFile[ XBL_IZNAME ] )    })

            /*acumula totales de tamaños de archivos - normal y comprimido*/
            nSizeFilesToUnZip  += aFile[ XBL_IZSIZEN ]
            nSizeFilesToUnZipC += aFile[ XBL_IZSIZEC ]

        NEXT

        /*obtiene los totales en Kb*/
        nSizeFilesToUnZip  /= 1024
        nSizeFilesToUnZipC /= 1024

    ENDIF

    /*pasa el arreglo al browse*/
    oBrowseUnZip:SetArray( acFilesToUnZip )
    oBrowseUnZip:refresh( TRUE )
    oBrowseUnZip:SetFocus()

    /*limpia arreglo y llama al colecor de basura de xharbour*/
    aFiles := nil
    hb_gcAll()

RETURN

PROCEDURE SetFolderUnZip()
    LOCAL cDir := "
"

    /*pide al usuario de el directorio destino de los datos*/
    cDir := cGetDir( "
Seleccione el directorio donde se restauraran los ficheros respaldados" )

    /*verifica si se selecciono un directorio*/
    IF empty( cDir )
        MsgStop( "
Error, defina un directorio destino de datos!" )
        RETURN

    ELSE
        /*muestra el nombre del directorio seleccionado*/
        cFolderTargetUnZip := cDir
        oFolderTargetUnZip:refresh()

    ENDIF

RETURN

PROCEDURE DoMakeUnZip()
    LOCAL lOkUnZip      := FALSE
    LOCAL acFiles       := {}
    LOCAL bOnUnZipFile  := { |cFile, nPos| UpdateMeterUnZip( cFile, nPos ) }
    LOCAL bOnSetDiskZip := { |nDisk| MsgInfo( "
Por favor inserte el disco # " + str( nDisk,,, XBL_TRIM ) ) }

    /*verifica que existan ficheros a respaldar y el nombre del fichero de respaldo se haya definido*/
    IF empty( cSourceUnZip ) .or. empty( cFolderTargetUnZip ) .or. ( len( acFilesToUnZip ) = 1 .and. acFilesToUnZip[1,1] = "
" )
        MsgStop( "
Error, debe definir un fichero de respaldo valido y un directorio destino!")
        RETURN
    ENDIF

    /*se extra solo el nombre de los ficheros a respaldar incuyendo su path*/
    aeval( acFilesToUnZip, { | aFile | aadd( acFiles, aFile[ XBL_UZFILEPATH ] + aFile[ XBL_UZFILENAME ] ) } )

    /*establece limites de valores de control meter*/
    oFilesCountUnZip:SetRange( 0, nTotalFilesToUnZip )
    oFilesCountUnZip:SetPos( 0 )

    /*desactiva botones*/
    oGetSourceUnZip:disable()
    oGetFolderTargetUnZip:disable()
    oDoUnCompress:disable()
    oClose:disable()

    /*realiza la compresion de los ficheros*/
    hb_SetDiskZip( bOnSetDiskZip )
    lOkUnZip := hb_UnZipFile( cSourceUnZip      ,;
                              bOnUnZipFile      ,;
                              lUnZipWithPath    ,;
                              NIL               ,;
                              cFolderTargetUnZip + "
\" )

    /*verifica proceso e informa al usuario*/
    IF lOkUnZip
        MsgInfo("
La creación del fichero de respaldo fue exitosa!!!")
    ELSE
        MsgStop("
La creación del fichero de respaldo fallo!!!")
    ENDIF

    /*activa botones*/
    oGetSourceUnZip:enable()
    oGetFolderTargetUnZip:enable()
    oDoUnCompress:enable()
    oClose:enable()

    /*reinicia contador de meter*/
    oFilesCountUnZip:SetPos( 0 )
    oFilesCountUnZip:refresh()

    /*limpia arreglo y llama al colecor de basura de xharbour*/
    acFiles := NIL
    hb_gcAll()

RETURN

PROCEDURE UpdateMeterUnZip( cFile, nPos )
    #ifdef BUG_IN_HBZIP

    STATIC n := 0

    IF n > nTotalFilesToUnZip
        n := 0
    ENDIF

    ++n
    IF n % 10 = 0
        SysRefresh()
    ENDIF

    oFilesCountUnZip:SetPos( n )

    #else

    oFilesCountUnZip:SetPos( nPos )

    #endif

RETURN

FUNCTION loadmsg()
   RETURN nil


boxget.prg
Code: Select all  Expand view
/*-----------------------------------------------------------------------
Fichero : BoxGet.prg
Proyecto: XBackupLite (utilidad de compresion para datos de aplicaicones)
Objetivo: Prueba del poder del compilador xHarbour
Fecha   : 2004.03.06
-----------------------------------------------------------------------*/

#include "xblite.ch"

FUNCTION BoxGet( cTitle, cText, uVar, cPicture, oWnd )
    LOCAL oDlgBG,;
          oGet  ,;
          oSay

    LOCAL uTemp := uVar
    LOCAL lOk   := .f.

    DEFAULT cText := "",;
            cTitle:= "Buscar",;
            oWnd := GetWndDefault(),;
            cPicture := "@X"

    DEFINE DIALOG oDlgBG NAME "DlgBoxGet" OF oWnd TITLE cTitle

    REDEFINE SAY oSay PROMPT cText;
        ID 101 OF oDlgBG UPDATE COLOR CLR_BLUE

    REDEFINE GET oGet VAR uTemp;
        ID 102 OF oDlgBG ;
        PICTURE cPicture;
        UPDATE

    REDEFINE BUTTON ;
        ID 201 OF oDlgBG ;
        ACTION ( oDlgBG:End(), lOk := .t. ) DEFAULT

    REDEFINE BUTTON ;
        ID 202 OF oDlgBG ;
        ACTION ( oDlgBG:End(), lOk := .f. )

    ACTIVATE DIALOG oDlgBG CENTERED ON INIT oSay:refresh()

    IF lOk
        uVar := uTemp
    ENDIF

RETURN lOk

FUNCTION KDSDebug( xVal )
    OutPutDebugStringC( "Debug : " + cValtoChar( xVal ) )
RETURN NIL

#pragma BEGINDUMP

#include <windows.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"

HB_FUNC( OUTPUTDEBUGSTRINGC )
{
    PHB_ITEM szMsg = hb_param(1, HB_IT_STRING );

    if( szMsg != NULL )
    {
        OutputDebugStringA( hb_itemGetC( szMsg ) );
    }
}

#pragma ENDDUMP
 


Estoy suponiendo que me falta alguna lib en el archivo de entorno

De antemano muchas gracias

Saludos
Juan Arroyo
México
FWH 7.12 VERCE 5.3 xHarbour 1.1.0
juan_arroyo_t@hotmail.com
User avatar
juan_arroyo_t
 
Posts: 196
Joined: Fri May 15, 2009 1:25 am
Location: Cuautitlán, Mexico

Re: xBackupLite

Postby Armando » Mon Oct 01, 2018 6:35 pm

Juan:

Preguntonta, y para que necesitas xBackupLite?

Saludos
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
User avatar
Armando
 
Posts: 3201
Joined: Fri Oct 07, 2005 8:20 pm
Location: Toluca, México

Re: xBackupLite

Postby juan_arroyo_t » Mon Oct 01, 2018 7:21 pm

Armando

Preguntonta, y para que necesitas xBackupLite?


Estoy utilizando esta aplicacion para hacer respaldo y restuaracion de archivos pero lo tengo como un exe adicional que ocupa mas o menos 1160 kb

La intencion es ver si lo puedo incorporar como un prg mas a mis aplicaciones

Saludos
Juan Arroyo
México
FWH 7.12 VERCE 5.3 xHarbour 1.1.0
juan_arroyo_t@hotmail.com
User avatar
juan_arroyo_t
 
Posts: 196
Joined: Fri May 15, 2009 1:25 am
Location: Cuautitlán, Mexico

Re: xBackupLite

Postby karinha » Mon Oct 01, 2018 8:06 pm

No falta incorporar la TsBrowse() del maestro Manuel Mercado?

http://www.pctoledo.com.br/forum/viewtopic.php?f=2&t=16893&start=0&hilit=blite

Saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xBackupLite

Postby karinha » Mon Oct 01, 2018 8:09 pm

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xBackupLite

Postby juan_arroyo_t » Tue Oct 02, 2018 2:31 am

Karinha

Gracias por responder

Probé el pBackup y se ma hace muy bueno

Quise respaldar los archivos de una carpeta con unas subcarpetas pero no encontré la manera de que esas subcarpetas no las incluyera en el respaldo

Saludos
Juan Arroyo
México
FWH 7.12 VERCE 5.3 xHarbour 1.1.0
juan_arroyo_t@hotmail.com
User avatar
juan_arroyo_t
 
Posts: 196
Joined: Fri May 15, 2009 1:25 am
Location: Cuautitlán, Mexico

Re: xBackupLite

Postby karinha » Tue Oct 02, 2018 1:25 pm

Intenta asi:

Code: Select all  Expand view

   #IFDEF __XHARBOUR__

      // if xHarbour
      aFiles := DirectoryRecurse( cSourceZip + "\*.*",, .F. )

   #ELSE

      // if harbour
      aFiles := DirectoryRecurse( cSourceZip + "*",, .F. )

   #ENDIF
 


Saludos
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xBackupLite

Postby juan_arroyo_t » Thu Oct 04, 2018 1:09 pm

Karinha

#IFDEF __XHARBOUR__

// if xHarbour
aFiles := DirectoryRecurse( cSourceZip + "\*.*",, .F. )

#ELSE

// if harbour
aFiles := DirectoryRecurse( cSourceZip + "*",, .F. )

#ENDIF


Disculpa mi ignorancia

Ya logré compilar xbackup con xharbour

Te comento
Quiero respaldar una carpeta cuya estructura es esta

Carpeta
Subcarpeta
Subcarpeta
archivo
archivo
-------
-------
archivo

Solo quiero respaldar archivos, no incluir las Subcarpetas

Este es el codigo de pbackup
Code: Select all  Expand view
/*---------------------------------------------------------------------------------------*/
*        Archivo: pBackup.PRG                                                            *
*    Descripcion: Programa para Backup y Restores de copias de seguridad para            *
*                 formatos de fichero ZIP en nuestros programas.                         *
*          Fecha: 25-01-2012                                                             *
*          Autor: Jose Javier LLoris Roig                                                *
*            Web: http://javierlloris.blogspot.com.es/                                   *
*            Msn: fwh-jll@hotmail.es                                                     *
*                                                                                        *
*            Libreria: FWH/FWHX 11.09                                                    *
*             Harbour: Harbour 5.8.2 release 20120330                                    *
*          Compilador: Borland C++ 5.8.2                                                 *
*                 S.O: Windows                                                           *
*                                                                                        *
*  Los fuentes Harbour para el control de ZIP estan en:                                  *
*  C:\Compra FWH1108-FWH1109-fwh1110\Harbour 3.0 Fuentes\harbour-3.0.0\contrib\hbziparc  *
*
/*---------------------------------------------------------------------------------------*/
*  Modificado em: 28/03/2017 Para FWHX 17.01 - Jan. 2017
*  xHarbour 1.2.3 Intl. (SimpLex) (Build 20170215) -> Para BCC72
*  Compilador: Borland C++ 7.2 - Joao Santos - kapiabafwh@gmail.com
/*---------------------------------------------------------------------------------------*/

#Include "FiveWin.ch"

#Define CLR_MENTA      nRGB(221,255,238)     //-> Cor de Menta
#Define CLR_HMENTA     nRGB(000,128,000)     //-> Cor de Menta Light
#Define CLR_SOFTYELLOW RGB(255,251,225)

STATIC oWnd
STATIC cWebBlog
STATIC cMsn
STATIC cTitle
STATIC cAutor
STATIC lExit

/*------------------------------------------------------------------------------*/
Function Main()
/*------------------------------------------------------------------------------*/

   LOCAL cFolder := StrCapFirst( cFilePath( GetModuleFileName( GetInstance() ) ) + "Backup" )
   LOCAL hDLL    := LoadLibrary( "Bwcc32.dll" )

   REQUEST HB_LANG_ES
   HB_LANGSELECT("ES")

   SET CONFIRM ON
   SET DELETE ON
   SET _3DLOOK ON
   SET UNIQUE OFF
   SET DATE FORMAT TO "DD-MM-YYYY"
   SET MULTIPLE ON

   IF ISEXERUNNING( CFILENAME( HB_ARGV( 0 ) ) )
      __Quit()
   ENDIF

   BWCCRegister( GetResources() )

   /* Activamos los mensajes tooltip en forma de balon */
   SetBalloon( .T. )

   SkinButtons()     // Botoes Coloridos

   SetGetColorFocus( CLR_MENTA )

   tGet():lDisColors  := .F.
   tGet():nClrTextDis := CLR_HBLUE
   tGet():nClrPaneDis := CLR_SOFTYELLOW

   /* Sino existe la carpeta Backup, la creamos */
   IF !lIsDir( cFolder )
      lMkDir( "Backup" )
   END

   cWebBlog  := "http://javierlloris.blogspot.com.es/"
   cTitle    := "pBackup versión 2.0"
   cAutor    := "José Javier Lloris Roig, 2012"
   cMsn      := "fwh-jll@hotmail.es"
   lExit     := .F.

   BWCCRegister( GetResources() )

   MainOpenWnd() // Abertura da janela(window)

   FreeResources()
   FreeLibrary( hDLL )

Return NIL
/*------------------------------------------------------------------------------*/
STATIC Function MainOpenWnd()
/*------------------------------------------------------------------------------*/

   LOCAL oIcon, oMenu, oBmp

   DEFINE ICON oIcon RESOURCE "Icono"
   DEFINE BITMAP oBmp FILENAME "Aranha.bmp"

   oMenu := FrameMenu()

   DEFINE WINDOW oWnd FROM 0, 0 TO 40, 90;
          COLOR nRGB( 51,51,51 ), nRGB( 51,51,51 );
          MENU oMenu TITLE cTitle;
          ICON  oIcon;
          BORDER NONE NOMAXIMIZE

   FrameBar( oWnd )

   SET MESSAGE OF oWnd TO cAutor CENTER NOINSET 2007 //2010

   DEFINE MSGITEM OF oWnd:oMsgBar SIZE 100;
          TOOLTIP "Correo electrónico y messenger "+cMsn;
          PROMPT cMsn

   DEFINE MSGITEM OF oWnd:oMsgBar SIZE 200;
          TOOLTIP "Dirección web: "+cWebBlog;
          PROMPT cWebBlog ACTION IrWeb( cWebBlog )

   oWnd:oMsgBar:DateOn()
   oWnd:oMsgBar:ClockOn()

   oWnd:bInit := { || oWnd:Center() }

   ACTIVATE WINDOW oWnd VALID ( lExit )                                    ;
            ON PAINT PalBmpDraw( hDC, 075, 000, oBmp:hBitmap )

   DeleteObject( oIcon )

Return NIL
/*------------------------------------------------------------------------------*/
STATIC Function FrameBar( oWnd )
/*------------------------------------------------------------------------------*/

   LOCAL oCursor, oFont, oBar

   DEFINE CURSOR oCursor HAND
   DEFINE FONT oFont NAME "Arial" SIZE 0,-12

   DEFINE BUTTONBAR oBar _3D SIZE 70, 70 OF oWnd 2007

   oBar:oFont := oFont

   DEFINE BUTTON RESOURCE "Backup" NOBORDER OF oBar;
          TOOLTIP "Hacer copia de seguridad";
          ACTION Backup();
          PROMPT "Backup"

   DEFINE BUTTON RESOURCE "Backup" NOBORDER OF oBar;
          TOOLTIP "Restaurar copias de seguridad";
          ACTION Restore();
          PROMPT "Restore"

   DEFINE BUTTON RESOURCE "BotonSalir" OF oBar NOBORDER GROUP;
          TOOLTIP "Salir del Programa";
          ACTION Salir();
          PROMPT "Salir"

   AEval( oBar:aControls, { | o | o:oCursor := oCursor } )

   oBar:bRClicked := {|| NIL }

   oBar:SetColor( CLR_WHITE, CLR_HCYAN )

   oBar:Adjust()

   DeleteObject( oFont )
   DeleteObject( oCursor )
   DeleteObject( oBar )

Return NIL
/*------------------------------------------------------------------------------*/
STATIC Function FrameMenu()
/*------------------------------------------------------------------------------*/

   LOCAL oMenu

   MENU oMenu 2007 //2010

      MENUITEM "&Servicios"
      MENU
        MENUITEM "Hacer copia de seguridad (Backup)"      ACTION Backup()
        MENUITEM "Restaurar copia de seguridad (Restore)" ACTION Restore()
        SEPARATOR
        MENUITEM "Salir" ACTION Salir()
      ENDMENU

      MENUITEM "&Ayuda"
      MENU
        MENUITEM "Ir al Blog" ACTION IrWeb( cWebBlog )
        MENUITEM "Acerca"     ACTION AcercaDe()
      ENDMENU

   ENDMENU

Return( oMenu )
/*------------------------------------------------------------------------------*/
STATIC Function Salir()
/*------------------------------------------------------------------------------*/

   If MsgYesNo( "¿ Desea cerrar la aplicación ?",;
                OemToAnsi( "Confirmar" ) )
      lExit := .T.
      oWnd:End()
   End

Return NIL
/*------------------------------------------------------------------------------*/
Function IrWeb( cURL )
/*------------------------------------------------------------------------------*/

   /* comprobamos si tenemos conexion a internet */
   If !IsInternet()

      MsgAlert( "Compruebe la conexión a Internet.", "Atención" )

      Return NIL

   End

   CursorWait()

   // Funcion modificada para que funcione con Windows 7 y XP
   ShellExecute( , "open", cURL )

   CursorArrow()

Return NIL
/*------------------------------------------------------------------------------*/
Function AcercaDe()
/*------------------------------------------------------------------------------*/

   LOCAL oDlg, oBoton, oCursor, oFontA, oFontB, oWeb, oMsn, oAutor
   LOCAL lValid  := .F.

   DEFINE FONT oFontA NAME "Arial"  SIZE 0, -11
   DEFINE FONT oFontB NAME "Tahoma" SIZE 0, -11 BOLD
   DEFINE CURSOR oCursor HAND

   DEFINE DIALOG oDlg NAME "BoxAcerca" TITLE "Acerca de..." FONT oFontA

   oDlg:lHelpIcon := .F.

   REDEFINE SAY oAutor VAR cAutor   ID 100 OF oDlg COLOR CLR_BLUE, GetSysColor( 15 ) FONT oFontB

   REDEFINE SAY oWeb   VAR cWebBlog ID 101 OF oDlg COLOR CLR_BLUE, GetSysColor( 15 ) FONT oFontB

   REDEFINE SAY oMsn   VAR cMsn     ID 102 OF oDlg COLOR CLR_BLUE, GetSysColor( 15 ) FONT oFontB

   REDEFINE BUTTONBMP oBoton ID 610 OF oDlg     ;
            ACTION ( lValid := .T., oDlg:End() );
            PROMPT "&Cerrar"                    ;
            BITMAP "SalirFtp" TEXTRIGHT         ;
            TOOLTIP "Cerrar"

   oBoton:oCursor  := oCursor

   ACTIVATE DIALOG oDlg CENTERED VALID ( lValid )

   DeleteObject( oFontA )
   DeleteObject( oFontB )
   DeleteObject( oCursor )

Return NIL

/*------------------------------------------------------------------------------*/
DLL32 FUNCTION BWCCRegister( hInst AS LONG ) AS WORD PASCAL LIB "BWCC32.DLL"
/*------------------------------------------------------------------------------*/

// FIN




Donde va el codigo que me comentas ?
Juan Arroyo
México
FWH 7.12 VERCE 5.3 xHarbour 1.1.0
juan_arroyo_t@hotmail.com
User avatar
juan_arroyo_t
 
Posts: 196
Joined: Fri May 15, 2009 1:25 am
Location: Cuautitlán, Mexico

Re: xBackupLite

Postby karinha » Thu Oct 04, 2018 1:53 pm

Code: Select all  Expand view

/*------------------------------------------------------------------------------*/
STATIC Function GetFilesToZip( cSourceZip )
/*------------------------------------------------------------------------------*/

   LOCAL aFile    := {}
   LOCAL aFiles   := {}
   LOCAL nRetorna := 1

   CursorWait()

   nSizeFiles := 0.000

   #IFDEF __XHARBOUR__

      // if xHarbour
      aFiles := DirectoryRecurse( cSourceZip + "\*.*",, .F. )

   #ELSE

      // if harbour
      aFiles := DirectoryRecurse( cSourceZip + "*",, .F. )

   #ENDIF

   aSize( aFilesToZip, 0 )

   FOR EACH aFile IN aFiles

      AAdd( aFilesToZip, { StrCapFirst( cFileName( aFile[ 1 ] ) )                      ,; // Archivo
                           dToC( aFile[ 3 ] )                                          ,; // Fecha
                           aFile[ 4 ]                                                  ,; // Hora
                           Transform( ( aFile[ 2 ] / 1024 ), "999,999,999,999.999 Kb" ),; // Tamaño
                           cFilePath( aFile[ 1 ] )                                     }) // Path del fichero

      /* Acumula total de tamaños de archivos */
      nSizeFiles += aFile[ 2 ]
      nRetorna := 0

      SysRefresh()

   NEXT

   CursorArrow()

   /* Acumulamos el tamaño de los ficheros en Kb */
   IF nRetorna == 0

      nSizeFiles /= 1024

      /* Controlamos que el fichero a crear no supere los 2GB ya que es la restriccion que tienen */
      /* los ZIP */
      IF ( ( nSizeFiles / 1024 ) / 1024 ) >= 2
         Return( 2 )
      END

   END

Return( nRetorna )
 
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xBackupLite

Postby juan_arroyo_t » Thu Oct 04, 2018 3:10 pm

Karinha

Estas instrucciones estan en PROC9995.PRG

Yo tenia
aFiles := DirectoryRecurse( cSourceZip + "\*.*",, .T. )

Ya la cambie a
aFiles := DirectoryRecurse( cSourceZip + "\*.*",, .F. )

y me sigue respaldando la carpeta y sus subcarpetas

Ahora si pongo la instruccion como
aFiles := DirectoryRecurse( cSourceZip + "\*.dbf",, .F. )
lo hace correctamente pero para dbf's solamente

Yo quiero respaldar archivos dbf, cdx y fpt
Juan Arroyo
México
FWH 7.12 VERCE 5.3 xHarbour 1.1.0
juan_arroyo_t@hotmail.com
User avatar
juan_arroyo_t
 
Posts: 196
Joined: Fri May 15, 2009 1:25 am
Location: Cuautitlán, Mexico

Re: xBackupLite

Postby karinha » Thu Oct 04, 2018 3:24 pm

Juan,

? cSourceZip

Que muestra para usted?

Saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7794
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: xBackupLite

Postby juan_arroyo_t » Thu Oct 04, 2018 7:16 pm

Karinha

Para poder respaldar los archivos que necesito hice esta modificacion en PROC9995.PRG en Function GetFilesToZip( cSourceZip ) el IF rat...

Code: Select all  Expand view
FOR EACH aFile IN aFiles
               
        if rat("DBF",upper(aFile[1])) <> 0 .or. rat("CDX",upper(aFile[1])) <> 0 .or. rat("FPT",upper(aFile[1])) <> 0

            AAdd( aFilesToZip, { StrCapFirst( cFileName( aFile[ 1 ] ) )                      ,; // Archivo
                                        dToC( aFile[ 3 ] )                                          ,; // Fecha
                                        aFile[ 4 ]                                                  ,; // Hora
                                        Transform( ( aFile[ 2 ] / 1024 ), "999,999,999,999.999 Kb" ),; // Tamaño
                                        cFilePath( aFile[ 1 ] )                                     }) // Path del fichero

            /* Acumula total de tamaños de archivos */
            nSizeFiles += aFile[ 2 ]
            nRetorna := 0

            SysRefresh()
      endif
     
   NEXT


Yo respaldo unicamente dbf's, cdx's y fpt's
Pero cuando hago el restore seleccionando la carpeta destino (la misma que en el respaldo), me crea una carpeta "ESA_13.01", se supone que al hacer el restore me debe sobreescribir los mismos arhivos.
Te pego el link de la carpeta con las imagenes del restore
https://1drv.ms/f/s!AgM94kAKnz9CkVZirt3PRDaesmVP

saludos
Juan Arroyo
México
FWH 7.12 VERCE 5.3 xHarbour 1.1.0
juan_arroyo_t@hotmail.com
User avatar
juan_arroyo_t
 
Posts: 196
Joined: Fri May 15, 2009 1:25 am
Location: Cuautitlán, Mexico


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 66 guests