FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour xBlite.prg con xBrowse
Posts: 8523
Joined: Tue Dec 20, 2005 07:36 PM
xBlite.prg con xBrowse
Posted: Tue Mar 21, 2017 04:17 PM

Señores, alguien tiene la xBlite.prg (xbackuplite) del master Carlos Vargas con xBrowse? Si es así, usted podría enviarme:

kapiabafwh@gmail.com

Gracias, saludos.

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
Posts: 564
Joined: Thu Oct 13, 2005 09:23 AM
Re: xBlite.prg con xBrowse
Posted: Thu Mar 23, 2017 05:47 PM

Hola,
Yo uso una versión modificada de ese código, la pongo a continuación

#include "FiveWin.ch"
#include "xBrowse.ch"

Function ZipBackup()
   LOCAL cPath    := oApp():cDbfPath
   LOCAL aDir     := Directory(cPath+"*.*" )
   LOCAL aFiles   := {}
   LOCAL aToZip   := {}
   LOCAL aFooter  := { 0, 0, "" }
   LOCAL cZipFile := oApp():cZipPath+DtoS(Date())+".ZIP" + space( 20 )
   LOCAL aGet[3]
   LOCAL i
   LOCAL oDlg, oLbx, oCol
   LOCAL oDlgPro, oSay01, oSay02, oProgress, oBmp

   IF oApp():oDlg != nil
      IF oApp():nEdit > 0
         msgStop( i18n("No puede hacer copias de seguridad hasta que no cierre las ventanas abiertas sobre el mantenimiento que está manejando.") )
         RETURN nil
      ELSE
         oApp():oDlg:End()
         SysRefresh()
      ENDIF
   ENDIF

   FOR i := 1 TO LEN( aDir )
      aadd( aFiles, {aDir[i,1],aDir[i,2],aDir[i,3]})
      aadd( aToZip, cPath+aDir[i,1] )
      aFooter[1] := aFooter[1] + 1
      aFooter[2] := aFooter[2] + aDir[i,2]
   NEXT
   aFiles   := aSort(aFiles,,,{|x,y| UPPER(x[1]) < UPPER(y[1])})

   DEFINE DIALOG oDlg OF oApp():oWndMain RESOURCE "ZipBackup_"+oApp():cLanguage  ;
      TITLE oApp():cAppName+oApp():cVersion + " - hacer copia de seguridad"
   oDlg:SetFont(oApp():oFont)

   REDEFINE SAY ID 100 OF oDlg

   REDEFINE GET aGet[1] VAR cPath   ;
      ID 101 OF oDlg                ;
      COLOR CLR_BLACK, CLR_WHITE    ;
      WHEN .F.

    oLbx := TXBrowse():New( oDlg )
    oLbx:SetArray(aFiles)
    Ut_BrwRowConfig( oLbx )
   oLbx:nDataType            := 1 // array

   oLbx:aCols[1]:cHeader  := i18n("Fichero")
   oLbx:aCols[1]:nWidth   := 100

   oLbx:aCols[2]:cHeader  := i18n("Tamaño")
   oLbx:aCols[2]:nWidth   := 100
    oLbx:aCols[2]:nDataStrAlign := 1
    oLbx:aCols[2]:nHeadStrAlign := 1
    //oLbx:aCols[2]:bStrData := {|| TRAN(aFiles[ oLbx:nAt,2 ]/1000,"@E 999,999,999 ")+" KB" }

   oLbx:aCols[3]:cHeader  := i18n("Fecha modificación")
   oLbx:aCols[3]:nWidth   := 100
    oLbx:aCols[3]:nDataStrAlign := 1
    oLbx:aCols[3]:nHeadStrAlign := 1
    //oLbx:aCols[3]:bStrData := {|| DtoC(aFiles[ oLbx:nAt,3 ]) }

    oLbx:CreateFromResource( 102 )

   REDEFINE SAY ID 103 OF oDlg

   REDEFINE GET aGet[2] VAR cZipFile   ;
      ID 104 OF oDlg UPDATE            ;
      PICTURE '@!'

   REDEFINE BUTTON aGet[3]             ;
      ID 105 OF oDlg UPDATE            ;
      ACTION SetFileZip(aGet[2])
   aGet[3]:cTOOLTIP  := "seleccionar fichero de destino"

   REDEFINE BUTTON   ;
      ID    IDOK     ;
      OF    oDlg     ;
      ACTION   ( if( file( cZipFile ),;
                     if( msgYesNo( i18n( "El fichero de destino especificado ya exite." ) + CRLF + CRLF + ;
                               i18n( "¿Desea reemplazarlo?" ) ), oDlg:end( IDOK ), aGet[2]:setFocus() ),;
                     oDlg:end( IDOK ) ) )

   REDEFINE BUTTON   ;
      ID    IDCANCEL ;
      OF    oDlg     ;
      CANCEL         ;
      ACTION   ( oDlg:end( IDCANCEL ) )

   ACTIVATE DIALOG oDlg ;
      ON INIT oDlg:Center( oApp():oWndMain )

   IF oDlg:nresult == IDOK

      DEFINE DIALOG oDlgPro RESOURCE 'UT_PROGRESS_'+oApp():cLanguage
        oDlgpro:SetFont(oApp():oFont)
      REDEFINE BITMAP oBmp ID 111 OF oDlgPro RESOURCE "APP" TRANSPARENT
      REDEFINE SAY oSay01 PROMPT "Realizando copia de seguridad..." ID 99  OF oDlgPro
      REDEFINE SAY oSay02 PROMPT space(30) ID 100  OF oDlgPro
      oProgress := TProgress():Redefine( 101, oDlgPro )
      oDlgPro:bStart := { || SysRefresh(), DoMakeZip( oProgress, cZipFile, aToZip, aFooter, oSay02 ), oDlgPro:End() }
      ACTIVATE DIALOG oDlgPro ;
         ON INIT oDlgPro:Center( oApp():oWndMain )

   ENDIF

RETURN NIL

FUNCTION SetFileZip( oGet )
   LOCAL cFile
   /*solicita el nombre con la unidad destino incluido*/
   cFile := cGetFile( "ZipFile | *.zip", "Nombre de archivo de copia de seguridad en Disco Duro", 1, oApp():cZipPath, .T., .T. )
   cFile := rtrim( cFile )

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

PROCEDURE DoMakeZip( oProgress, cZipFile, aToZip, aFooter, oSay )
   LOCAL lOkZip      := .F.
   LOCAL bOnZipFile  := { |cFile, nFile| ( oProgress:SetPos( nFile ),;
                                           oSay:SetText(SubStr(cFile,RAT("\",cFile)+1)),;
                                           SysRefresh() ) }
   LOCAL nPos     := 0

   /*establece limites de valores de control meter*/
   oProgress:SetRange( 0, aFooter[1] )
   oProgress:SetPos( 0 )
   /*realiza la compresion de los ficheros*/
   hb_SetDiskZip( {|| NIL } )
   lOkZip := hb_ZipFile( cZipFile   ,;
                         aToZip     ,;
                         9          ,;
                         bOnZipFile ,;
                         NIL        ,;
                         NIL        ,;
                         NIL        )

    /*verifica proceso e informa al usuario*/
    IF lOkZip
        MsgInfo("La creación del fichero de copia de seguridad se realizó correctamente.")
    ELSE
        MsgStop("La creación del fichero de copia de seguridad falló.")
    ENDIF

    hb_gcAll()

RETURN

/*_____________________________________________________________________________*/

Function ZipRestore()

   LOCAL cPath    := UPPER(oApp():cDbfPath)
   LOCAL aDir     := {}
   LOCAL aFiles   := Array(1,3)
   LOCAL aToUnZip := {}
   LOCAL aFooter  := { 0, 0, "" }
   LOCAL cZipFile := ""
   LOCAL aGet[4]
   LOCAL i
   LOCAL oDlg, oLbx, oCol
   LOCAL oDlgPro, oSay01, oSay02, oProgress, oBmp


   IF oApp():oDlg != nil
      IF oApp():nEdit > 0
         msgStop( i18n("No puede restaurar copias de seguridad hasta que no cierre las ventanas abiertas sobre el mantenimiento que está manejando.") )
         RETURN nil
      ELSE
         oApp():oDlg:End()
         SysRefresh()
      ENDIF
   ENDIF

   IF LEFT(cPath,1) == '.'
      cPath := cFilePath(GetModuleFileName(GetInstance()))+SUBSTR(cPath,2)
   ENDIF
   FOR i := 1 TO LEN( aDir )
      aadd( aFiles, {aDir[i,1],aDir[i,2],aDir[i,3]})
      aadd( aToUnzip, cPath+aDir[i,1] )
      aFooter[1] := aFooter[1] + 1
      aFooter[2] := aFooter[2] + aDir[i,2]
   NEXT
   aFiles   := aSort(aFiles,,,{|x,y| UPPER(x[1]) < UPPER(y[1])})

   DEFINE DIALOG oDlg OF oApp():oWndMain RESOURCE "ZipRestore_"+oApp():cLanguage;
      TITLE oApp():cAppName+oApp():cVersion + " - restaurar copia de seguridad"
   oDlg:oFont  := oApp():oFont

   REDEFINE SAY ID 100 OF oDlg

   REDEFINE GET aGet[1] VAR cZipFile;
      ID 101 OF oDlg UPDATE         ;
      PICTURE '@!'
   REDEFINE BUTTON aGet[4]             ;
      ID 105 OF oDlg UPDATE            ;
      ACTION GetFileToUnzip(aGet[1], aFiles, aToUnZip, aFooter, oLbx)
   aGet[4]:cTOOLTIP  := "seleccionar fichero con la copia de seguridad"

    oLbx := TXBrowse():New( oDlg )
    oLbx:SetArray(aFiles)
    Ut_BrwRowConfig( oLbx )
   oLbx:nDataType            := 1 // array

   oLbx:aCols[1]:cHeader  := i18n("Fichero")
   oLbx:aCols[1]:nWidth   := 100

   oLbx:aCols[2]:cHeader  := i18n("Tamaño")
   oLbx:aCols[2]:nWidth   := 100
    oLbx:aCols[2]:nDataStrAlign := 1
    oLbx:aCols[2]:nHeadStrAlign := 1
    //oLbx:aCols[2]:bStrData := {|| TRAN(aFiles[ oLbx:nAt,2 ]/1000,"@E 999,999,999 ")+" KB" }

   oLbx:aCols[3]:cHeader  := i18n("Fecha modificación")
   oLbx:aCols[3]:nWidth   := 100
    oLbx:aCols[3]:nDataStrAlign := 1
    oLbx:aCols[3]:nHeadStrAlign := 1
    //oLbx:aCols[3]:bStrData := {|| DtoC(aFiles[ oLbx:nAt,3 ]) }

    oLbx:CreateFromResource( 102 )

   REDEFINE SAY ID 103 OF oDlg

   REDEFINE GET aGet[2] VAR cPath   ;
      ID 104 OF oDlg                ;
      COLOR CLR_BLACK, CLR_WHITE    ;
      WHEN .F.

   REDEFINE BUTTON   ;
      ID    IDOK     ;
      OF    oDlg     ;
      ACTION   ( oDlg:end( IDOK ) )

   REDEFINE BUTTON   ;
      ID    IDCANCEL ;
      OF    oDlg     ;
      CANCEL         ;
      ACTION   ( oDlg:end( IDCANCEL ) )

   ACTIVATE DIALOG oDlg ;
      ON INIT oDlg:Center( oApp():oWndMain )

   IF oDlg:nresult == IDOK

      DEFINE DIALOG oDlgPro RESOURCE 'UT_PROGRESS_'+oApp():cLanguage
        oDlgPro:oFont  := oApp():oFont
      REDEFINE BITMAP oBmp ID 111 OF oDlgPro RESOURCE "APP" TRANSPARENT
      REDEFINE SAY oSay01 PROMPT "Restaurando copia de seguridad..." ID 99  OF oDlgPro
      REDEFINE SAY oSay02 PROMPT space(30) ID 100  OF oDlgPro
      oProgress := TProgress():Redefine( 101, oDlgPro )
      oDlgPro:bStart := { || SysRefresh(), DoMakeUnZip( oProgress, cZipFile, cPath, aFooter, oSay02 ), oDlgPro:End() }
      ACTIVATE DIALOG oDlgPro ;
         ON INIT oDlgPro:Center( oApp():oWndMain )

   ENDIF

RETURN NIL

PROCEDURE GetFileToUnZip( oGet,aFiles,aToUnZip,aFooter,oLbx )
   LOCAL cFile
   LOCAL aDir
   LOCAL i

   /*pide al usuario que seleccione el fichero de respaldo*/
   cFile := cGetFile( "ZipFile   | *.zip", "Nombre de archivo de copia de seguridad a restaurar", 1, oApp():cZipPath, .f., .t. )

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

      /*muestra el nombre del fichero en el dialogo*/
      oGet:cText := cFile

      aDir := hb_GetFilesInZip( cFile, .T. )

      /*vereficia el valor retornado por la funcion, si es arreglo y si tiene elementos*/
      IF valtype( aDir ) = "A" .and. len( aDir ) > 0
         aFiles   := {}
         aToUnzip := {}
         aFooter  := { 0, 0, ""}
         FOR i := 1 TO LEN( aDir )
            aadd( aFiles, {aDir[i,1],aDir[i,2],aDir[i,6]})
            aadd( aToUnZip, cFilePath(cFile)+aDir[i,1] )
            aFooter[1] := aFooter[1] + 1
            aFooter[2] := aFooter[2] + aDir[i,2]
         NEXT

         aFiles   := aSort(aFiles,,,{|x,y| UPPER(x[1]) < UPPER(y[1])})

         /*pasa el arreglo al browse*/

         oLbx:bLine  := { || { " "+cFileName(aFiles[ oLbx:nAt,1 ]) ,;
                               TRAN(aFiles[ oLbx:nAt,2 ]/1000,"@E 999,999,999 ")+" KB",;
                               " "+DtoC(aFiles[ oLbx:nAt,3 ]) }}
         //oLbx:aFooters  := { TRAN(aFooter[1],"@E 999 ")+" ficheros",TRAN(aFooter[2]/1000,"@E 999,999,999 ")+" KB", }
         oLbx:SetArray( aFiles )
         oLbx:refresh( .T. )
         hb_gcAll()
      ELSE
         MsgStop(i18n("El fichero no es un fichero ZIP válido o parece estar dañado."))
         RETURN
      ENDIF
   ENDIF
RETURN

PROCEDURE DoMakeUnZip( oProgress, cZipFile, cPath, aFooter, oSay )
   LOCAL lOkUnZip    := .F.
   LOCAL bOnZipFile  := { |cFile, nFile| ( oProgress:SetPos( nFile ),;
                                           oSay:SetText(SubStr(cFile,RAT("\",cFile)+1)),;
                                           SysRefresh() ) }
   LOCAL nPos     := 0
   LOCAL aFiles   := hb_GetFilesInZip( cZipFile )

   /*establece limites de valores de control meter*/
   oProgress:SetRange( 0, aFooter[1] )
   oProgress:SetPos( 0 )
   /*realiza la compresion de los ficheros*/
   hb_SetDiskZip( {|| NIL } )

   lOkUnZip := hb_UnZipFile( cZipFile     ,;
                             bOnZipFile   ,;
                             .F.          ,;
                             NIL          ,;
                             cPath        ,;
                             aFiles  )

    /*verifica proceso e informa al usuario*/
    IF lOkUnZip
        MsgInfo("La restauración del fichero de copia de seguridad se realizó correctamente.")
    ELSE
        MsgStop("La restauración del fichero de copia de seguridad ha fallado.")
    ENDIF

    hb_gcAll()

RETURN

y el código del diálogo es este

Code (fw): Select all Collapse
LANGUAGE LANG_SPANISH, SUBLANG_SPANISH_MODERN
ZIPBACKUP_ES DIALOG 41, 15, 240, 188
STYLE DS_3DLOOK | DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_VISIBLE | WS_POPUP | WS_SYSMENU
CAPTION "ZipBackup"
FONT 8, "MS Sans Serif"
{
    LTEXT           "Directorio a copiar:", 100, 8, 8, 173, 8, SS_LEFT
    EDITTEXT        101, 8, 20, 224, 12, ES_UPPERCASE
    CONTROL         "", 102, "TxBrowse", 0x50A10000, 8, 36, 224, 92
    LTEXT           "Ruta y Fichero ZIP de copia de seguridad:", 103, 8, 134, 140, 8, SS_LEFT
    EDITTEXT        104, 8, 144, 206, 12
    PUSHBUTTON      "...", 105, 218, 144, 14, 12
    DEFPUSHBUTTON   "&Aceptar", IDOK, 128, 164, 50, 16
    PUSHBUTTON      "&Cancelar", IDCANCEL, 182, 164, 50, 16
    LTEXT           "01", IDC_STATIC, 8, 160, 224, 1, SS_LEFT | SS_SUNKEN
}


LANGUAGE LANG_SPANISH, SUBLANG_SPANISH_MODERN
ZIPRESTORE_ES DIALOG 41, 15, 240, 188
STYLE DS_3DLOOK | DS_MODALFRAME | DS_SETFONT | WS_CAPTION | WS_VISIBLE | WS_POPUP | WS_SYSMENU
CAPTION "ZipBackup"
FONT 8, "MS Sans Serif"
{
    LTEXT           "Fichero ZIP con la copia de seguridad:", 100, 8, 8, 173, 8, SS_LEFT
    EDITTEXT        101, 8, 20, 206, 12, ES_AUTOHSCROLL
    PUSHBUTTON      "...", 105, 218, 20, 14, 12
    CONTROL         "", 102, "TxBrowse", 0x50A10000, 8, 36, 224, 92
    LTEXT           "Directorio de destino de los datos:", 103, 8, 134, 140, 8, SS_LEFT
    EDITTEXT        104, 8, 144, 224, 12, ES_READONLY
    DEFPUSHBUTTON   "&Aceptar", IDOK, 128, 164, 50, 16
    PUSHBUTTON      "&Cancelar", IDCANCEL, 182, 164, 50, 16
    LTEXT           "01", IDC_STATIC, 8, 160, 224, 1, SS_LEFT | SS_SUNKEN
}

Saludos,
Posts: 8523
Joined: Tue Dec 20, 2005 07:36 PM
Re: xBlite.prg con xBrowse
Posted: Thu Mar 23, 2017 05:55 PM

Gracias José, me genera estos errores:

Error: Unresolved external '_HB_FUN_OAPP' referenced from C:\FWH1701\SAMPLES\XBL
ITE.OBJ
Error: Unresolved external '_HB_FUN_UT_BRWROWCONFIG' referenced from C:\FWH1701\
SAMPLES\XBLITE.OBJ

Saludos.

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
Posts: 564
Joined: Thu Oct 13, 2005 09:23 AM
Re: xBlite.prg con xBrowse
Posted: Fri Mar 24, 2017 07:31 AM

Hi,
oApp() is a function that return an object where I store all the configuration of my applications. And Ut_brwrowconfig is a function to customize the browses. You can delete the calls them without any problem.

Regards,

Posts: 1710
Joined: Tue Oct 28, 2008 06:26 PM
Re: xBlite.prg con xBrowse
Posted: Fri Mar 24, 2017 12:58 PM

José

En que librería estás estas funciones:

Error: Unresolved external '_HB_FUN_HB_SETDISKZIP' referenced from D:\SISTEMAS\ACRSOFT\OK\OBJ\ACR.OBJ
Error: Unresolved external '_HB_FUN_HB_ZIPFILE' referenced from D:\SISTEMAS\ACRSOFT\OK\OBJ\ACR.OBJ
Error: Unresolved external '_HB_FUN_HB_GETFILESINZIP' referenced from D:\SISTEMAS\ACRSOFT\OK\OBJ\ACR.OBJ
Error: Unresolved external '_HB_FUN_HB_UNZIPFILE' referenced from D:\SISTEMAS\ACRSOFT\OK\OBJ\ACR.OBJ

Gracias,

Saludos,



Adhemar C.
Posts: 8523
Joined: Tue Dec 20, 2005 07:36 PM
Re: xBlite.prg con xBrowse
Posted: Fri Mar 24, 2017 01:52 PM

Adhemar:

echo %fwh%\lib\Fivehx.lib %fwh%\lib\FiveHC.lib %fwh%\lib\libmysql.lib + >> b32.bc
echo %hdirl%\rtl.lib + >> b32.bc
echo %hdirl%\vm.lib + >> b32.bc
echo %hdirl%\%GT%.lib + >> b32.bc
echo %hdirl%\lang.lib + >> b32.bc
echo %hdirl%\macro.lib + >> b32.bc
echo %hdirl%\rdd.lib + >> b32.bc
echo %hdirl%\dbfntx.lib + >> b32.bc
echo %hdirl%\dbfcdx.lib + >> b32.bc
echo %hdirl%\dbffpt.lib + >> b32.bc
echo %hdirl%\hbsix.lib + >> b32.bc
echo %hdirl%\debug.lib + >> b32.bc
echo %hdirl%\common.lib + >> b32.bc
echo %hdirl%\codepage.lib + >> b32.bc
echo %hdirl%\pp.lib + >> b32.bc
echo %hdirl%\pcrepos.lib + >> b32.bc
echo %hdirl%\ct.lib + >> b32.bc
echo %hdirl%\zlib.lib + >> b32.bc
echo %hdirl%\hbzip.lib + >> b32.bc
echo %hdirl%\libmisc.lib + >> b32.bc
echo %hdirl%\tip.lib + >> b32.bc
rem echo %hdirl%\png.lib + >> b32.bc

rem Uncomment these two lines to use Advantage RDD
rem echo %hdir%\lib\rddads.lib + >> b32.bc
rem echo %hdir%\lib\Ace32.lib + >> b32.bc

echo %bcdir%\lib\cw32.lib + >> b32.bc
echo %bcdir%\lib\import32.lib + >> b32.bc
echo %bcdir%\lib\uuid.lib + >> b32.bc
echo %bcdir%\lib\ws2_32.lib + >> b32.bc
echo %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
echo %bcdir%\lib\psdk\rasapi32.lib + >> b32.bc
echo %bcdir%\lib\psdk\nddeapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\msimg32.lib + >> b32.bc
echo %bcdir%\lib\psdk\psapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\gdiplus.lib + >> b32.bc
echo %bcdir%\lib\psdk\iphlpapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\shell32.lib, >> b32.bc

Saludos

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
Posts: 8523
Joined: Tue Dec 20, 2005 07:36 PM
Re: xBlite.prg con xBrowse
Posted: Fri Mar 24, 2017 09:09 PM
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
Posts: 8523
Joined: Tue Dec 20, 2005 07:36 PM
Re: xBlite.prg con xBrowse
Posted: Tue Mar 28, 2017 03:21 PM
Haciendo pruebas con xHarbour para BCC7.2 y FWHX17.01:

http://i.imgur.com/FNn6ReH.png



Saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
Posts: 8523
Joined: Tue Dec 20, 2005 07:36 PM
Re: xBlite.prg con xBrowse
Posted: Tue Mar 28, 2017 08:14 PM
Download disponible con fuentes y executable:

http://www.pctoledo.com.br/forum/viewtopic.php?f=2&t=8731&p=114846#p114846

Porfa, mantener el nombre del autor.

Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341

Continue the discussion