Jump to content
Fivewin Brasil

DonJuan

Membros
 View Profile  See their activity

  • Posts

    836

  • Joined

  • Last visited

 Content Type 

Everything posted by DonJuan

  1. DonJuan
    citação:Hola podrias poner una imagen,para ver el error de donde se produce ? y que version de VeRCE estas usando ? yo tengo años de usar VeRCE version 5.0 y hasta la fecha no me ha dado problemas, alguno, creo que algo estas haciendo mal, en tu proyecto,o algo por el estilo. Saludos Adrian C. C. acc69@hotmail.com id=quote>id=quote>Verifique a linha que esta dando erro, também pode ser um campo com valor numero de 15 e vc deve estar tentando guardar uma numoer de 20 Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  2. DonJuan
    citação:ótima contribuição, funcionou certinho. Parabens William Adami "Eu creio, que de algum modo, que seje relativo em demasia a subjetiva constitucional perante tecnicamente aos que assim ditam o descritivo em si, no parágrafo subconsequente do subconciente doutrinários." id=quote>id=quote>Bleza estou terminando uma rotina de consulta ao CNPJ e CPF, onde traga os dados completo via internet!! Ta dando dor de cabeça mais vai sair Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  3. DonJuan
    Sei que essa é uma informação importante para todos!! Por isso estou enviando para você o codigo para pegar cotação diretamente do site #INCLUDE "FiveWin.ch" Function Main() Local oHttp, ; cResp1 := "", ; cResp := "", ; cComercialc := "",; cComercialv := "",; cParaleloc := "",; cParalelov := "",; cTurismoc := "",; cTurismov := "",; cEuroc := "",; cEurov := "",; clibrac := "",; cLibrav := "",; cData := "" IF !IsInternet() RETURN NIL ENDIF Try oHttp := CreateObject("Microsoft.XMLHTTP") oHttp:Open("GET","http://economia.uol.com.br/cotacoes/cambio.jhtm",.f.) oHttp:Send() cResp1 := oHttp:ResponseText() MemoWrit( 'teste.txt',cResp1) Catch MsgStop( "Error" ) Return cResp End Try //Dólar Comercial cResp := SubStr( cResp1 , At( 'Dólar comercial cResp := Substr( cResp , At( ' ', cResp ) ) cComercialc := Substr( cResp ,5,At( ' ', cResp )-4) cComercialc := STRTRAN(cComercialc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cComercialv := Substr( cResp ,10,At( ' cComercialv := STRTRAN(cComercialv, ",", ".") //Dólar Turismo cResp := SubStr( cResp1 , At( 'Dólar turismo cResp := Substr( cResp , At( ' ', cResp ) ) cTurismoc := Substr( cResp ,5,At( ' ', cResp )-4) cTurismoc := STRTRAN(cTurismoc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cTurismov := Substr( cResp ,10,At( ' cTurismov := STRTRAN(cTurismov, ",", ".") //Dólar Paralelo cResp := SubStr( cResp1 , At( 'Dólar paralelo cResp := Substr( cResp , At( ' ', cResp ) ) cParaleloc := Substr( cResp ,5,At( ' ', cResp )-4) cParaleloc := STRTRAN(cParaleloc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cParalelov := Substr( cResp ,10,At( ' cParalelov := STRTRAN(cParalelov, ",", ".") //Euro cResp := SubStr( cResp1 , At( 'Euro cResp := Substr( cResp , At( ' ', cResp ) ) cEuroc := Substr( cResp ,5,At( ' ', cResp )-4) cEuroc := STRTRAN(cEuroc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cEurov := Substr( cResp ,10,At( ' cEurov := STRTRAN(cEurov, ",", ".") //Libra cResp := SubStr( cResp1 , At( 'Libra cResp := Substr( cResp , At( ' ', cResp ) ) cLibrac := Substr( cResp ,5,At( ' ', cResp )-4) cLibrac := STRTRAN(cLibrac, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cLibrav := Substr( cResp ,10,At( ' cLibrav := STRTRAN(cLibrav, ",", ".") //Data cResp := Substr( cResp, At( 'data-hora', cResp )+11 ) cData := Substr( cResp, 1,At( ' ', cResp )-1 ) cResp := "Dólar Comercial Compra "+Tran(Val(cComercialc),"@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cComercialv),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Dólar Turidmo Compra "+Tran(Val(cTurismoc), "@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cTurismov),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Dólar Paralelo Compra "+Tran(Val(cParaleloc), "@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cParalelov),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Euro Compra "+Tran(Val(cEuroc),"@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cEurov),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Libra Compra "+Tran(Val(cLibrac),"@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cLibrav),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Última Atualização em "+Tran(cData,"@D") MSGINFO(cResp) Return cResp function gettasks() return nil Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  4. DonJuan
    Sei que essa é uma informação importante para todos!! Por isso estou enviando para você o codigo para pegar cotação diretamente do site #INCLUDE "FiveWin.ch" Function Main() Local oHttp, ; cResp1 := "", ; cResp := "", ; cComercialc := "",; cComercialv := "",; cParaleloc := "",; cParalelov := "",; cTurismoc := "",; cTurismov := "",; cEuroc := "",; cEurov := "",; clibrac := "",; cLibrav := "",; cData := "" IF !IsInternet() RETURN NIL ENDIF Try oHttp := CreateObject("Microsoft.XMLHTTP") oHttp:Open("GET","http://economia.uol.com.br/cotacoes/cambio.jhtm",.f.) oHttp:Send() cResp1 := oHttp:ResponseText() MemoWrit( 'teste.txt',cResp1) Catch MsgStop( "Error" ) Return cResp End Try //Dólar Comercial cResp := SubStr( cResp1 , At( 'Dólar comercial cResp := Substr( cResp , At( ' ', cResp ) ) cComercialc := Substr( cResp ,5,At( ' ', cResp )-4) cComercialc := STRTRAN(cComercialc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cComercialv := Substr( cResp ,10,At( ' cComercialv := STRTRAN(cComercialv, ",", ".") //Dólar Turismo cResp := SubStr( cResp1 , At( 'Dólar turismo cResp := Substr( cResp , At( ' ', cResp ) ) cTurismoc := Substr( cResp ,5,At( ' ', cResp )-4) cTurismoc := STRTRAN(cTurismoc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cTurismov := Substr( cResp ,10,At( ' cTurismov := STRTRAN(cTurismov, ",", ".") //Dólar Paralelo cResp := SubStr( cResp1 , At( 'Dólar paralelo cResp := Substr( cResp , At( ' ', cResp ) ) cParaleloc := Substr( cResp ,5,At( ' ', cResp )-4) cParaleloc := STRTRAN(cParaleloc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cParalelov := Substr( cResp ,10,At( ' cParalelov := STRTRAN(cParalelov, ",", ".") //Euro cResp := SubStr( cResp1 , At( 'Euro cResp := Substr( cResp , At( ' ', cResp ) ) cEuroc := Substr( cResp ,5,At( ' ', cResp )-4) cEuroc := STRTRAN(cEuroc, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cEurov := Substr( cResp ,10,At( ' cEurov := STRTRAN(cEurov, ",", ".") //Libra cResp := SubStr( cResp1 , At( 'Libra cResp := Substr( cResp , At( ' ', cResp ) ) cLibrac := Substr( cResp ,5,At( ' ', cResp )-4) cLibrac := STRTRAN(cLibrac, ",", ".") cResp := Substr( cResp , At( ' ', cResp ) ) cLibrav := Substr( cResp ,10,At( ' cLibrav := STRTRAN(cLibrav, ",", ".") //Data cResp := Substr( cResp, At( 'data-hora', cResp )+11 ) cData := Substr( cResp, 1,At( ' ', cResp )-1 ) cResp := "Dólar Comercial Compra "+Tran(Val(cComercialc),"@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cComercialv),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Dólar Turidmo Compra "+Tran(Val(cTurismoc), "@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cTurismov),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Dólar Paralelo Compra "+Tran(Val(cParaleloc), "@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cParalelov),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Euro Compra "+Tran(Val(cEuroc),"@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cEurov),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Libra Compra "+Tran(Val(cLibrac),"@E R$ 999,999.9999")+CRLF+; " Venda "+Tran(Val(cLibrav),"@E R$ 999,999.9999")+CRLF+; ""+CRLF+; "Última Atualização em "+Tran(cData,"@D") MSGINFO(cResp) Return cResp function gettasks() return nil Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  5. DonJuan
    Que Deus possa te confortar pela perda. Que vai estar contigo nas horas em que precisar!! Ele te ama e concerteza ama ela também!! Deus te abençõe em nome de Jesus!! Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  6. DonJuan
    citação:Boa tarde DonJuan!!! Esta rotina é muito boa para termos uma idéia de como fazer porque ela não funcional. Faltam o arquivo .CH e algumas funções estão ausentes. Muito Grato Sds José Carlos - ZECA fwh612(Free)-clipper52e-blinker 7.0 - six 3.02 - Windows XP id=quote>id=quote>Mande e-mail para mim que te mando o res e os chs necessários Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  7. DonJuan
    Estou enviando pra quem gosta de Sgdb e precisa de um backup prontinho pra jogar suas informações para um arquivo texto, podendo restaurar conforme queira /****************************************************************************** * Sistema .....: PROJETO_PRINCIPAL * Programa ....: BKPRST.PRG * Autor .......: ALESSANDRO * Sintese .....: RESP. PELA ADMIN. DO SISTEMA * Data ........: 5/29/2010 às 6:38:50 PM * Revisado em .: 5/29/2010 às 6:38:50 PM ******************************************************************************/ #include "SYSTEMA.CH" /*******************************************************************************/ STATIC aBase *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION BKPRST() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 aBase:={} FOR nX:=1 TO LEN(aMods) IF !EMPTY(aMods[nX,5]) AADD(aBase,{aMods[nX,1],aMods[nX,2],aMods[nX,3],aMods[nX,4],aMods[nX,5]}) ENDIF NEXT aDat[ 1]:=SPACE(255) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aBase) IF SR_EXISTTABLE(aBase[nX,5]) cComm:= " SELECT * FROM "+aBase[nX,5]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aBase[nX,5]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO ELSE MSGINFO(" ESTA TABELA NÃO EXISTE "+aBase[nX,5],"ATENÇÃO") ENDIF NEXT AADD(aFONTE2,{(""),(""),(0),(0)}) DEFINE DIALOG oDbkp RESOURCE "BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE FOLDER oFld ID 1000 OF oDbkp ; PROMPTS "Criar Backups","Restaurar Backups" ; DIALOGS "G_BACKUP","I_BACKUP" oBlbx := TXBrowse():New( oFld:aDialogs[1] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 1] VAR aDat[ 1] ID 101 OF oFld:aDialogs[1]; ACTION (aDat[ 1] := cGetDir( "Selecione uma pasta ",".\odonto", CurDrive() + ":\" + GetCurDir() ),oDat[ 1]:REFRESH() ) REDEFINE SAY oSay1 VAR cSay1 ID 104 OF oFld:aDialogs[1] REDEFINE SAY oSay2 VAR cSay2 ID 105 OF oFld:aDialogs[1] REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 103 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[1] ACTION IF(!EMPTY(aDat[ 1]),BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[1] ACTION oDbkp:End() CANCEL // 2 FOLHA DE RESTAURAÇÃO DE ARQUIVOS oBlbx := TXBrowse():New( oFld:aDialogs[2] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE2, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 2] VAR aDat[ 2] ID 101 OF oFld:aDialogs[2]; ACTION (aDat[ 2] := cGetfile32("*.SQL | ", "Selecione o Arquivo de Backups",,.f.),BUSCA_BKP(aDat,@aFONTE2,oBlbx),oDat[ 2]:REFRESH() ) REDEFINE SAY oSay3 VAR cSay3 ID 104 OF oFld:aDialogs[2] REDEFINE SAY oSay4 VAR cSay4 ID 105 OF oFld:aDialogs[2] REDEFINE METER oMtr3 VAR nPor3 TOTAL 100 ID 102 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr4 VAR nPor4 TOTAL 100 ID 103 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[2] ACTION IF(!EMPTY(aDat[ 2]),BACKUP_GERA(2,aFONTE2, oMtr3, oMtr4, @nPor3, @nPor4, oSay3, oSay4, @cSay3, @cSay4,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[2] ACTION oDbkp:End() CANCEL ACTIVATE DIALOG oDbkp CENTERED RETURN NIL *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION CHKBKP() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 IF Secs( TIME() ) >= Secs( cHorBkp ) .AND. DATE() > dDatBkp .AND. DIABKP()==.T. oTimer:Deactivate() aDat[ 1]:=ALLTRIM(cDesBkp) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aBase) cComm:= " SELECT * FROM "+aBase[nX,5]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aBase[nX,5]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO NEXT DEFINE DIALOG oDbkp RESOURCE "CHK_BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT oBlbx := TXBrowse():New( oDbkp ) oBlbx:CreateFromResource(1000) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE SAY oSay1 VAR cSay1 ID 101 OF oDbkp REDEFINE SAY oSay2 VAR cSay2 ID 103 OF oDbkp REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oDbkp COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 104 OF oDbkp COLOR CLR_WHITE, CLR_BLACK ACTIVATE DIALOG oDbkp NOWAIT CENTERED (BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),; MSGINFO("Backup Concluído","Atenção"),oDbkp:End(),; cCodiSQl:="UPDATE CONFIGURACAO SET DATBKP = '"+DTOS(DATE())+"'", apCode := SR_SQLParse( cCodiSQl ), oSql := SR_GetConnection(),; oSql:exec( SR_SQLCodeGen( apCode, {}, oSql:nSystemID ) ), dDatBkp:=DATE(), oTimer:activate() ) ELSE ENDIF RETURN NIL ********************************************************** STATIC FUNCTION DIABKP() ********************************************************** LOCAL lConcede:=.F. DO CASE CASE CtoDoW( CDoW( DATE() ) ) = 2 lConcede:=lSeg CASE CtoDoW( CDoW( DATE() ) ) = 3 lConcede:=lTer CASE CtoDoW( CDoW( DATE() ) ) = 4 lConcede:=lQua CASE CtoDoW( CDoW( DATE() ) ) = 5 lConcede:=lQui CASE CtoDoW( CDoW( DATE() ) ) = 6 lConcede:=lSex CASE CtoDoW( CDoW( DATE() ) ) = 7 lConcede:=lSab CASE CtoDoW( CDoW( DATE() ) ) = 1 lConcede:=lDom ENDCASE RETURN lConcede ********************************************************** STATIC FUNCTION BUSCA_BKP(aDat,aFONTE2,oBlbx) ********************************************************** LOCAL oTXT, cLinha, cTabela, aStrutura_OUT,nReg:=0, aTokens, nBd:=0 aFONTE2:={} aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" .AND. cTabela <> StrTran( aTokens, "TB-" ) IF !EMPTY(cTabela) AADD(aFONTE2,{nBd,cTabela,nReg,0}) ENDIF nBd+=1 cTabela:=StrTran( aTokens, "TB-" ) nReg:=0 ENDIF IF SUBSTR(aTokens,1,3) == "RG-" nReg+=1 ENDIF NEXT AADD(aFONTE2,{nBd,cTabela ,nReg,0}) //AADD(aFONTE2,{(""),(cTabela),(nReg),(0)}) oBlbx:SetArray( aFONTE2, .t., ,{1,2,3,4} ) oBlbx:aCols[1]:cHeader := "-" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 25 oBlbx:aCols[2]:cHeader := "TABELA" oBlbx:aCols[2]:cEditPicture := "@!" oBlbx:aCols[2]:nDataStrAlign := AL_LEFT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[2]:nWiDTH := 150 oBlbx:aCols[3]:cHeader := "TOT REGISTRO" oBlbx:aCols[3]:cEditPicture := "@E 999,999,999" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER oBlbx:aCols[4]:cHeader := "STATUS" oBlbx:aCols[4]:cEditPicture := "@E 9" oBlbx:aCols[4]:nDataStrAlign := AL_RIGHT oBlbx:aCols[4]:nHeadStrAlign := AL_CENTER oBlbx:Refresh() RETURN NIL ********************************************************** STATIC FUNCTION BACKUP_GERA(nMOD,aFONTEx, oMtr1, oMtr2, nPor1, nPor2, oSay1, oSay2, cSay1, cSay2,aDat) ********************************************************** LOCAL nX:=0, nTot1, nTot2, nF1, nF2, nT1, nT2, cArquivo, lDel:=.F. ,cErros:="" LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens, aToken_Rg LOCAL oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle, cNome_Arquivo:=SPACE(255), lResp:=.F. nF1:=0; nF2:=0; nT1:=0; nT2:=0; nTot1:=LEN(aFONTEx); nTot2:=0 SysRefresh() IF nMOD == 1 FOR nX:=1 TO LEN(aFONTEx) cSay1:="Fazendo Cópia do Arquivo: "+aFONTEx[nX,2] oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 // IDENTIFICA A TABELA E FAZ UMA SELEÇÃO DA MESMA cArquivo:=aFONTEx[nX,2] cComm:= " SELECT * FROM "+cArquivo+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") // INICA O SCRIPT DO ARQUIVOS DE BACKUP E COPIA A ESTRUTURA DA TABELA cBACKUP+="TB-"+cArquivo+Chr(10) aStrutura_INI:={} FOR n := 1 TO TB_ARQUIVO->(FCount()) AEval( PEGAESTRUTURA( n, aFStruct,@cBACKUP,@aStrutura_INI ), {|x| TB_ARQUIVO->(QOut( x )) } ) NEXT // AQUI ELE PEGA OS REGISTROS E JOGA NO ARQUIVO nTot2:=TB_ARQUIVO->(LASTREC()) TB_ARQUIVO->(DBGOTOP()) DO WHILE TB_ARQUIVO->(!EOF()) cBACKUP+="RG-" FOR nI:=1 TO LEN(aStrutura_INI) IF nI == LEN(aStrutura_INI) cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+Chr(10) lResp:=.T. ELSE cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C", ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+"|" ENDIF NEXT nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF TB_ARQUIVO->(DBSKIP()) ENDDO CLOSE TB_ARQUIVO NEXT // FAZENDO A GRAVAÇÃO DA COPIA cNome_Arquivo:=aDat[1]+"\"+cNomTab+"_"+alltrim(cConnTipo)+"_BKP_"+SUBSTR(DTOC(DATE()),1,2)+"-"+SUBSTR(DTOC(DATE()),4,2)+"-"+SUBSTR(DTOC(DATE()),7,4)+"_"+SUBSTR(TIME(),1,2)+"-"+SUBSTR(TIME(),4,2)+"-"+SUBSTR(TIME(),7,2)+".SQL" //MemoWrit(ALLTRIM(cNome_Arquivo) , cBACKUP ) MemoWrit(ALLTRIM(cNome_Arquivo) , StrTran( cBACKUP, '"' ) ) // CHECANDO A INTEGRIDADE DO ARQUIVO oTXT:=TTxtFile():New( cNome_Arquivo ) while !oTXT:lEof cLinha:= oTXT:cLine IF SUBSTR(cLinha,1,3) <> "TB-" .AND. SUBSTR(cLinha,1,3) == "ES-" .AND. SUBSTR(cLinha,1,3) == "RG-" MSGINFO("ERRO" ) ENDIF oTXT:Skip(1) ENDDO oTXT:Close() cSay1:="Cópia Feita Com Sucesso. Arquivo : "+ALLTRIM(cNome_Arquivo) cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() ELSEIF nMOD == 2 // ESTE MÓDULO É O DE RESTAURAÇÃO DO BACKUP SR_BeginTransaction() // TRY aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" aStrutura_OUT:={} cTabela:=StrTran( aTokens, "TB-" ) lDel:=.T. cSay1:="Restaurando Cópia de Segurança: Arquivo "+cTabela oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 nTot2:=aFONTEx[nF1,3] ENDIF IF SUBSTR(aTokens,1,3) == "ES-" aToken_Rg := HB_ATokens( StrTran( aTokens, "ES-" ), "|", .F., .F. ) AADD(aStrutura_OUT, { aToken_Rg[1], aToken_Rg[2], VAL(aToken_Rg[3]), VAL(aToken_Rg[4]) } ) ENDIF IF SUBSTR(aTokens,1,3) == "RG-" IF SR_ExistTable( cTabela ) .AND. lDel==.T. SR_DropTable( cTabela ) DBCreate( cTabela, aStrutura_OUT, "SqlRdd" ) lDel:=.F. ENDIF aToken_Rg := HB_ATokens( StrTran( aTokens, "RG-" ), "|", .F., .F. ) SCRIPT_SALVARSQL2(1, cTabela, aStrutura_OUT,aToken_Rg,@cErros) nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF ENDIF NEXT cSay1:="Aguarde... " cSay2:="Organizando Registros...: " oSay1:Refresh() oSay2:Refresh() VERIFICA_TABELAS(.T.) /* CATCH oErr MemoWrit("ERRO_BACKUP.LOG" , cErros ) SR_RollBackTransaction() MSGALERT("Ocorreram alguns erros durante o processo!"+CRLF+; "Para proteção do sistema e das informações,"+CRLF+; "esse processo será abortado."+CRLF+; +CRLF+CRLF+cErros+CRLF+CRLF+; "Comunique ao Suport o Problema" ,"Erro no Sistema") quit FINALLY SR_CommitTransaction() END */ ENDIF cSay1:="Cópia Restaurada Com Sucesso. " cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() REG_AUDITOR(cUSU_LOGIN,"INICIOU","MOD. DE BACKUP E RESTAURAÇÃO",IF(nMOD==1,"BACKUP","RESTAURAR"),cNome_Arquivo) RETURN .T. //--//--// function Parse( cInput, cSep ) local cOutput local k DEFAULT cSep := ';' k := At( cSep, cInput ) if k > 0 cOutput := AllTrim( SubStr( cInput, 1, k-1 ) ) cInput := AllTrim( SubStr( cInput, k+1 ) ) else cOutput := Trim( cInput ) cInput := '' endif RETURN cOutput *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION PEGAESTRUTURA( nFieldPos, aFStruct,cBACKUP,aStrutura_INI ) aFStruct[DBS_NAME] := DbFieldInfo( DBS_NAME, nFieldPos ) aFStruct[DBS_TYPE] := DbFieldInfo( DBS_TYPE, nFieldPos ) aFStruct[DBS_LEN ] := DbFieldInfo( DBS_LEN , nFieldPos ) aFStruct[DBS_DEC ] := DbFieldInfo( DBS_DEC , nFieldPos ) AADD( aStrutura_INI, { aFStruct[DBS_NAME], aFStruct[DBS_TYPE]} ) cBACKUP+="ES-"+ALLTRIM(aFStruct[DBS_NAME])+"|"+ALLTRIM(aFStruct[DBS_TYPE])+"|"+ALLTRIM(STR(aFStruct[DBS_LEN]))+"|"+ALLTRIM(STR(aFStruct[DBS_DEC]))+Chr(10) RETURN aFStruct *************************************************************************** FUNCTION SCRIPT_SALVARSQL2(nTIPO, cBANCO, aCampos, aGets,cErros) *************************************************************************** LOCAL cSCRIPT:=SPACE(500), nI:=0 IF nTIPO == 1 IF ALLTRIM(cConnTipo) == "FIREBIRD" USE &(cBANCO) ALIAS &cBANCO VIA "SQLRDD" &cBANCO->(DBAPPEND()) SELECT &cBANCO FOR nI:=1 TO LEN(aGets) REPLACE &cBANCO->&(aCampos[nI,1]) WITH IF(aCampos[nI,2]="D",StoD( aGets[nI] ),; IF(aCampos[nI,2]="N",VAL(aGets[nI]),; IF(aCampos[nI,2]="C",TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]),; IF(aCampos[nI,2]="L",IF(VAL(aGets[nI])==1,.T.,.F.),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ) ) ) ) NEXT &cBANCO->(DBCOMMIT()) CLOSE &cBANCO ELSE cSCRIPT:="INSERT INTO "+cBANCO+" (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+aCampos[nI,1]+") " ELSE cSCRIPT+=" "+aCampos[nI,1]+", " ENDIF NEXT /* cSCRIPT+=" VALUES (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+SR_cDBValue( DataConvert(cDado, cType, n_Tam) IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ) )+") " ELSE cSCRIPT+=" "+SR_cDBValue( IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2])) )+", " ENDIF NEXT */ cSCRIPT+=" VALUES (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+SR_cDBValue( DataConvert(aGets[nI], aCampos[nI,2], aCampos[nI,3], aCampos[nI,1] ) )+") " ELSE cSCRIPT+=" "+SR_cDBValue( DataConvert(aGets[nI], aCampos[nI,2], aCampos[nI,3], aCampos[nI,1] ) )+", " ENDIF NEXT apCode := SR_SQLParse(cSCRIPT) oSql := SR_GetConnection() oSql:exec( SR_SQLCodeGen( apCode, {,,}, oSql:nSystemID ) ) ENDIF ENDIF cErros:=cSCRIPT RETURN cSCRIPT STATIC FUNCTION DataConvert(cDado, cType, n_Tam,cCampo) LOCAL cNewFormat := cDado, cNovo IF cType = "C" cNewFormat := TIRA_ACENTUACAO(cDado,cType) ELSEIF cType = "D" IF EMPTY(cDado) cNewFormat := DATE() ELSE cNewFormat := cDado ENDIF ELSEIF cType = "L" cNewFormat := cDado ELSEIF cType = "M" cNewFormat := cDado ELSEIF cType = "N" cNewFormat := cDado ENDIF RETURN(cNewFormat) FUNCTION TIRA_ACENTUACAO( cStr,nTIpo ) local cStrNew := "", nX cAcentos := {"'",'"',"´","`","\"} cLetras := {"" ,"" ,"" ,"" ,"_"} For nX := 1 TO LEN(cAcentos) cStrNew := StrTran(cStr, cAcentos[nX], cLetras[nX]) cStr := cStrNew Next Return( cStrNew ) Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL" Editado por - DonJuan on 30/09/2011 14:40:41
  8. DonJuan
    Estou enviando pra quem gosta de Sgdb e precisa de um backup prontinho pra jogar suas informações para um arquivo texto, podendo restaurar conforme queira /****************************************************************************** * Sistema .....: PROJETO_PRINCIPAL * Programa ....: BKPRST.PRG * Autor .......: ALESSANDRO * Sintese .....: RESP. PELA ADMIN. DO SISTEMA * Data ........: 5/29/2010 às 6:38:50 PM * Revisado em .: 5/29/2010 às 6:38:50 PM ******************************************************************************/ #include "SYSTEMA.CH" /*******************************************************************************/ STATIC aBase *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION BKPRST() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 aBase:={} FOR nX:=1 TO LEN(aMods) IF !EMPTY(aMods[nX,5]) AADD(aBase,{aMods[nX,1],aMods[nX,2],aMods[nX,3],aMods[nX,4],aMods[nX,5]}) ENDIF NEXT aDat[ 1]:=SPACE(255) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aBase) IF SR_EXISTTABLE(aBase[nX,5]) cComm:= " SELECT * FROM "+aBase[nX,5]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aBase[nX,5]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO ELSE MSGINFO(" ESTA TABELA NÃO EXISTE "+aBase[nX,5],"ATENÇÃO") ENDIF NEXT AADD(aFONTE2,{(""),(""),(0),(0)}) DEFINE DIALOG oDbkp RESOURCE "BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE FOLDER oFld ID 1000 OF oDbkp ; PROMPTS "Criar Backups","Restaurar Backups" ; DIALOGS "G_BACKUP","I_BACKUP" oBlbx := TXBrowse():New( oFld:aDialogs[1] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 1] VAR aDat[ 1] ID 101 OF oFld:aDialogs[1]; ACTION (aDat[ 1] := cGetDir( "Selecione uma pasta ",".\odonto", CurDrive() + ":\" + GetCurDir() ),oDat[ 1]:REFRESH() ) REDEFINE SAY oSay1 VAR cSay1 ID 104 OF oFld:aDialogs[1] REDEFINE SAY oSay2 VAR cSay2 ID 105 OF oFld:aDialogs[1] REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 103 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[1] ACTION IF(!EMPTY(aDat[ 1]),BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[1] ACTION oDbkp:End() CANCEL // 2 FOLHA DE RESTAURAÇÃO DE ARQUIVOS oBlbx := TXBrowse():New( oFld:aDialogs[2] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE2, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 2] VAR aDat[ 2] ID 101 OF oFld:aDialogs[2]; ACTION (aDat[ 2] := cGetfile32("*.SQL | ", "Selecione o Arquivo de Backups",,.f.),BUSCA_BKP(aDat,@aFONTE2,oBlbx),oDat[ 2]:REFRESH() ) REDEFINE SAY oSay3 VAR cSay3 ID 104 OF oFld:aDialogs[2] REDEFINE SAY oSay4 VAR cSay4 ID 105 OF oFld:aDialogs[2] REDEFINE METER oMtr3 VAR nPor3 TOTAL 100 ID 102 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr4 VAR nPor4 TOTAL 100 ID 103 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[2] ACTION IF(!EMPTY(aDat[ 2]),BACKUP_GERA(2,aFONTE2, oMtr3, oMtr4, @nPor3, @nPor4, oSay3, oSay4, @cSay3, @cSay4,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[2] ACTION oDbkp:End() CANCEL ACTIVATE DIALOG oDbkp CENTERED RETURN NIL *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION CHKBKP() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 IF Secs( TIME() ) >= Secs( cHorBkp ) .AND. DATE() > dDatBkp .AND. DIABKP()==.T. oTimer:Deactivate() aDat[ 1]:=ALLTRIM(cDesBkp) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aBase) cComm:= " SELECT * FROM "+aBase[nX,5]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aBase[nX,5]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO NEXT DEFINE DIALOG oDbkp RESOURCE "CHK_BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT oBlbx := TXBrowse():New( oDbkp ) oBlbx:CreateFromResource(1000) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE SAY oSay1 VAR cSay1 ID 101 OF oDbkp REDEFINE SAY oSay2 VAR cSay2 ID 103 OF oDbkp REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oDbkp COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 104 OF oDbkp COLOR CLR_WHITE, CLR_BLACK ACTIVATE DIALOG oDbkp NOWAIT CENTERED (BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),; MSGINFO("Backup Concluído","Atenção"),oDbkp:End(),; cCodiSQl:="UPDATE CONFIGURACAO SET DATBKP = '"+DTOS(DATE())+"'", apCode := SR_SQLParse( cCodiSQl ), oSql := SR_GetConnection(),; oSql:exec( SR_SQLCodeGen( apCode, {}, oSql:nSystemID ) ), dDatBkp:=DATE(), oTimer:activate() ) ELSE ENDIF RETURN NIL ********************************************************** STATIC FUNCTION DIABKP() ********************************************************** LOCAL lConcede:=.F. DO CASE CASE CtoDoW( CDoW( DATE() ) ) = 2 lConcede:=lSeg CASE CtoDoW( CDoW( DATE() ) ) = 3 lConcede:=lTer CASE CtoDoW( CDoW( DATE() ) ) = 4 lConcede:=lQua CASE CtoDoW( CDoW( DATE() ) ) = 5 lConcede:=lQui CASE CtoDoW( CDoW( DATE() ) ) = 6 lConcede:=lSex CASE CtoDoW( CDoW( DATE() ) ) = 7 lConcede:=lSab CASE CtoDoW( CDoW( DATE() ) ) = 1 lConcede:=lDom ENDCASE RETURN lConcede ********************************************************** STATIC FUNCTION BUSCA_BKP(aDat,aFONTE2,oBlbx) ********************************************************** LOCAL oTXT, cLinha, cTabela, aStrutura_OUT,nReg:=0, aTokens, nBd:=0 aFONTE2:={} aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" .AND. cTabela <> StrTran( aTokens, "TB-" ) IF !EMPTY(cTabela) AADD(aFONTE2,{nBd,cTabela,nReg,0}) ENDIF nBd+=1 cTabela:=StrTran( aTokens, "TB-" ) nReg:=0 ENDIF IF SUBSTR(aTokens,1,3) == "RG-" nReg+=1 ENDIF NEXT AADD(aFONTE2,{nBd,cTabela ,nReg,0}) //AADD(aFONTE2,{(""),(cTabela),(nReg),(0)}) oBlbx:SetArray( aFONTE2, .t., ,{1,2,3,4} ) oBlbx:aCols[1]:cHeader := "-" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 25 oBlbx:aCols[2]:cHeader := "TABELA" oBlbx:aCols[2]:cEditPicture := "@!" oBlbx:aCols[2]:nDataStrAlign := AL_LEFT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[2]:nWiDTH := 150 oBlbx:aCols[3]:cHeader := "TOT REGISTRO" oBlbx:aCols[3]:cEditPicture := "@E 999,999,999" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER oBlbx:aCols[4]:cHeader := "STATUS" oBlbx:aCols[4]:cEditPicture := "@E 9" oBlbx:aCols[4]:nDataStrAlign := AL_RIGHT oBlbx:aCols[4]:nHeadStrAlign := AL_CENTER oBlbx:Refresh() RETURN NIL ********************************************************** STATIC FUNCTION BACKUP_GERA(nMOD,aFONTEx, oMtr1, oMtr2, nPor1, nPor2, oSay1, oSay2, cSay1, cSay2,aDat) ********************************************************** LOCAL nX:=0, nTot1, nTot2, nF1, nF2, nT1, nT2, cArquivo, lDel:=.F. ,cErros:="" LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens, aToken_Rg LOCAL oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle, cNome_Arquivo:=SPACE(255), lResp:=.F. nF1:=0; nF2:=0; nT1:=0; nT2:=0; nTot1:=LEN(aFONTEx); nTot2:=0 SysRefresh() IF nMOD == 1 FOR nX:=1 TO LEN(aFONTEx) cSay1:="Fazendo Cópia do Arquivo: "+aFONTEx[nX,2] oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 // IDENTIFICA A TABELA E FAZ UMA SELEÇÃO DA MESMA cArquivo:=aFONTEx[nX,2] cComm:= " SELECT * FROM "+cArquivo+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") // INICA O SCRIPT DO ARQUIVOS DE BACKUP E COPIA A ESTRUTURA DA TABELA cBACKUP+="TB-"+cArquivo+Chr(10) aStrutura_INI:={} FOR n := 1 TO TB_ARQUIVO->(FCount()) AEval( PEGAESTRUTURA( n, aFStruct,@cBACKUP,@aStrutura_INI ), {|x| TB_ARQUIVO->(QOut( x )) } ) NEXT // AQUI ELE PEGA OS REGISTROS E JOGA NO ARQUIVO nTot2:=TB_ARQUIVO->(LASTREC()) TB_ARQUIVO->(DBGOTOP()) DO WHILE TB_ARQUIVO->(!EOF()) cBACKUP+="RG-" FOR nI:=1 TO LEN(aStrutura_INI) IF nI == LEN(aStrutura_INI) cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+Chr(10) lResp:=.T. ELSE cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C", ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+"|" ENDIF NEXT nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF TB_ARQUIVO->(DBSKIP()) ENDDO CLOSE TB_ARQUIVO NEXT // FAZENDO A GRAVAÇÃO DA COPIA cNome_Arquivo:=aDat[1]+"\"+cNomTab+"_"+alltrim(cConnTipo)+"_BKP_"+SUBSTR(DTOC(DATE()),1,2)+"-"+SUBSTR(DTOC(DATE()),4,2)+"-"+SUBSTR(DTOC(DATE()),7,4)+"_"+SUBSTR(TIME(),1,2)+"-"+SUBSTR(TIME(),4,2)+"-"+SUBSTR(TIME(),7,2)+".SQL" //MemoWrit(ALLTRIM(cNome_Arquivo) , cBACKUP ) MemoWrit(ALLTRIM(cNome_Arquivo) , StrTran( cBACKUP, '"' ) ) // CHECANDO A INTEGRIDADE DO ARQUIVO oTXT:=TTxtFile():New( cNome_Arquivo ) while !oTXT:lEof cLinha:= oTXT:cLine IF SUBSTR(cLinha,1,3) <> "TB-" .AND. SUBSTR(cLinha,1,3) == "ES-" .AND. SUBSTR(cLinha,1,3) == "RG-" MSGINFO("ERRO" ) ENDIF oTXT:Skip(1) ENDDO oTXT:Close() cSay1:="Cópia Feita Com Sucesso. Arquivo : "+ALLTRIM(cNome_Arquivo) cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() ELSEIF nMOD == 2 // ESTE MÓDULO É O DE RESTAURAÇÃO DO BACKUP SR_BeginTransaction() // TRY aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" aStrutura_OUT:={} cTabela:=StrTran( aTokens, "TB-" ) lDel:=.T. cSay1:="Restaurando Cópia de Segurança: Arquivo "+cTabela oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 nTot2:=aFONTEx[nF1,3] ENDIF IF SUBSTR(aTokens,1,3) == "ES-" aToken_Rg := HB_ATokens( StrTran( aTokens, "ES-" ), "|", .F., .F. ) AADD(aStrutura_OUT, { aToken_Rg[1], aToken_Rg[2], VAL(aToken_Rg[3]), VAL(aToken_Rg[4]) } ) ENDIF IF SUBSTR(aTokens,1,3) == "RG-" IF SR_ExistTable( cTabela ) .AND. lDel==.T. SR_DropTable( cTabela ) DBCreate( cTabela, aStrutura_OUT, "SqlRdd" ) lDel:=.F. ENDIF aToken_Rg := HB_ATokens( StrTran( aTokens, "RG-" ), "|", .F., .F. ) SCRIPT_SALVARSQL2(1, cTabela, aStrutura_OUT,aToken_Rg,@cErros) nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF ENDIF NEXT cSay1:="Aguarde... " cSay2:="Organizando Registros...: " oSay1:Refresh() oSay2:Refresh() VERIFICA_TABELAS(.T.) /* CATCH oErr MemoWrit("ERRO_BACKUP.LOG" , cErros ) SR_RollBackTransaction() MSGALERT("Ocorreram alguns erros durante o processo!"+CRLF+; "Para proteção do sistema e das informações,"+CRLF+; "esse processo será abortado."+CRLF+; +CRLF+CRLF+cErros+CRLF+CRLF+; "Comunique ao Suport o Problema" ,"Erro no Sistema") quit FINALLY SR_CommitTransaction() END */ ENDIF cSay1:="Cópia Restaurada Com Sucesso. " cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() REG_AUDITOR(cUSU_LOGIN,"INICIOU","MOD. DE BACKUP E RESTAURAÇÃO",IF(nMOD==1,"BACKUP","RESTAURAR"),cNome_Arquivo) RETURN .T. //--//--// function Parse( cInput, cSep ) local cOutput local k DEFAULT cSep := ';' k := At( cSep, cInput ) if k > 0 cOutput := AllTrim( SubStr( cInput, 1, k-1 ) ) cInput := AllTrim( SubStr( cInput, k+1 ) ) else cOutput := Trim( cInput ) cInput := '' endif RETURN cOutput *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION PEGAESTRUTURA( nFieldPos, aFStruct,cBACKUP,aStrutura_INI ) aFStruct[DBS_NAME] := DbFieldInfo( DBS_NAME, nFieldPos ) aFStruct[DBS_TYPE] := DbFieldInfo( DBS_TYPE, nFieldPos ) aFStruct[DBS_LEN ] := DbFieldInfo( DBS_LEN , nFieldPos ) aFStruct[DBS_DEC ] := DbFieldInfo( DBS_DEC , nFieldPos ) AADD( aStrutura_INI, { aFStruct[DBS_NAME], aFStruct[DBS_TYPE]} ) cBACKUP+="ES-"+ALLTRIM(aFStruct[DBS_NAME])+"|"+ALLTRIM(aFStruct[DBS_TYPE])+"|"+ALLTRIM(STR(aFStruct[DBS_LEN]))+"|"+ALLTRIM(STR(aFStruct[DBS_DEC]))+Chr(10) RETURN aFStruct *************************************************************************** FUNCTION SCRIPT_SALVARSQL2(nTIPO, cBANCO, aCampos, aGets,cErros) *************************************************************************** LOCAL cSCRIPT:=SPACE(500), nI:=0 IF nTIPO == 1 IF ALLTRIM(cConnTipo) == "FIREBIRD" USE &(cBANCO) ALIAS &cBANCO VIA "SQLRDD" &cBANCO->(DBAPPEND()) SELECT &cBANCO FOR nI:=1 TO LEN(aGets) REPLACE &cBANCO->&(aCampos[nI,1]) WITH IF(aCampos[nI,2]="D",StoD( aGets[nI] ),; IF(aCampos[nI,2]="N",VAL(aGets[nI]),; IF(aCampos[nI,2]="C",TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]),; IF(aCampos[nI,2]="L",IF(VAL(aGets[nI])==1,.T.,.F.),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ) ) ) ) NEXT &cBANCO->(DBCOMMIT()) CLOSE &cBANCO ELSE cSCRIPT:="INSERT INTO "+cBANCO+" (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+aCampos[nI,1]+") " ELSE cSCRIPT+=" "+aCampos[nI,1]+", " ENDIF NEXT /* cSCRIPT+=" VALUES (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+SR_cDBValue( DataConvert(cDado, cType, n_Tam) IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ) )+") " ELSE cSCRIPT+=" "+SR_cDBValue( IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2])) )+", " ENDIF NEXT */ cSCRIPT+=" VALUES (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+SR_cDBValue( DataConvert(aGets[nI], aCampos[nI,2], aCampos[nI,3], aCampos[nI,1] ) )+") " ELSE cSCRIPT+=" "+SR_cDBValue( DataConvert(aGets[nI], aCampos[nI,2], aCampos[nI,3], aCampos[nI,1] ) )+", " ENDIF NEXT apCode := SR_SQLParse(cSCRIPT) oSql := SR_GetConnection() oSql:exec( SR_SQLCodeGen( apCode, {,,}, oSql:nSystemID ) ) ENDIF ENDIF cErros:=cSCRIPT RETURN cSCRIPT STATIC FUNCTION DataConvert(cDado, cType, n_Tam,cCampo) LOCAL cNewFormat := cDado, cNovo IF cType = "C" cNewFormat := TIRA_ACENTUACAO(cDado,cType) ELSEIF cType = "D" IF EMPTY(cDado) cNewFormat := DATE() ELSE cNewFormat := cDado ENDIF ELSEIF cType = "L" cNewFormat := cDado ELSEIF cType = "M" cNewFormat := cDado ELSEIF cType = "N" cNewFormat := cDado ENDIF RETURN(cNewFormat) FUNCTION TIRA_ACENTUACAO( cStr,nTIpo ) local cStrNew := "", nX cAcentos := {"'",'"',"´","`","\"} cLetras := {"" ,"" ,"" ,"" ,"_"} For nX := 1 TO LEN(cAcentos) cStrNew := StrTran(cStr, cAcentos[nX], cLetras[nX]) cStr := cStrNew Next Return( cStrNew ) Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL" Editado por - DonJuan on 30/09/2011 14:40:41
  9. DonJuan
    citação:DonJuan (alessandroavel@ibest.com.br) Por gentileza responda meus e-mails, fale comigo no msn. Aos demais colegas me desculpe por este post, mas é importante. Cleiton Cleiton FWH906+xHarbour 1.2.1+WorkShop,PellesC, FW20d+Clipper5.2+Clip53b id=quote>id=quote>Respondido Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  10. DonJuan
    citação:quem já fez esse trabalho de migrar do mysql 5.0 para firebird....? a sqllib tambem tem suporte para firebird? minha base hj é mysql ... tou querendo mudar para firebird? fw10.8harbour-xDev.70 Studio-bcc582-Mysql-Pelles programadorcp80@hotmail.com.br ; id=quote>id=quote>Olá amigo dou suporte para mudança de banco de dados como firebird e Posgres entre em contato pelo msn alessandroavel@ibest.com.br Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  11. DonJuan
    citação:Estou super interessado em converter meus sistema clipper em Fivewin(?). Estrou com problemas pois sistema clipper nao rodam (infelizmente)no WIN7 64 bits. Mas estou com muitas duvidas. Fala-se de fivewin,harbour,xharbour. Qual é a LP e o compilador? Onde encontro algum manual dos comando de programação?. Como compilar,linkar etc. Grato pela atenção e compreensão. id=quote>id=quote>Se tiver interessado em adquirir aulas e suporte para aprender a migrar de Clipper para Fivewin bem como usando bancos de dados SQL, tipo como Postgres/Firebird /MySql entre em contato no meu MSN: alessandroavel@ibest.con.br Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  12. DonJuan
    citação: Gostaria de saber se tem alguem aqui no forum que tem sistema completo de transportadora? fw10.8harbour-xDev.70 Studio-bcc582-Mysql-Pelles programadorcp80@hotmail.com.br ; id=quote>id=quote>Eu tenho amigo O que vc precisa? MEU MSN : alessandroavel@ibest.com.br Editado por - DonJuan on 26/04/2011 08:28:55
  13. DonJuan
    Postei em dicas um atualizador de bancos SGDB, muitos amigos tem trabalho na hora de migrar as informações de seus dbfs de programas antigos, esta ai a soluçao. Migra tanto para postgres, mysql e Firebird Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  14. DonJuan
    Postei em dicas um atualizador de bancos SGDB, muitos amigos tem trabalho na hora de migrar as informações de seus dbfs de programas antigos, esta ai a soluçao. Migra tanto para postgres, mysql e Firebird Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  15. DonJuan
    citação:Bom dia ! Programo em Clipper a 23 anos e quero agora mudar para fivewin, gostaria de obter ajuda neste processo de migração. Como começar ? A versão Demo serve para aprendizado ? Onde encontrar o livro e ele vale o custo ? (No site Fivewin Brasil é impossível) Obrigado. Marcelo Mendes id=quote>id=quote>Olá amigo!! Boa Tarde Estou dando curso via remoto para os amigos que querem sair do clipper e entrar no Fivewin! Inclusive também com acesso a bancos de dados postgres, mysql e firebird Me adcione no MSN para mais informações MSN: alessandroavel@ibest.com.br Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL" Editado por - DonJuan on 29/03/2011 12:36:15
  16. DonJuan
    citação:Boa Tarde!!! Voce postou uma dica com senha. Como fazr para verificar o demo postado? Grato Sds José Carlos - ZECA fwh612(Free)-clipper52e-blinker 7.0 - six 3.02 - Windows XP id=quote>id=quote>Desculpe-me, a senha é 120775, meu email e msn é alessandroavel@ibest.com.br Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  17. DonJuan
    citação:PESSOAL VEJO TANTAS DISCURSSOES SOBRE BANCO DE DADOS QUAL SERIA O MELHOR BANCO PARA SAIR DO DBF SEM TER QUE MEXER MUITO EM PROGRAMA OBRIGADO FW24 + CLIP5_2 email :edutraini@uol.com.br id=quote>id=quote>APRENDA A PROGRAMAR COM BANCOS DE DADOS, MYSQL/FIREBIRD E POSTGRES EM 10 HORAS, VIA REMOTO. NO HORÃRIO EM QUE VOCÊ DISPÔE DE TEMPO! APRENDA: 1 - INSTALAÇÃO E MANUTENÇÃO DE BANCOS SGDB 2 - APLICAÇÃO DO BANCO DE DADOS NA PROGRAMAÇÃO FIVEWIN/XHABROUR, CRIAÇÃO DE BANCO DE DADOS, CRIAÇÃO DE TABELAS E INDICES 3 - INSERINDO, ALTERANDO E EXCLUINDO REGISTROS COM CÓDIGOS XBASE 4 - INSERINDO, ALTERANDO E EXCLUINDO REGISTROS COM CÓDIGOS NATIVOS SQL SEM ABRIR TABELAS OU BANCO 5 - APRENDENDO A FAZER QUERYS, COM UMA TABELA E MAIS DE UMA TABELA, UTILIZANDO METODO JOIN. ESTE É APENAS UM RESUMO DO SERà VISTO! SÃO 10 HORAS NECESSÃRIOS PARA QUE VC APRENDA!! SAIA DO DBF, TENHA MAIS SOSSEGO! E DÊ SEGURANÇA E RAPIDEZ NAS INFORMAÇÕES AOS SEUS CLIENTES, E SAIA NA FRENTE! ENTRE EM CONTATO E MARQUE SEU HORÃRIO! EMAIL / MSN: alessandroavel@ibest.com.br Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  18. DonJuan
    citação:PESSOAL VEJO TANTAS DISCURSSOES SOBRE BANCO DE DADOS QUAL SERIA O MELHOR BANCO PARA SAIR DO DBF SEM TER QUE MEXER MUITO EM PROGRAMA OBRIGADO FW24 + CLIP5_2 email :edutraini@uol.com.br id=quote>id=quote>Da uma olhada neste link http://www.fivewin.com.br/forum/topic.asp?TOPIC_ID=18592 Acesse: http://programafontefivewin.blogspot.com/ FHW 10.8, XHB1.2.1, PELLESC 6.5, XDEV 7.2, FASTREPORT, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BANCOS SQL"
  19. DonJuan
    citação:Alguém conhece alguma maneira de trabalhar com arquivo FDB do firebird, seja com RDD ou sem RDD, se tiver um exemplo e postar aqui no fórun, fico grato. Cleiton FWH902+xHarbour 1.0.0+WorkShop, FW20d+Clipper5.2+Clip53b id=quote>id=quote>Acesse esse link http://www.fivewin.com.br/forum/topic.asp?TOPIC_ID=18592 Acesse: http://programafontefivewin.blogspot.com/ FHW 10.6, XHB1.2.1, PELLESC 6.0, XDEV 7.2, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BAMCOS SQL"
  20. DonJuan
    citação:Boa tarde a todos!!! Estou tentando instalar o MYSQL versao 5.xxx no windows 7, sem sucesso. A instalação ocorre normalmente até na hora em quem pede para executar como serviço. Ai dá o erro. Já tentei de tudo quanto foi jeito, inclusive desativei o Firewall, mas neca de birica. Parece que li em algum lugar que o MYSQL e o SEVEN "não se bicam de jeito nenhum". alguém sabe de alguma coisa? Olha que instalei o MYSQL como sempre faço, usando a formula do Vailton(apesar da mudança de algumas telas). A versão do MYSQL parace que é a ultima - retirei do site esta semana. Grato Sds José Carlos - ZECA fwh612(Free)-clipper52e-blinker 7.0 - six 3.02 - Windows XP id=quote>id=quote>Não é bem isso não amigo! Tenho em minha máquina o Windows 7 Com MySql 5.0 roda filé, o que deve estar acontecendo é algum conflito com os serviço, eu tive esse mesmo problemas e tive que reinstalar em um cliente de novo o windows 7, essa pode ser uma das causas Acesse: http://programafontefivewin.blogspot.com/ FHW 10.6, XHB1.2.1, PELLESC 6.0, XDEV 7.2, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BAMCOS SQL"
  21. DonJuan
    citação:Parabens pela iniciativa de disponibilizar esta rotina, com certeza vai ajudar muita gente, a começar por mim. Sem querer abusar da sua generosidade... será que vc pode disponibilizar tambem os RESOURCES e o SYSTEMA.CH? Mais uma, duas, tres e muitas vezes o meu obrigado!!! Em Cristo! Rone - Itajubá(MG) id=red>xHB build 1.1.0 (SimpLex) & BCC 5.5.1 & FW 7.12 + xDevStudio A pessoa que pensa que sabe alguma coisa, ainda não tem a sabedoria que precisa. (1 Cor 8, 2)id=blue> id=quote>id=quote>Passa no meu MSN que eu te arranjo Acesse: http://programafontefivewin.blogspot.com/ FHW 10.6, XHB1.2.1, PELLESC 6.0, XDEV 7.2, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BAMCOS SQL"
  22. DonJuan
    citação:luis quero mudar os botões ok fw10.8harbour-xDev.70 Studio-bcc582-Mysql-Pelles programadorcp80@hotmail.com.br ; id=quote>id=quote>Me add no MSN que eu te mando alessandroavel@ibest.com.br Acesse: http://programafontefivewin.blogspot.com/ FHW 10.6, XHB1.2.1, PELLESC 6.0, XDEV 7.2, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BAMCOS SQL"
  23. DonJuan
    Estou disponibilizando para os amigos o meu código de Backups e restoures, ele funcionando tanto para Bancos DBF, como Sgdb´s tais como firebird, MySql, MS Server, Oracle, Postgres e etc. Ele pega as informações criptografa para um arquivo texto, tornando leve para ser armazenado ou levado e atraves desse arquivos ele executa a restauração das informações. Valeu? Espero que os amigos aproveitem. /****************************************************************************** * Sistema .....: PROJETO_PRINCIPAL * Programa ....: BKPRST.PRG * Autor .......: ALESSANDRO AVELINO CAVALCANTE * Sintese .....: RESP. PELA ADMIN. DO SISTEMA * Data ........: 5/29/2010 às 6:38:50 PM * Revisado em .: 5/29/2010 às 6:38:50 PM ******************************************************************************/ #include "SYSTEMA.CH" /*******************************************************************************/ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION BKPRST() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 aDat[ 1]:=SPACE(255) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aArqs) cComm:= " SELECT * FROM "+aArqs[nX]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aArqs[nX]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO NEXT AADD(aFONTE2,{(""),(""),(0),(0)}) DEFINE DIALOG oDbkp RESOURCE "BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE FOLDER oFld ID 1000 OF oDbkp ; PROMPTS "Criar Backups","Restaurar Backups" ; DIALOGS "G_BACKUP","I_BACKUP" oBlbx := TXBrowse():New( oFld:aDialogs[1] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 1] VAR aDat[ 1] ID 101 OF oFld:aDialogs[1]; ACTION (aDat[ 1] := cGetDir( "Selecione uma pasta ",".\odonto", CurDrive() + ":\" + GetCurDir() ),oDat[ 1]:REFRESH() ) REDEFINE SAY oSay1 VAR cSay1 ID 104 OF oFld:aDialogs[1] REDEFINE SAY oSay2 VAR cSay2 ID 105 OF oFld:aDialogs[1] REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 103 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[1] ACTION IF(!EMPTY(aDat[ 1]),BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[1] ACTION oDbkp:End() CANCEL // 2 FOLHA DE RESTAURAÇÃO DE ARQUIVOS oBlbx := TXBrowse():New( oFld:aDialogs[2] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE2, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 2] VAR aDat[ 2] ID 101 OF oFld:aDialogs[2]; ACTION (aDat[ 2] := cGetfile32("*.SQL | ", "Selecione o Arquivo de Backups",,.f.),BUSCA_BKP(aDat,@aFONTE2,oBlbx),oDat[ 2]:REFRESH() ) REDEFINE SAY oSay3 VAR cSay3 ID 104 OF oFld:aDialogs[2] REDEFINE SAY oSay4 VAR cSay4 ID 105 OF oFld:aDialogs[2] REDEFINE METER oMtr3 VAR nPor3 TOTAL 100 ID 102 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr4 VAR nPor4 TOTAL 100 ID 103 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[2] ACTION IF(!EMPTY(aDat[ 2]),BACKUP_GERA(2,aFONTE2, oMtr3, oMtr4, @nPor3, @nPor4, oSay3, oSay4, @cSay3, @cSay4,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[2] ACTION oDbkp:End() CANCEL ACTIVATE DIALOG oDbkp CENTERED RETURN NIL *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION CHKBKP() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 IF Secs( TIME() ) >= Secs( cHorBkp ) .AND. DATE() > dDatBkp .AND. DIABKP()==.T. oTimer:Deactivate() aDat[ 1]:=ALLTRIM(cDesBkp) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aArqs) cComm:= " SELECT * FROM "+aArqs[nX]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aArqs[nX]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO NEXT DEFINE DIALOG oDbkp RESOURCE "CHK_BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT oBlbx := TXBrowse():New( oDbkp ) oBlbx:CreateFromResource(1000) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE SAY oSay1 VAR cSay1 ID 101 OF oDbkp REDEFINE SAY oSay2 VAR cSay2 ID 103 OF oDbkp REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oDbkp COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 104 OF oDbkp COLOR CLR_WHITE, CLR_BLACK ACTIVATE DIALOG oDbkp NOWAIT CENTERED (BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),; MSGINFO("Backup Concluído","Atenção"),oDbkp:End(),; cCodiSQl:="UPDATE CONFIGURACAO SET DATBKP = '"+DTOS(DATE())+"'", apCode := SR_SQLParse( cCodiSQl ), oSql := SR_GetConnection(),; oSql:exec( SR_SQLCodeGen( apCode, {}, oSql:nSystemID ) ), dDatBkp:=DATE(), oTimer:activate() ) ELSE ENDIF RETURN NIL ********************************************************** STATIC FUNCTION DIABKP() ********************************************************** LOCAL lConcede:=.F. DO CASE CASE CtoDoW( CDoW( DATE() ) ) = 2 lConcede:=lSeg CASE CtoDoW( CDoW( DATE() ) ) = 3 lConcede:=lTer CASE CtoDoW( CDoW( DATE() ) ) = 4 lConcede:=lQua CASE CtoDoW( CDoW( DATE() ) ) = 5 lConcede:=lQui CASE CtoDoW( CDoW( DATE() ) ) = 6 lConcede:=lSex CASE CtoDoW( CDoW( DATE() ) ) = 7 lConcede:=lSab CASE CtoDoW( CDoW( DATE() ) ) = 1 lConcede:=lDom ENDCASE RETURN lConcede ********************************************************** STATIC FUNCTION BUSCA_BKP(aDat,aFONTE2,oBlbx) ********************************************************** LOCAL oTXT, cLinha, cTabela, aStrutura_OUT,nReg:=0, aTokens, nBd:=0 aFONTE2:={} aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" .AND. cTabela <> StrTran( aTokens, "TB-" ) IF !EMPTY(cTabela) AADD(aFONTE2,{nBd,cTabela,nReg,0}) ENDIF nBd+=1 cTabela:=StrTran( aTokens, "TB-" ) nReg:=0 ENDIF IF SUBSTR(aTokens,1,3) == "RG-" nReg+=1 ENDIF NEXT AADD(aFONTE2,{nBd,cTabela ,nReg,0}) //AADD(aFONTE2,{(""),(cTabela),(nReg),(0)}) oBlbx:SetArray( aFONTE2, .t., ,{1,2,3,4} ) oBlbx:aCols[1]:cHeader := "-" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 25 oBlbx:aCols[2]:cHeader := "TABELA" oBlbx:aCols[2]:cEditPicture := "@!" oBlbx:aCols[2]:nDataStrAlign := AL_LEFT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[2]:nWiDTH := 150 oBlbx:aCols[3]:cHeader := "TOT REGISTRO" oBlbx:aCols[3]:cEditPicture := "@E 999,999,999" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER oBlbx:aCols[4]:cHeader := "STATUS" oBlbx:aCols[4]:cEditPicture := "@E 9" oBlbx:aCols[4]:nDataStrAlign := AL_RIGHT oBlbx:aCols[4]:nHeadStrAlign := AL_CENTER oBlbx:Refresh() RETURN NIL ********************************************************** STATIC FUNCTION BACKUP_GERA(nMOD,aFONTEx, oMtr1, oMtr2, nPor1, nPor2, oSay1, oSay2, cSay1, cSay2,aDat) ********************************************************** LOCAL nX:=0, nTot1, nTot2, nF1, nF2, nT1, nT2, cArquivo, lDel:=.F. ,cErros:="" LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens, aToken_Rg LOCAL oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle, cNome_Arquivo:=SPACE(255), lResp:=.F. nF1:=0; nF2:=0; nT1:=0; nT2:=0; nTot1:=LEN(aFONTEx); nTot2:=0 SysRefresh() IF nMOD == 1 FOR nX:=1 TO LEN(aFONTEx) cSay1:="Fazendo Cópia do Arquivo: "+aFONTEx[nX,2] oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 // IDENTIFICA A TABELA E FAZ UMA SELEÇÃO DA MESMA cArquivo:=aFONTEx[nX,2] cComm:= " SELECT * FROM "+cArquivo+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") // INICA O SCRIPT DO ARQUIVOS DE BACKUP E COPIA A ESTRUTURA DA TABELA cBACKUP+="TB-"+cArquivo+Chr(10) aStrutura_INI:={} FOR n := 1 TO TB_ARQUIVO->(FCount()) AEval( PEGAESTRUTURA( n, aFStruct,@cBACKUP,@aStrutura_INI ), {|x| TB_ARQUIVO->(QOut( x )) } ) NEXT // AQUI ELE PEGA OS REGISTROS E JOGA NO ARQUIVO nTot2:=TB_ARQUIVO->(LASTREC()) TB_ARQUIVO->(DBGOTOP()) DO WHILE TB_ARQUIVO->(!EOF()) cBACKUP+="RG-" FOR nI:=1 TO LEN(aStrutura_INI) IF nI == LEN(aStrutura_INI) cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+Chr(10) lResp:=.T. ELSE cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C", ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+"|" ENDIF NEXT nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF TB_ARQUIVO->(DBSKIP()) ENDDO CLOSE TB_ARQUIVO NEXT // FAZENDO A GRAVAÇÃO DA COPIA cNome_Arquivo:=aDat[1]+"\"+cNomTab+"_"+alltrim(cConnTipo)+"_BKP_"+SUBSTR(DTOC(DATE()),1,2)+"-"+SUBSTR(DTOC(DATE()),4,2)+"-"+SUBSTR(DTOC(DATE()),7,4)+"_"+SUBSTR(TIME(),1,2)+"-"+SUBSTR(TIME(),4,2)+"-"+SUBSTR(TIME(),7,2)+".SQL" //MemoWrit(ALLTRIM(cNome_Arquivo) , cBACKUP ) MemoWrit(ALLTRIM(cNome_Arquivo) , StrTran( cBACKUP, '"' ) ) // CHECANDO A INTEGRIDADE DO ARQUIVO oTXT:=TTxtFile():New( cNome_Arquivo ) while !oTXT:lEof cLinha:= oTXT:cLine IF SUBSTR(cLinha,1,3) <> "TB-" .AND. SUBSTR(cLinha,1,3) == "ES-" .AND. SUBSTR(cLinha,1,3) == "RG-" MSGINFO("ERRO" ) ENDIF oTXT:Skip(1) ENDDO oTXT:Close() cSay1:="Cópia Feita Com Sucesso. Arquivo : "+ALLTRIM(cNome_Arquivo) cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() ELSEIF nMOD == 2 // ESTE MÓDULO É O DE RESTAURAÇÃO DO BACKUP SR_BeginTransaction() // TRY aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" aStrutura_OUT:={} cTabela:=StrTran( aTokens, "TB-" ) lDel:=.T. cSay1:="Restaurando Cópia de Segurança: Arquivo "+cTabela oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 nTot2:=aFONTEx[nF1,3] ENDIF IF SUBSTR(aTokens,1,3) == "ES-" aToken_Rg := HB_ATokens( StrTran( aTokens, "ES-" ), "|", .F., .F. ) AADD(aStrutura_OUT, { aToken_Rg[1], aToken_Rg[2], VAL(aToken_Rg[3]), VAL(aToken_Rg[4]) } ) ENDIF IF SUBSTR(aTokens,1,3) == "RG-" IF SR_ExistTable( cTabela ) .AND. lDel==.T. SR_DropTable( cTabela ) DBCreate( cTabela, aStrutura_OUT, "SqlRdd" ) lDel:=.F. ENDIF aToken_Rg := HB_ATokens( StrTran( aTokens, "RG-" ), "|", .F., .F. ) SCRIPT_SALVARSQL2(1, cTabela, aStrutura_OUT,aToken_Rg,@cErros) nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF ENDIF NEXT cSay1:="Aguarde... " cSay2:="Organizando Registros...: " oSay1:Refresh() oSay2:Refresh() VERIFICA_TABELAS(.T.) /* CATCH oErr MemoWrit("ERRO_BACKUP.LOG" , cErros ) SR_RollBackTransaction() MSGALERT("Ocorreram alguns erros durante o processo!"+CRLF+; "Para proteção do sistema e das informações,"+CRLF+; "esse processo será abortado."+CRLF+; +CRLF+CRLF+cErros+CRLF+CRLF+; "Comunique ao Suport o Problema" ,"Erro no Sistema") quit FINALLY SR_CommitTransaction() END */ ENDIF cSay1:="Cópia Restaurada Com Sucesso. " cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() REG_AUDITOR(cUSU_LOGIN,"INICIOU","MOD. DE BACKUP E RESTAURAÇÃO",IF(nMOD==1,"BACKUP","RESTAURAR"),cNome_Arquivo) RETURN .T. //--//--// function Parse( cInput, cSep ) local cOutput local k DEFAULT cSep := ';' k := At( cSep, cInput ) if k > 0 cOutput := AllTrim( SubStr( cInput, 1, k-1 ) ) cInput := AllTrim( SubStr( cInput, k+1 ) ) else cOutput := Trim( cInput ) cInput := '' endif RETURN cOutput *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION PEGAESTRUTURA( nFieldPos, aFStruct,cBACKUP,aStrutura_INI ) aFStruct[DBS_NAME] := DbFieldInfo( DBS_NAME, nFieldPos ) aFStruct[DBS_TYPE] := DbFieldInfo( DBS_TYPE, nFieldPos ) aFStruct[DBS_LEN ] := DbFieldInfo( DBS_LEN , nFieldPos ) aFStruct[DBS_DEC ] := DbFieldInfo( DBS_DEC , nFieldPos ) AADD( aStrutura_INI, { aFStruct[DBS_NAME], aFStruct[DBS_TYPE]} ) cBACKUP+="ES-"+ALLTRIM(aFStruct[DBS_NAME])+"|"+ALLTRIM(aFStruct[DBS_TYPE])+"|"+ALLTRIM(STR(aFStruct[DBS_LEN]))+"|"+ALLTRIM(STR(aFStruct[DBS_DEC]))+Chr(10) RETURN aFStruct *************************************************************************** FUNCTION SCRIPT_SALVARSQL2(nTIPO, cBANCO, aCampos, aGets,cErros) *************************************************************************** LOCAL cSCRIPT:=SPACE(500), nI:=0 IF nTIPO == 1 IF ALLTRIM(cConnTipo) == "FIREBIRD" USE &(cBANCO) ALIAS &cBANCO VIA "SQLRDD" &cBANCO->(DBAPPEND()) SELECT &cBANCO FOR nI:=1 TO LEN(aGets) REPLACE &cBANCO->&(aCampos[nI,1]) WITH IF(aCampos[nI,2]="D",StoD( aGets[nI] ),; IF(aCampos[nI,2]="N",VAL(aGets[nI]),; IF(aCampos[nI,2]="C",TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]),; IF(aCampos[nI,2]="L",IF(VAL(aGets[nI])==1,.T.,.F.),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ) ) ) ) NEXT &cBANCO->(DBCOMMIT()) CLOSE &cBANCO ELSE cSCRIPT:="INSERT INTO "+cBANCO+" (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+aCampos[nI,1]+") " ELSE cSCRIPT+=" "+aCampos[nI,1]+", " ENDIF NEXT cSCRIPT+=" VALUES (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+SR_cDBValue( IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ), SYSTEMID_MSSQL7 )+") " ELSE cSCRIPT+=" "+SR_cDBValue( IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2])), SYSTEMID_MSSQL7 )+", " ENDIF NEXT apCode := SR_SQLParse(cSCRIPT) oSql := SR_GetConnection() oSql:exec( SR_SQLCodeGen( apCode, {,,}, oSql:nSystemID ) ) ENDIF ENDIF cErros:=cSCRIPT RETURN cSCRIPT FUNCTION TIRA_ACENTUACAO( cStr,nTIpo ) local cStrNew := "", nX cAcentos := {"'",'"',"´","`"} cLetras := {"","","",""} For nX := 1 TO LEN(cAcentos) cStrNew := StrTran(cStr, cAcentos[nX], cLetras[nX]) cStr := cStrNew Next Return( cStrNew ) mais informações pelo MSN alessandroavel@ibest.com.br Editado por - DonJuan on 27/12/2010 14:53:37
  24. DonJuan
    Estou disponibilizando para os amigos o meu código de Backups e restoures, ele funcionando tanto para Bancos DBF, como Sgdb´s tais como firebird, MySql, MS Server, Oracle, Postgres e etc. Ele pega as informações criptografa para um arquivo texto, tornando leve para ser armazenado ou levado e atraves desse arquivos ele executa a restauração das informações. Valeu? Espero que os amigos aproveitem. /****************************************************************************** * Sistema .....: PROJETO_PRINCIPAL * Programa ....: BKPRST.PRG * Autor .......: ALESSANDRO AVELINO CAVALCANTE * Sintese .....: RESP. PELA ADMIN. DO SISTEMA * Data ........: 5/29/2010 às 6:38:50 PM * Revisado em .: 5/29/2010 às 6:38:50 PM ******************************************************************************/ #include "SYSTEMA.CH" /*******************************************************************************/ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION BKPRST() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 aDat[ 1]:=SPACE(255) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aArqs) cComm:= " SELECT * FROM "+aArqs[nX]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aArqs[nX]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO NEXT AADD(aFONTE2,{(""),(""),(0),(0)}) DEFINE DIALOG oDbkp RESOURCE "BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE FOLDER oFld ID 1000 OF oDbkp ; PROMPTS "Criar Backups","Restaurar Backups" ; DIALOGS "G_BACKUP","I_BACKUP" oBlbx := TXBrowse():New( oFld:aDialogs[1] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 1] VAR aDat[ 1] ID 101 OF oFld:aDialogs[1]; ACTION (aDat[ 1] := cGetDir( "Selecione uma pasta ",".\odonto", CurDrive() + ":\" + GetCurDir() ),oDat[ 1]:REFRESH() ) REDEFINE SAY oSay1 VAR cSay1 ID 104 OF oFld:aDialogs[1] REDEFINE SAY oSay2 VAR cSay2 ID 105 OF oFld:aDialogs[1] REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 103 OF oFld:aDialogs[1] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[1] ACTION IF(!EMPTY(aDat[ 1]),BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[1] ACTION oDbkp:End() CANCEL // 2 FOLHA DE RESTAURAÇÃO DE ARQUIVOS oBlbx := TXBrowse():New( oFld:aDialogs[2] ) oBlbx:CreateFromResource(100) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE2, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE BTNGET oDat[ 2] VAR aDat[ 2] ID 101 OF oFld:aDialogs[2]; ACTION (aDat[ 2] := cGetfile32("*.SQL | ", "Selecione o Arquivo de Backups",,.f.),BUSCA_BKP(aDat,@aFONTE2,oBlbx),oDat[ 2]:REFRESH() ) REDEFINE SAY oSay3 VAR cSay3 ID 104 OF oFld:aDialogs[2] REDEFINE SAY oSay4 VAR cSay4 ID 105 OF oFld:aDialogs[2] REDEFINE METER oMtr3 VAR nPor3 TOTAL 100 ID 102 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr4 VAR nPor4 TOTAL 100 ID 103 OF oFld:aDialogs[2] COLOR CLR_WHITE, CLR_BLACK REDEFINE BUTTON ID 10 OF oFld:aDialogs[2] ACTION IF(!EMPTY(aDat[ 2]),BACKUP_GERA(2,aFONTE2, oMtr3, oMtr4, @nPor3, @nPor4, oSay3, oSay4, @cSay3, @cSay4,aDat ),MSGINFO("ESCOLHA UM LOCAL DE DESTINO PARA O BACLUP","ATENÇÃO")) REDEFINE BUTTON ID 20 OF oFld:aDialogs[2] ACTION oDbkp:End() CANCEL ACTIVATE DIALOG oDbkp CENTERED RETURN NIL *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION CHKBKP() *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens local oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle,aFONTE:={},aFONTE2:={}, aDat[ 2], oDat[ 2] LOCAL cSt_SUBMODULO:="Módulo de Backups", oBlbx LOCAL oMtr1,oMtr2,nPor1,nPor2, cSay1,cSay2, oSay1,oSay2 LOCAL oMtr3,oMtr4,nPor3,nPor4, cSay3,cSay4, oSay3,oSay4 IF Secs( TIME() ) >= Secs( cHorBkp ) .AND. DATE() > dDatBkp .AND. DIABKP()==.T. oTimer:Deactivate() aDat[ 1]:=ALLTRIM(cDesBkp) aDat[ 2]:=SPACE(255) nPor1:=0 nPor2:=0 cSay1:="-" cSay2:="-" FOR nX:=1 TO LEN(aArqs) cComm:= " SELECT * FROM "+aArqs[nX]+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") AADD(aFONTE,{("*"),(aArqs[nX]),(TB_ARQUIVO->(LASTREC())),(0)}) CLOSE TB_ARQUIVO NEXT DEFINE DIALOG oDbkp RESOURCE "CHK_BACKUP" TITLE cSt_SUBMODULO FONT oFontSystem REDEFINE BITMAP ID 5000 RESOURCE "BANNER" OF oDbkp ADJUST REDEFINE SENSITIVE SAY oSS06 PROMPT cSt_SUBMODULO ID 5001 OF oDbkp FONT oFont_Banner01 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT REDEFINE SENSITIVE SAY oSS06 PROMPT cVersao_Sistema ID 5002 OF oDbkp FONT oFont_Banner02 COLOR CLR_YELLOW ALIGN RIGHT TRANSPARENT oBlbx := TXBrowse():New( oDbkp ) oBlbx:CreateFromResource(1000) //oBlbx:bKeyDown :={|nKey| IIF(nKey==VK_RETURN,,)} //oBlbx:bChange :={|| SQLRefresh()} //oBlbx:bLDblClick:={|| INCLUIR(.T.,oBlbx,aDad)} //oBlbx:bRClicked :={|| MsgInfo("Teste") } oBlbx:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } } oBlbx:nMarqueeStyle := MARQSTYLE_HIGHLCELL // MARQSTYLE_HIGHLCELL //MARQSTYLE_HIGHLROW oBlbx:nColDividerStyle := 4 oBlbx:nRowDividerStyle := 4 oBlbx:lColDividerComplete := .F. oBlbx:lFooter := .F. oBlbx:nFreeze := 1 oBlbx:nHeaderLines := 1 oBlbx:nDataLines := 1 oBlbx:lHScroll := .T. // Barra Rolagem Horiz. oBlbx:lVScroll := .T. // Barra Rolagem vertical //oBlbx:bClrStd := {|| { CLR_BROWSE_TEXTO, IIF(((oBd_Espe)->(ORDKEYNO()))%2==0, CLR_BROWSE01, CLR_BROWSE02) } } oBlbx:bClrSelFocus := {|| { CLR_BROWSE_TEXTO_BARRA, CLR_BROWSE_BARRA } } oBlbx:SetArray( aFONTE, .t., ,{2,3,4} ) oBlbx:aCols[1]:cHeader := "TABELA" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 150 oBlbx:aCols[2]:cHeader := "TOT REGISTRO" oBlbx:aCols[2]:cEditPicture := "@E 999,999,999" oBlbx:aCols[2]:nDataStrAlign := AL_RIGHT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[3]:cHeader := "STATUS" oBlbx:aCols[3]:cEditPicture := "@E 9" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER REDEFINE SAY oSay1 VAR cSay1 ID 101 OF oDbkp REDEFINE SAY oSay2 VAR cSay2 ID 103 OF oDbkp REDEFINE METER oMtr1 VAR nPor1 TOTAL 100 ID 102 OF oDbkp COLOR CLR_WHITE, CLR_BLACK REDEFINE METER oMtr2 VAR nPor2 TOTAL 100 ID 104 OF oDbkp COLOR CLR_WHITE, CLR_BLACK ACTIVATE DIALOG oDbkp NOWAIT CENTERED (BACKUP_GERA(1,aFONTE, oMtr1, oMtr2, @nPor1, @nPor2, oSay1, oSay2, @cSay1, @cSay2,aDat ),; MSGINFO("Backup Concluído","Atenção"),oDbkp:End(),; cCodiSQl:="UPDATE CONFIGURACAO SET DATBKP = '"+DTOS(DATE())+"'", apCode := SR_SQLParse( cCodiSQl ), oSql := SR_GetConnection(),; oSql:exec( SR_SQLCodeGen( apCode, {}, oSql:nSystemID ) ), dDatBkp:=DATE(), oTimer:activate() ) ELSE ENDIF RETURN NIL ********************************************************** STATIC FUNCTION DIABKP() ********************************************************** LOCAL lConcede:=.F. DO CASE CASE CtoDoW( CDoW( DATE() ) ) = 2 lConcede:=lSeg CASE CtoDoW( CDoW( DATE() ) ) = 3 lConcede:=lTer CASE CtoDoW( CDoW( DATE() ) ) = 4 lConcede:=lQua CASE CtoDoW( CDoW( DATE() ) ) = 5 lConcede:=lQui CASE CtoDoW( CDoW( DATE() ) ) = 6 lConcede:=lSex CASE CtoDoW( CDoW( DATE() ) ) = 7 lConcede:=lSab CASE CtoDoW( CDoW( DATE() ) ) = 1 lConcede:=lDom ENDCASE RETURN lConcede ********************************************************** STATIC FUNCTION BUSCA_BKP(aDat,aFONTE2,oBlbx) ********************************************************** LOCAL oTXT, cLinha, cTabela, aStrutura_OUT,nReg:=0, aTokens, nBd:=0 aFONTE2:={} aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" .AND. cTabela <> StrTran( aTokens, "TB-" ) IF !EMPTY(cTabela) AADD(aFONTE2,{nBd,cTabela,nReg,0}) ENDIF nBd+=1 cTabela:=StrTran( aTokens, "TB-" ) nReg:=0 ENDIF IF SUBSTR(aTokens,1,3) == "RG-" nReg+=1 ENDIF NEXT AADD(aFONTE2,{nBd,cTabela ,nReg,0}) //AADD(aFONTE2,{(""),(cTabela),(nReg),(0)}) oBlbx:SetArray( aFONTE2, .t., ,{1,2,3,4} ) oBlbx:aCols[1]:cHeader := "-" oBlbx:aCols[1]:cEditPicture := "@!" oBlbx:aCols[1]:nDataStrAlign := AL_LEFT oBlbx:aCols[1]:nHeadStrAlign := AL_CENTER oBlbx:aCols[1]:nWiDTH := 25 oBlbx:aCols[2]:cHeader := "TABELA" oBlbx:aCols[2]:cEditPicture := "@!" oBlbx:aCols[2]:nDataStrAlign := AL_LEFT oBlbx:aCols[2]:nHeadStrAlign := AL_CENTER oBlbx:aCols[2]:nWiDTH := 150 oBlbx:aCols[3]:cHeader := "TOT REGISTRO" oBlbx:aCols[3]:cEditPicture := "@E 999,999,999" oBlbx:aCols[3]:nDataStrAlign := AL_RIGHT oBlbx:aCols[3]:nHeadStrAlign := AL_CENTER oBlbx:aCols[4]:cHeader := "STATUS" oBlbx:aCols[4]:cEditPicture := "@E 9" oBlbx:aCols[4]:nDataStrAlign := AL_RIGHT oBlbx:aCols[4]:nHeadStrAlign := AL_CENTER oBlbx:Refresh() RETURN NIL ********************************************************** STATIC FUNCTION BACKUP_GERA(nMOD,aFONTEx, oMtr1, oMtr2, nPor1, nPor2, oSay1, oSay2, cSay1, cSay2,aDat) ********************************************************** LOCAL nX:=0, nTot1, nTot2, nF1, nF2, nT1, nT2, cArquivo, lDel:=.F. ,cErros:="" LOCAL X, cBACKUP:="", aFStruct[4], aStrutura_OUT, aStrutura_INI, cTabela, aTokens, aToken_Rg LOCAL oTXT, clinha := '', cAux:='', cArqTxt, nFileHandle, cNome_Arquivo:=SPACE(255), lResp:=.F. nF1:=0; nF2:=0; nT1:=0; nT2:=0; nTot1:=LEN(aFONTEx); nTot2:=0 SysRefresh() IF nMOD == 1 FOR nX:=1 TO LEN(aFONTEx) cSay1:="Fazendo Cópia do Arquivo: "+aFONTEx[nX,2] oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 // IDENTIFICA A TABELA E FAZ UMA SELEÇÃO DA MESMA cArquivo:=aFONTEx[nX,2] cComm:= " SELECT * FROM "+cArquivo+" ORDER BY SR_RECNO" EXECUTA_SQL(cComm,"TB_ARQUIVO") // INICA O SCRIPT DO ARQUIVOS DE BACKUP E COPIA A ESTRUTURA DA TABELA cBACKUP+="TB-"+cArquivo+Chr(10) aStrutura_INI:={} FOR n := 1 TO TB_ARQUIVO->(FCount()) AEval( PEGAESTRUTURA( n, aFStruct,@cBACKUP,@aStrutura_INI ), {|x| TB_ARQUIVO->(QOut( x )) } ) NEXT // AQUI ELE PEGA OS REGISTROS E JOGA NO ARQUIVO nTot2:=TB_ARQUIVO->(LASTREC()) TB_ARQUIVO->(DBGOTOP()) DO WHILE TB_ARQUIVO->(!EOF()) cBACKUP+="RG-" FOR nI:=1 TO LEN(aStrutura_INI) IF nI == LEN(aStrutura_INI) cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+Chr(10) lResp:=.T. ELSE cBACKUP+=IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="N",ALLTRIM(STR(TB_ARQUIVO->(FIELDGET(nI))) ),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="D",DTOS(TB_ARQUIVO->(FIELDGET(nI) )),; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="L",IF( TB_ARQUIVO->(FIELDGET(nI)) == .T. ,"1","0") ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="M",ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))) ,; IF(VALTYPE(TB_ARQUIVO->(FIELDGET(nI)))=="C", ALLTRIM(TB_ARQUIVO->(FIELDGET(nI))),"") ))))+"|" ENDIF NEXT nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF TB_ARQUIVO->(DBSKIP()) ENDDO CLOSE TB_ARQUIVO NEXT // FAZENDO A GRAVAÇÃO DA COPIA cNome_Arquivo:=aDat[1]+"\"+cNomTab+"_"+alltrim(cConnTipo)+"_BKP_"+SUBSTR(DTOC(DATE()),1,2)+"-"+SUBSTR(DTOC(DATE()),4,2)+"-"+SUBSTR(DTOC(DATE()),7,4)+"_"+SUBSTR(TIME(),1,2)+"-"+SUBSTR(TIME(),4,2)+"-"+SUBSTR(TIME(),7,2)+".SQL" //MemoWrit(ALLTRIM(cNome_Arquivo) , cBACKUP ) MemoWrit(ALLTRIM(cNome_Arquivo) , StrTran( cBACKUP, '"' ) ) // CHECANDO A INTEGRIDADE DO ARQUIVO oTXT:=TTxtFile():New( cNome_Arquivo ) while !oTXT:lEof cLinha:= oTXT:cLine IF SUBSTR(cLinha,1,3) <> "TB-" .AND. SUBSTR(cLinha,1,3) == "ES-" .AND. SUBSTR(cLinha,1,3) == "RG-" MSGINFO("ERRO" ) ENDIF oTXT:Skip(1) ENDDO oTXT:Close() cSay1:="Cópia Feita Com Sucesso. Arquivo : "+ALLTRIM(cNome_Arquivo) cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() ELSEIF nMOD == 2 // ESTE MÓDULO É O DE RESTAURAÇÃO DO BACKUP SR_BeginTransaction() // TRY aTokens := HB_ATokens( MEMOREAD(aDat[ 2]), Chr(10) , .F., .F. ) FOR i := 1 TO Len( aTokens ) IF SUBSTR(aTokens,1,3) == "TB-" aStrutura_OUT:={} cTabela:=StrTran( aTokens, "TB-" ) lDel:=.T. cSay1:="Restaurando Cópia de Segurança: Arquivo "+cTabela oSay1:Refresh() nF1++ nPor1:=INT((nF1*100)/nTot1) IF nPor1<>nT1 oMtr1:Refresh() SysRefresh() nT1:=nPor1 ENDIF nF2:=0; nT2:=0; nTot2:=0 nTot2:=aFONTEx[nF1,3] ENDIF IF SUBSTR(aTokens,1,3) == "ES-" aToken_Rg := HB_ATokens( StrTran( aTokens, "ES-" ), "|", .F., .F. ) AADD(aStrutura_OUT, { aToken_Rg[1], aToken_Rg[2], VAL(aToken_Rg[3]), VAL(aToken_Rg[4]) } ) ENDIF IF SUBSTR(aTokens,1,3) == "RG-" IF SR_ExistTable( cTabela ) .AND. lDel==.T. SR_DropTable( cTabela ) DBCreate( cTabela, aStrutura_OUT, "SqlRdd" ) lDel:=.F. ENDIF aToken_Rg := HB_ATokens( StrTran( aTokens, "RG-" ), "|", .F., .F. ) SCRIPT_SALVARSQL2(1, cTabela, aStrutura_OUT,aToken_Rg,@cErros) nF2++ cSay2:="Copiando Registro(s): "+str(nF2)+" de "+ALLTRIM(str(nTot2)) oSay2:Refresh() nPor2:=INT((nF2*100)/nTot2) IF nPor2<>nT2 oMtr2:Refresh() SysRefresh() nT2:=nPor2 ENDIF ENDIF NEXT cSay1:="Aguarde... " cSay2:="Organizando Registros...: " oSay1:Refresh() oSay2:Refresh() VERIFICA_TABELAS(.T.) /* CATCH oErr MemoWrit("ERRO_BACKUP.LOG" , cErros ) SR_RollBackTransaction() MSGALERT("Ocorreram alguns erros durante o processo!"+CRLF+; "Para proteção do sistema e das informações,"+CRLF+; "esse processo será abortado."+CRLF+; +CRLF+CRLF+cErros+CRLF+CRLF+; "Comunique ao Suport o Problema" ,"Erro no Sistema") quit FINALLY SR_CommitTransaction() END */ ENDIF cSay1:="Cópia Restaurada Com Sucesso. " cSay2:="Registros Copiados Com Sucesso : " oSay1:Refresh() oSay2:Refresh() REG_AUDITOR(cUSU_LOGIN,"INICIOU","MOD. DE BACKUP E RESTAURAÇÃO",IF(nMOD==1,"BACKUP","RESTAURAR"),cNome_Arquivo) RETURN .T. //--//--// function Parse( cInput, cSep ) local cOutput local k DEFAULT cSep := ';' k := At( cSep, cInput ) if k > 0 cOutput := AllTrim( SubStr( cInput, 1, k-1 ) ) cInput := AllTrim( SubStr( cInput, k+1 ) ) else cOutput := Trim( cInput ) cInput := '' endif RETURN cOutput *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=* FUNCTION PEGAESTRUTURA( nFieldPos, aFStruct,cBACKUP,aStrutura_INI ) aFStruct[DBS_NAME] := DbFieldInfo( DBS_NAME, nFieldPos ) aFStruct[DBS_TYPE] := DbFieldInfo( DBS_TYPE, nFieldPos ) aFStruct[DBS_LEN ] := DbFieldInfo( DBS_LEN , nFieldPos ) aFStruct[DBS_DEC ] := DbFieldInfo( DBS_DEC , nFieldPos ) AADD( aStrutura_INI, { aFStruct[DBS_NAME], aFStruct[DBS_TYPE]} ) cBACKUP+="ES-"+ALLTRIM(aFStruct[DBS_NAME])+"|"+ALLTRIM(aFStruct[DBS_TYPE])+"|"+ALLTRIM(STR(aFStruct[DBS_LEN]))+"|"+ALLTRIM(STR(aFStruct[DBS_DEC]))+Chr(10) RETURN aFStruct *************************************************************************** FUNCTION SCRIPT_SALVARSQL2(nTIPO, cBANCO, aCampos, aGets,cErros) *************************************************************************** LOCAL cSCRIPT:=SPACE(500), nI:=0 IF nTIPO == 1 IF ALLTRIM(cConnTipo) == "FIREBIRD" USE &(cBANCO) ALIAS &cBANCO VIA "SQLRDD" &cBANCO->(DBAPPEND()) SELECT &cBANCO FOR nI:=1 TO LEN(aGets) REPLACE &cBANCO->&(aCampos[nI,1]) WITH IF(aCampos[nI,2]="D",StoD( aGets[nI] ),; IF(aCampos[nI,2]="N",VAL(aGets[nI]),; IF(aCampos[nI,2]="C",TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]),; IF(aCampos[nI,2]="L",IF(VAL(aGets[nI])==1,.T.,.F.),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ) ) ) ) NEXT &cBANCO->(DBCOMMIT()) CLOSE &cBANCO ELSE cSCRIPT:="INSERT INTO "+cBANCO+" (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+aCampos[nI,1]+") " ELSE cSCRIPT+=" "+aCampos[nI,1]+", " ENDIF NEXT cSCRIPT+=" VALUES (" FOR nI:=1 TO LEN(aGets) IF nI==LEN(aGets) cSCRIPT+=" "+SR_cDBValue( IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2]) ), SYSTEMID_MSSQL7 )+") " ELSE cSCRIPT+=" "+SR_cDBValue( IF(aCampos[nI,2]="D",IF(EMPTY(aGets[nI]),DTOS(DATE()),aGets[nI] ),TIRA_ACENTUACAO(aGets[nI],aCampos[nI,2])), SYSTEMID_MSSQL7 )+", " ENDIF NEXT apCode := SR_SQLParse(cSCRIPT) oSql := SR_GetConnection() oSql:exec( SR_SQLCodeGen( apCode, {,,}, oSql:nSystemID ) ) ENDIF ENDIF cErros:=cSCRIPT RETURN cSCRIPT FUNCTION TIRA_ACENTUACAO( cStr,nTIpo ) local cStrNew := "", nX cAcentos := {"'",'"',"´","`"} cLetras := {"","","",""} For nX := 1 TO LEN(cAcentos) cStrNew := StrTran(cStr, cAcentos[nX], cLetras[nX]) cStr := cStrNew Next Return( cStrNew ) mais informações pelo MSN alessandroavel@ibest.com.br Editado por - DonJuan on 27/12/2010 14:53:37
  25. DonJuan
    citação:Ola amigos Alguem de fortaleza para trocar ideias? Preciso saber se tem homologacao pra entrar com nosso sistema em fortaleza, se fortaleza utiliza PAF-ECF... se tem alguma coisa diferenciada para fortaleza... Temos um cliente daqui que tem filial em fortaleza e precisamos ter uma ideia de como funciona por ae obrigado amigos Um Xharbraço. Uso Fwh 9.4 (xharbour 1.2.1) + xDev Para Compilar Impactus Automação Comercial jef2_timber@hotmail.com (91)-3238-7012 Belem-PA id=quote>id=quote>Olá amigo, sou de Fortaleza, vou me certificar por aqui e te retorno, meu MSN é alessandroavel@ibest.com.br Acesse: http://programafontefivewin.blogspot.com/ FHW 10.6, XHB1.2.1, PELLESC 6.0, XDEV 7.2, SQLRDD, MySql, Firebird, Postgres "MIGRE SEUS SISTEMAS EM CLIPPER PARA 32BITS COM BAMCOS SQL"
×
×
  • Create New...