Conforme autorizado pelo Toledo estou postando aqui a minha rotina para backup compactado usando a hbzlib.lib.
Esta rotina não usa nenhuma lib gráfica, somente as funções da GASpro, mas pode ser usada com a gtwvw sem nenhum problema.
Como meus sistemas são multi empresa, crio um arquivo compactado com com o número da empresa, ano e mes de processamento Ex.: "E01_A2008M06.ZIP", assim fica fácil identificar de qual empresa é este backup.
Código: Selecionar todos
#include "SFP40H.ch" // inicializa constantes manifestas
#include "Directry.ch"
#include "common.ch"
PROC SFP_COMP
LOCAL m_arquivo,m_arquivo2,mcaminho
LOCAL dele_atu, cur_atual
PRIV getlist:={}
PRIV tem_borda:=.t., op_menu:=VAR_COMPL, l_s:=01, c_s:=02, l_i:=12, c_i:=78, tela_fundo:=SAVESCREEN(0,0,MAXROW(),79)
REQUEST DISKREADYW
// abaixo nos GETs tem os comandos AJUDA e MOSTRA, que estão definidos no arquivo SFP40H.ch
// Estes comandos são usados pelo getsys da GAS, o AJUDA mostra uma janelinha com uma ajuda a dada campo
// disparado a cada GET, como um hint.
// Caso não queiram usar esse comando com o getsys do gas, basta tirá-los.
// A fun‡Æo DBOX pode ser substituida por outra fun‡Æo que mostre uma mensagem e
// monte menus com prompt.
// vari veis para a fun‡Æo dbox() e errorsys()
drvcara=CHR(178); mold="ÚÄ¿³ÙÄÀ³ÃÄ´"
drvmenucen=.f.
drvcorpad="W+/RB" ; drvcorbox="W+/B" // cores default
drvcormsg="W+/N*" ; drvcorenf="W+/R"
drvcorget="W+/BG" ; drvcortel="W+/B"
drvcorhlp="GR+/G" ; drvcortna="GR/N"
drvtitpad="GR+/RB" ; drvtitbox="GR+/B" // cores dos titulos default
drvtitmsg="GR+/N*" ; drvtitenf="GR+/R"
drvtitget="GR+/BG" ; drvtittel="GR+/B"
drvtithlp="W+/G" ; drvtittna="W/N"
drvdbf='C:\teste\backup\' // caminho dos arquivos DBFs e DBTs
usuario='FULANO'
SETMODE(25,80)
SETCOLOR(drvtittel)
CAIXA(mold,l_s,c_s,l_i,c_i) // monta caixa da tela
@ l_s,c_s+1 SAY " CàPIA OU RESTAURA€ÇO DOS DADOS (BACKUP) "
@ l_i,c_s+1 SAY " Tecle [ESC] para retornar "
SETCOLOR(drvcortel)
@ l_s+02,c_s+01 SAY " Tipo de Opera‡Æo...:"
@ l_s+04,c_s+01 SAY " Drive destino......: "
@ l_s+06,c_s+01 SAY " Arquivo a compactar:"
@ l_s+07,c_s+01 SAY " Bytes por arquivo..:"
@ l_s+08,c_s+01 SAY " Total de bytes.....:"
@ l_s+09,c_s+01 SAY " Total Processado...:"
PRIV mtipo:=' ', Mdrv:=' ',MDEST:='C'
DO WHILE .t.
rola_t=.f.
SETCOLOR(drvcortel+","+drvcorget+",,,"+drvtittel)
@ l_s+02 ,c_s+23 GET mtipo;
PICT "@R 9";
VALI CRIT("mtipo$[123]~Escolha 1, 2 ou 3 para esta op‡Æo")
AJUDA "ESCOLHA UMA OPۂO:||"+;
"1.Fazer a c¢pia de seguran‡a compactada para disquete. |"+;
"2.Restaurar uma c¢pia j existente (Descompactar). |"+;
"3.Copiar todas as Empresas em outro Computador na rede.|"
MOSTRA {"if(mtipo='1','Fazer a c¢pia de seguran‡a (Compactar).',"+;
"if(mtipo='2','Restaurar uma c¢pia j existente (Descompactar).',"+;
"if(mtipo='3','Copiar todas as empresas em outro computador.',"+;
"'Restaurar c¢pia antiga.')))", 2 , 25 }
@ l_s+04 ,c_s+23 GET mdrv;
PICT "@!";
WHEN MTIPO#'3';
VALI CRIT("mdrv$[ABCDEFGHIJKLMNOPQRSTUVZWYZ].and.DiskReadyW(mDrv,.t.)~Disco inexistemte ou est protegido contra grava‡Æo.|Escolha uma unidade de disco ativa neste computador.")
AJUDA "Escolha driver para fazer ou restaurar a c¢pia de seguran‡a.|Depois coloque um disquete no driver ou o PEN Driver.|Tecle F8 para ver as unidade de disco dispo¡veis."
CMDF8 "MTAB(pega_drive(),[Selecione um Drive para gravar este Backup.])"
READ
IF LASTKEY()=K_ESC // se quer cancelar
RETU // retorna
ENDI
MMVDESTBK=MDEST
exit
enddo
IF MTIPO='1'
msgt="SALVAR DADOS DA EMPRESA (BACKUP)" // monta mensagens
msg ="1 Continua Opera‡„o|2 Cancelar Opera‡„o"
ALERTA(3)
IF DBOX(msg,,,E_MENU,,msgt)!=1 // solicita confirm do usuario
RETURN
ENDIF
GCOMPAC() // Faz backup COMPACTADO
ELSEIF MTIPO='2'
msgt="RESTAURAR DADOS DA EMPRESA|Esta opera‡Æo vai subscrever|todos os dados existentes." // monta mensagens
msg ="1 Cancelar Opera‡„o|2 Continua Opera‡„o"
ALERTA(99)
IF DBOX(msg,,,E_MENU,,msgt)!=2 // solicita confirm do usuario
RETURN
ENDIF
IF nivelop < 3 // usuario pode acessar esta opcap?...
ALERTA()
DBOX(msg_auto,,,3)
RETU
ENDIF
GDCOMPAC() // Recupera backup COMPACTADO
ELSEIF MTIPO='3'
msgt="SALVAR DADOS DE TODAS AS EMPRESA" // monta mensagens
msg ="1 Continua Opera‡„o|2 Cancelar Opera‡„o"
ALERTA(3)
IF DBOX(msg,,,E_MENU,,msgt)!=1 // solicita confirm do usuario
RETURN
ENDIF
//COP_SEG() // copiar toda as empresas
ENDIF
RETU
/*
ROTINA PARA COMPACTAR OS DADOS DA EMPRESA ABERTA
Usa a hbzlib para compactar.
*/
PROC GCOMPAC
local mcaminho,marqarj,marqarja,marq,mtot:=0,mtamdisk,mdisco
local aDir1:=Directory(DRVDBF+"*.db?") // enxo um vetor com os nomes dos
local aDir2:=Directory(DRVDBF+"*.mem") // arquivos a serem compactados
local aDir3:=Directory(DRVDBF+"*.PRG") // pode ser v rias exten‡äes e ainda usando coringas
local afiles:={},aTamanho:={}
Local x
local nLen
local aGauge
mcaminho:=DRVdbf //16
// no meu sistema par_codigo ‚ o numero da empresa
// par_mes tem o ano e mes de referencia, uso esse campos para montar o nome do arquivo
// marqzip :='E'+PAR_codIGO+'_A'+right(par_mes,4)+'M'+left(par_mes,2)
marqzip:= 'nome_zip'
//enxo aFiles com o caminho e os nomes dos arquivos e aTamanho com a quantidade
// em baites de cada arquivo, para apresentar o crecimento da compacta‡Æo de
// cada arquivo
For x:=1 to len(aDir1)
aadd(aFiles ,drvdbf+adir1[x,1])
aadd(aTamanho,adir1[x,2])
next
For x:=1 to len(aDir2)
aadd(aFiles ,drvdbf+adir2[x,1])
aadd(aTamanho,adir2[x,2])
next
For x:=1 to len(aDir3)
aadd(aFiles ,left(drvdbf,14)+adir3[x,1])
aadd(aTamanho,adir3[x,2])
next
nLen=len(afiles) // quantidade de arquivos, para apresentar o crescimento
// total do arquivo zip.
mtotBytes:=0 // total de bytes, vai acrescentando
if hb_zipfile( drvdbf+marqzip, afiles, 9, {|cFile,nPos| eProgresso( cFile, nPos, nLen) },.t., ,.f.,.f., {|cFile,nPos2| cProgressoFile( cFile, nPos2) } )
mOrigem :=drvdbf+marqzip+'.zip'
mDestino:=mDrv +':\'+marqzip+'.zip'
COPY FILE (mOrigem) TO (mDestino)
if fError() = 0 // se nÆo teve nenhum erro ao copiar
dbox("BACKUP COMPACTADO FOI EFETUADO COM SUCESSO.|O arquivo "+mDestino+" foi copiado na Unidade de Disco "+mdrv+':\',13,,,,"ATENۂO "+ALLTRIM(USUARIO)+'!')
else
dbox('A OPERAۂO FALHOR.|Erro encontrado ao tentar copiar|o arquivo gerado para o disco de destino.',13,,,,"ATENۂO "+ALLTRIM(USUARIO)+'!')
endif
else
dbox("A OPERAۂO FALHOR.|ERROS FORAM DETECTADOS DURANTE O BACKUP.",13,,,,"ATENۂO "+ALLTRIM(USUARIO)+'!')
endif
RETU
/*
ROTINA PARA DESCOMPACTAR OS DADOS DA EMPRESA ABERTA
Usa a hbzlib para compactar.
*/
PROC GDCOMPAC
local mcaminho,marqarj,marqarja,marq,mtot:=0,mtamdisk,mdisco
local afiles:={},aTamanho:={}
Local x
local nLen
marqzip :='nome_zip' // informe o nome do arquivo zip a descompactar
if file( mDrv+':\'+marqzip+'.zip')
mDestino:=drvdbf + marqzip+'.zip'
mOrigem :=mDrv +':\'+marqzip+'.zip'
COPY FILE (mOrigem) TO (mDestino) // faz a c¢pia do arquivo para a pasta
// para depois descompactar
if fError() = 0 // se nÆo teve nenhum erro ao copiar continua
mtotBytes:=0 // total de bytes, vai acrescentando
aExtract := hb_GetFilesInZip( left( Drvdbf,14 ) + marqzip+'.zip' ) // extract all files in zip
nLen=len(aExtract) // quantidade de arquivos
if hb_unzipfile( left( Drvdbf,14 ) + marqzip + '.zip', {|cFile,nPos| eProgresso( cFile, nPos, nLen) }, , , drvdbf, aExtract, {|cFile,nPos2| cProgressoFile( cFile, nPos2) } )
// APAGA ARQUIVOS .NSX, macro com fun‡äes da clipper.lib e directry.ch
AEVAL(DIRECTORY(drvdbf +'*.cdx'), { |aFile| FERASE(drvdbf + aFile[F_NAME]) })
// crie novamente seus indices
//criadbf() // cria novamente os ntx's
ALERTA() // avisa ao usuario
dbox("DESCOMPACTAۂO EFETUADA COM SUCESSO.|O arquivo "+mOrigem+" foi descompactado na pasta da empresa.",13,,,,"ATENۂO "+ALLTRIM(USUARIO)+'!')
else
dbox("A OPERAۂO FALHOR.|ERROS FORAM DETECTADOS DURANTE A DESCOMPACTAۂO.",13,,,,"ATENۂO "+ALLTRIM(USUARIO)+'!')
endif
else
dbox('A OPERAۂO FALHOR.|Erro encontrado ao tentar copiar o arquivo.',13,,,,"ATENۂO "+ALLTRIM(USUARIO)+'!')
endif
else
dbox('A OPERA€ÇO FALHOR.|O arquivo ' +mDrv+':\'+marqzip+'.zip'+' nÆo foi encontrado no disco selecionado.',13,,,,"ATEN€ÇO "+ALLTRIM(USUARIO)+'!')
endif
RETU
************************************
Static Function eProgresso(vtxt,xPerc,wTot)
************************************
@ l_s+06,c_s+23 SAY space(50)
@ l_s+06,c_s+23 SAY vtxt // nome do arquivo
@ l_s+09,c_s+23 SAY tran((xPerc/wTot)*100, '@E 999.99')+" %"
return nil
************************************
Static Function cProgressoFile( cFile, nPos2 )
@ l_s+07,c_s+23 SAY space(50)
@ l_s+07,c_s+23 SAY Alltrim(tran( cFile, '@E 999,999,999'))+" / "+alltrim(tran( nPos2, '@E 999,999,999'))+' bytes'
if cFile = nPos2
mTotBytes+=nPos2
@ l_s+08,c_s+23 SAY tran( mTotBytes, '@E 999,999,999') + ' bytes'
endif
return nil
// Mostra os drives existentes, seus nomes e seus tipos
FUNC PEGA_Drive(mValor)
LOCAL mMenu:='', mdriver, aDriver[0]
local aDriveType:={'','Disquete','Disco r¡gido','CD-Rom','Drive na REDE'}
mDriver:=Drives() // drivers disponiveis
for i=1 to len(mDriver)
aadd(aDriver,subs(mDriver,i,1)+':\, '+;
aDriveType[ DriveType( subs( mDriver,i,1 ) ) ] +', '+;
GetVolInfo(subs(mDriver,i,1)+':\') )
next
for i=1 to len(aDriver)
mMenu+=aDriver[i]+'|'
next
RETU (mMenu) // Final
/*
Sintaxe: CRIT( <ExpC1> <,ExpN> [,ExpC2] )
Funcao.: Executa validacao de campos/ mostra formulas na tela
ExpC1 = expressao de validacao e a mensagem a ser mostrada
separados separadas pelo caracter "~".
ExpN = linha onde sera mostrada a mensagem
ExpC2 = formulas a serem mostradas na tela. ("nn|nn|nn|...",
"nn"=num das f¢rmulas especificadas no vetor "sistema"
Retorna: .t. se critica ok
*/
FUNC CRIT(msgc,li,form_)
LOCAL cond, msg, flag:=.t., no_gets, i_
PRIV l, c
no_gets=(RIGHT(PROCNAME(1),5)="_GETS") // flg se nao esta consultando
IF !EMPT(msgc) .AND. !("V"==msgc) .AND. !("I"==msgc)
li=IF(li=NIL.OR.li>MAXROW()-5,MAXROW()-5,li) // ajusta linha da mensagem
msg =SUBS(msgc,AT("~",msgc)+1) // mensagem a mostrar
cond=LEFT(msgc,AT("~",msgc)-1) // condicao de validacao
IF !(&cond.) // se condicao nao satisfeita,
IF !no_gets // se tem msg para mostrar
IF LEN(TRIM(msg))>0 // se tem msg para mostrar
ALERTA() // beep, beep, beep
DBOX(msg,li,,,,"ATEN€ŽO! "+usuario) // avisa ao usuario
ENDI
flag=.f. // retornando falso
ENDI
ENDI
ENDI
IF flag .AND. form_!=NIL // validacao ok e tem formulas
DO WHIL LEN(form_)>0 // mostraremos todas ...
i_=VAL(PARSE(@form_,"|")) // pega subscricao da formula
IMP_FORM(sistema[op_sis,O_FORMULA,i_]) // imprime a formula
ENDD
ENDI
RETU flag // retorna ok se validacao ok
PROC IMP_FORM(f_) // imprime formula na tela
LOCAL l_, c_
IF VALTYPE(f_[O_LINHA])="B" // a linhas esta variando (scroll)
l_=l_s+EVAL(f_[O_LINHA]) // acha a nova posicao
ELSE
l_=l_s+f_[O_LINHA] // a linha e fixa na tela
ENDI
c_=c_s+f_[O_COLUNA] // coluna
@ l_,c_ SAY &(f_[O_FORM]) // exibe formula
RETU
Abaixo segue o projeto compactado montado no xDev, compilado com o xHarbour 1.0.0 e a HBZLIB.LIB e ainda pode ser compilado com o "hbmake b32.bc"
, tentei incluir na função DIRECTORY() mas... tambem não fui feliz, ai vi esse poste e quem sabe... esse creio é uma necessidade a partir da NF-e para todos nos, desde já agradeço,