Frazato

Utilize o chr(002) no início para iniciar as configurações.

Bom dia!

é feito em gtwvw usando xharbour!

 

 

#include "inkey.ch"
#include "icbrasil.ch"

Function Main()

   public p_aListObjects := {}, p_nNormalMaxrow := 33, p_nNormalMaxcol := 98

   REQUEST DBFCDX
   RDDSETDEFAULT("dbfcdx")
   DBSETDRIVER("dbfcdx")

wvw_settitle( 0, "...#### JAF DESENVOLVIMENTO - ENVIO DE MENSAGEM ZAP VIA MEGA ( By Frazato )####..." )

Parameters xExecutarRotina

If xExecutarRotina==nIL
   xExecutarRotina := 'SEM PARAMETROS'
Endif

Iniciar()
COR_NORMAL
Close all

nLista := Directory("c:\temp\Zap\*.jpeg","D")
If Len(nLista)<=0 
   ALERTA('E NECESSARIO COLOCAR OS ARQUIVO *.JPEG NA PASTA C:\TEMP\ZAP')
Endif

If Len(nLista)>10 
   ALERTA('CARO AMIGO ACHO EU QUE TEM MUITO ARQUIVO PARA ENVIO, USUARIO NAO GOSTA VERIFIQUE A PASTA C:\TEMP\ZAP')
Endif

If xExecutarRotina=='ROBO'
   RoboZap()
   return nil
Endif

Sele 1
    use MSGZAP alias contato //Exclusive
    If ! File('msgzap.cdx')
         index on Nome      tag nomes to msgzap
     index on telefone  tag fones to msgzap
    endif
    Set index to msgzap
    

  Sele Contato
       OrdSetFocus('nomes')
       Go top
       nReg_ok:= nReg_Nt:= nReg_ := 0

       Do while ! EOF()
      If Contato->TemZap=='OK'
        nReg_ok++
          ElseIf Contato->TemZap=='NT'
        nReg_Nt++
      Else
        nReg_++
      Endif    
      Skip+1
       Enddo
       cStatus_banco := Space(3)+;
               "("+Alltrim(Str(nReg_ok,5))+' OK )'+Space(3)+;
               "("+Alltrim(Str(nReg_nt,5))+' NT )'+Space(3)+;
               "("+Alltrim(Str(nReg_  ,5))+' NA )'

       Go Top
       @ 00,00 say padc('JAF ENVIO DE WHASPP VIA APP MEGA',MaxCol()) color('nn+/WW+')
       @ 01,00 say padc('--------------------------------'+xExecutarRotina,MaxCol())
       @ 02,00 say padc('INS-NOVO  ENTER-ALTERA   DEL-EXCLUI    SPACE-MARCA/DESMARCA   ==> F10-MENU OPCAO',MaxCol())
       @ 03,00 say padc('F3-PESQUISA NOME  F9-VERIFICA CONTATO ==>'+cStatus_banco,MaxCol())
       @ 04,00 TO 04,MaxCol()

       oTab:=TbrowseDb(05,00,MaxRow()-2,MaxCol())

       oTab:ColSep    := " ³ "
       oTab:HeadSep   := "___"
       oTab:ColorSpec := "n/ww+*,B/GR+*,N/w,N/W*+,g+*/ww+*"

       Coluna1 := TbColumnNew("Telefone   ",{ ||Substr(Contato->Telefone,1,12)+' '+Substr(Contato->Nome,1,30)+'  '+Contato->Temzap } )
       Coluna2 := TbColumnNew("Envio      ",{ ||Substr(Contato->DataEnv,1,20)} )

       Coluna3 := TbColumnNew("Mensagem   ",{ ||Substr(Contato->Msg,1,40) } )
       Coluna4 := TbColumnNew("Pedido     ",{ ||Contato->DataPed } )

       Coluna5 := TbColumnNew("Arquivo    ",{ ||Contato->Arquivo } )
       Coluna6 := TbColumnNew("Retorno APP",{ ||Contato->Retorno } )

       oTab:AddColumn(Coluna1)
       oTab:AddColumn(Coluna2)
       oTab:AddColumn(Coluna3)
       oTab:AddColumn(Coluna4)
       oTab:AddColumn(Coluna5)
       oTab:AddColumn(Coluna6)

Do While .t.

        For i:= 1 to 6// 6
             oTab:GetColumn(i):ColorBlock :=  { || { Iif(OrdKeyNo()%2==0,4,3),2 } }
        Next

        Do While ! oTab:Stabilize()
        Enddo
        nKey := Inkey()
        If oTab:Stable
           nKey := Inkey(0)
           oTab:ForcEstable()
        Endif

        If nKey == K_ESC
           Exit
        ElseIf nKey == K_ENTER
        Manutencao(.f.)
            oTab:Refreshall()

        ElseIf nKey == K_DEL
           If op:= Alert('CONFIRMA EXCLUSAO DO CONTATO '+Alltrim(Contato->Telefone),{'SIM','NAO'})==1
          Trav_reg()
                  Delete
          Skip+1
          If Bof()
             Go top
          Endif
          oTab:Refreshall()
           Endif
        ElseIf nKey == K_INS
        Manutencao(.t.)
        oTab:Refreshall()
        ElseIf nKey == K_F10
        ROTINAS()
        ElseIf nKey == K_F9
        If Zap_VerStatus()==.t.
           Zap_checaContato(Contato->Telefone)
            Endif
        ElseIf nKey == K_SPACE
        If Empty(Contato->DataEnv)
            IF MSGCONF("Confirma DESMARCACAO ?"+Alltrim(Contato->Nome),"1") == .t.
                 Trav_reg()
                 Repla Contato->DataEnv With DTOC(DATE())
                 Repla Contato->MSg     With ''
                 Repla Contato->Arquivo With ''
            Endif

        Else

            IF MSGCONF("Confirma MARCAO ?"+Alltrim(Contato->Nome),"1") == .t.
                 Trav_reg()
                 Repla Contato->DataEnv With ''
                 Repla Contato->MSg     With 'La Villa, Ofertas!'
                 Repla Contato->Arquivo With 'PASTA'
            Endif
        Endif
        oTab:Refreshall()
        ElseIf nKey == K_F3     // PESQUISA NOME
        PESQNOME()
        oTab:Refreshall()

        ElseIf nKey == K_UP
               oTab:Up()
        ElseIf nKey == K_DOWN
               oTab:Down()
        ElseIf nKey == K_LEFT
               oTab:Left()
        ElseIf nKey == K_RIGHT
               oTab:Right()
        ElseIf nKey == K_PGUP
               oTab:PAGEUP()
        ElseIf nKey == K_PGDN
               oTab:PAGEDOWN()

        ElseIf nKey == K_CTRL_PGUP
               oTab:goTop()
           oTab:Refreshall()
    ElseIf nKey== K_CTRL_PGDN
           oTab:goBottom()
           oTab:Refreshall()
        Endif
Enddo
Close all
return nil

******************
FUNCTION Iniciar()
******************
   local lRet := .T.

   dbsetdriver("DBFCDX")

   set confirm    on
   set deleted    on
   set bell       off
   set scoreboard off
   set eventmask  to INKEY_ALL
   set date       british
   set epoch      to 1950
   set exclusive off
   Set date format to "DD/MM/YYYY"
   SET WRAP ON
   lRet := WVW_SetFont(,'Ms Sans Serif', 24, 11 )  // IDEAL E PADRAO
   If GetEnv("WINDOWS98")=='S'
      lRet := WVW_SetFont(,cTipoFonte)
   Endif
   If !lRet
       wvw_messagebox(0, "Fonte não carregada", "JAF Desenv.", 0)
       lRet := WVW_SetFont(,'Ms Sans Serif', 16, 8 )  // LABORATORIO
   Endif
   wvw_noclose()
   wvw_seticon(, "cxwin.ico" )
   wvw_size_ready(.T.)
   wvw_setmaincoord(.T.)
   wvw_SetPaintRefresh(0)
   WVW_SetCodePage(,255) // 250
   wvw_SetVertCaret(.F.)
   wvw_enableshortcuts(0,.T.)
*   SetInkeyAfterBlock({|nkey| AfterInkey( nkey ) })
   wvw_maximize(0)
    COR_NORMAL
    Jta(0)
  * Toolbar(0)
  * Jta(0)
   cls
   lRet := .t.
RETURN lRet

//-------------------------------------------------------
Function Trav_Reg()
Local Tela01 := Savescreen(00,00,24,79)
Local nTenta := 0
Local nHora1 := Time()
Local CorOld := SetColor()
Do While (!Rlock())
     nTenta++
     Centra(24,'Gravando dados no Banco de Dados...'+str(nTenta))

     If nTenta >= 150
          SetColor("W+*/R")
          @ 10,10 Clear to 15,60
          @ 10,10 to 15,60 Double
          SetColor("GR+/R")
          @ 11,11 say padc("Registro Alocado",48)

          @ 13,11 say "Tentativa n§:"
          @ 14,11 say " Tempo Gasto:"
          @ 13,26 say Str(nTenta,10) Color("WW+*/R")
          @ 14,26 say Elaptime(nHora1,Time())
      Endif
  Enddo
Setcolor(CorOld)
Centra(24,'')
*RestScreen(00,00,24,79,Tela01)
Return nil

Function Destrava()
DbUnlock()
//Commit
Return nil

***********************************************************
FUNCTION WVW_SIZE( nWindow, hWnd, message, wParam, lParam )
***********************************************************
   local cScreen, maxsavedscrrow, maxsavedscrcol, lNeedReset := .f.

   if !WVW_SIZE_READY()
      return NIL
   endif
   if nWindow # 0
      return NIL
   endif

   WVW_SIZE_READY(.F.)

   do case
      case wParam == 2 // Maximizar a janela
         if ( maxcol() # wvw_maxmaxcol() .or. maxrow() # wvw_maxmaxrow() )
            maxsavedscrrow := min( min( p_nNormalMaxrow, wvw_maxmaxrow() ), maxrow() )
            maxsavedscrcol := min( min( p_nNormalMaxcol, wvw_maxmaxcol() ), maxcol() )
            cScreen        := savescreen( 0, 0, maxsavedscrrow,  maxsavedscrcol )
            if setmode( wvw_maxmaxrow()+1, wvw_maxmaxcol()+1 )
               restscreen( 0, 0, maxsavedscrrow, maxsavedscrcol, cScreen )
            endif
         endif
      case wParam == 0 // Restaurar o Tamanho da Janela
         if ( maxcol() # p_nNormalMaxcol .or. maxrow() # p_nNormalMaxrow )
            maxsavedscrrow := min( p_nNormalMaxrow, maxrow() )
            maxsavedscrcol := min( p_nNormalMaxcol, maxcol() )
            cScreen        := savescreen( 0, 0, maxsavedscrrow, maxsavedscrcol )
            if setmode( p_nNormalMaxrow+1, p_nNormalMaxcol+1 )
               restscreen( 0, 0, maxsavedscrrow, maxsavedscrcol, cScreen )
            endif
         endif
      otherwise
   endcase
   WVW_SIZE_READY(.T.)
RETURN NIL

//
// FUNCAO     : WVW_Timer()
// PARAMETROS : nWindow - N§ da janela
//              hWnd    -
//              message -
//              wParam  -
//              lParam  -
// DESCRICAO  : Funcao chamada ao intervalo definido na funcao WVW_SETTIMER()
// RETORNO    :
//
************************************************************
FUNCTION WVW_TIMER( nWindow, hWnd, message, wParam, lParam )
************************************************************
   WVW_SBSetText(, 2, time() )
RETURN NIL

**********************************
STATIC FUNCTION jta(nWindow)

  local hWndSB := ""
   wvw_sbdestroy(nWindow)
   IF ! Empty( wvw_sbCreate() ) .AND. wvw_sbAddPart( , "99:99:99" ) > 0
  
      wvw_SetTimer( , 1000 )
   
   ENDIF

   *if WVW_SBAddPart(, "99/99/9999" ) > 0
     *set century on
      WVW_SBSetText(nWindow, 1,'CORTEZIA - JAF DESENVOLVIMENTO' )
     *WVW_SBSetText(nWindow, 2, time() )
     *set century off
   *endif

*   if !empty(wvw_SBcreate() ) .and.;
*      wvw_SBaddPart(, "99:99:99") > 0
*      wvw_SetTimer(, 1000)
*   endif

   *if WVW_SBAddPart(,"99:99:99") > 0
    *  WVW_SetTimer(nWindow,1,Time(),1000)
   *endif
    WVW_SBSetText(,0,"Programa Licenciado Para :CORTEZIA")
return nil

//--------------------------------------------------------------
static Function Manutencao(lOp)
Local cTelefone := Space(12)
Local CCONTATO  := Space(40)
Local GetList   := {}
Local Tela    := Savescreen(00,00,24,79)
Local CorOld  := SetColor()

If lOp == .f. // Alteracao
   cTelefone := Contato->Telefone
   cContato  := Contato->Nome
Endif
setcolor('g/r')
@ 11,10 say PADC(Iif(lop==.t.,'NOVO CONTATO','ALTERANDO '+cTelefone),61) COLOR 'GR+/N'
@ 12,10 Clear to 15,70
@ 13,11 say 'TELEFONE....' GET CTELEFONE Pict '999999999999'
Read
If LastKey()#27
   Go top
   OrdsetFocus('Fones')
   Seek StrZero(val(cTelefone),11)
   if Found()
      Alerta('Telefone ja cadastrado '+ Contato->Nome)
      cContato  := Contato->Nome
      lop := .f.
   Endif
Endif

@ 14,11 SAY 'CONTATO.....' GET CCONTATO  Pict "@!"
Read
If LastKey()#27
If Conf := Alert('Confirma INCLUSAO/ALTERACAO',{'Sim','Nao'})== 1
   If lop==.t.
      Append Blank
      Repla Contato->Telefone With cTelefone
   Endif
   Trav_reg()
   Repla Contato->Nome     With cContato
Endif
Endif
SetColor(CorOld)
RestScreen(00,00,24,79,Tela)
Return nil

//----------------------------------------------------------
Function EnviarMsgTexto(cNumero,cMsg,cPDF,lteste,lEnviaJPG)
Local i
*Local Url :='http://api2.megaapi.com.br:10248/'// sendfilebase64?'
*Local cToken := "demo12345678910"

Local Url    :='http://api2.megaapi.com.br:15358/'// sendfilebase64?'
Local cToken := "M_CI33zodtF1UisZAD"
Local cRetorno :=''
Local mTemporal_:= 'c:\temp\'

If lEnviaJPG==.t.
   mTemporal_:= 'c:\temp\zap\'
Endif
If cMsg==''
   *Alerta('sem msg!!')
   Return .f.
Endif

if lteste # Nil
   hHash := Hash()
Endif

    If ! Empty(cPDF)
    Url += 'sendfilebase64?'
    Else
    Url += 'sendmessage?'
    Endif

    Url += "token="+cToken
     

   *xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP.6.0")
    xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP")
    xmldoc:setTimeouts(1000*60, 1000*60, 0, 0)
    xmldoc:open("POST", url, .f.)
    xmldoc:SetRequestHeader( "Content-Type", "application/json;charset=utf-8"  )
    xmldoc:SetRequestHeader( "token" , cToKen )

   Texto :='{'+;
        [ "phone": "55]+Alltrim(cNumero)+[",]+;
        [ "body": "]+Alltrim(cMsg)+["]+;
        [}]

   If lEnviaJPG==.t. // envia a pasta c:\temp\zap todos os arquivos
       If ! Empty(cPDF)
          If File(cPDF)
         sContent = Alltrim(MemoRead(cPDF))
         sContent = hb_base64encode(sContent,Len(sContent))
         cArqBase64 := sContent

          cPDF:= StrTran(cPDF,mTemporal_) // Limpa o nome

          Texto := '{'+;
                [ "phone": "55]+Alltrim(cNumero)+[",]+;
               [ "body": "data:image/png;base64,]+ALLTRIM(cArqBase64)+[",]+; //application/pdf
               [ "filename": "]+Alltrim(cPDF)+[",]+;
               [ "caption": "]+Alltrim(cMsg)+["]+;
               '}'
          Endif
    Endif
   Else
     If ! Empty(cPDF)
        If File(cPDF)
       sContent = Alltrim(MemoRead(cPDF))
       sContent = hb_base64encode(sContent,Len(sContent))
       cArqBase64 := sContent

       cPDF:= StrTran(cPDF,mTemporal) // Limpa o nome

        Texto := '{'+;
              [ "phone": "55]+Alltrim(cNumero)+[",]+;
             [ "body": "data:application/pdf;base64,]+ALLTRIM(cArqBase64)+[",]+; //application/pdf
             [ "filename": "]+Alltrim(cPDF)+[",]+;
             [ "caption": "]+Alltrim(cMsg)+["]+;
             '}'
        Endif
     Endif
   Endif

  * Alerta(texto)
   lErroEnvio := .f.
   Try
    xmldoc:send(Texto)
    
   Catch oError
        CRLF := ''
        cErrorTmp :="Error: "  + Transform(oError:GenCode, nil) + CRLF +;
                    "SubC: "   + Transform(oError:SubCode, nil) + CRLF +;
                    "OSCode: "  + Transform(oError:OsCode,  nil) + CRLF +;
                    "SubSystem: " + Transform(oError:SubSystem, nil) + CRLF +;
                    "Mensagem: " + oError:Description
     
        *Alert("Erro ao chamar metodo SEND de HttpRequest (Registro envio)"+chr(10)+cErrorTmp )
        lErroEnvio := .t.
   End 

   If lErroEnvio == .t.
      Centra(24,cErrorTmp)
      Return .f. // cErrorTmp
   Endif

   DO WHILE xmldoc:readyState <> 4
      MILLISEC(1000)
   ENDDO

   Linha :=xmldoc:responseText
   Linha2:=xmldoc:ResponseBody()

   cTxtGerado := StrZero(Int(hb_random(10000)),5)

   MemoWrit(mTemporal_+'revisao2_'+cTxtGerado+'.txt',Texto)
   MemoWrit(mTemporal_+'revisao1_'+cTxtGerado+'.txt',Linha2 )

   hb_jsondecode( Linha2, @hHash )
            
   IF VALTYPE(hHash) != 'H'
       *Alert( 'Algo deu errado, verifique Endereço/token da API')
       RETURN(.F.)
   ENDIF 
   
   IF len(hHash)<0
      *Alert('Algo deu errado, verifique Endereço/token da API ou retorno vazio, tente novamente')
      RETURN(.F.)
   ENDIF 
RETURN .t.

//------------------------------------------------
Static Function RoboZap()
Local nQtdMSgEnviar:= 0
Local nQtdMsgEnviadas:= 0
Local TestaStatus := .t.
Close all

Sele 1
     Use MSGZAP Alias Lista
     set index to MsgZap

Sele Lista
     OrdSetFocus('nomes')
     Go top
     Do while ! Eof()
    If Empty(Lista->DATAENV) .and. Lista->Temzap=='OK'
       nQtdMSgEnviar++
    Endif
    Skip+1
     enddo

Go top
lTestaStatus := .t.  // teste somente quando der problema

Do while .t.

hHash := Hash()

If Lista->Temzap#"OK" // pula problemas
   Skip+1;Loop
Endif

If Empty(Lista->DATAENV) // .AND. !Empty(Lista->TELEFONE)

  If lTestaStatus==.t.
     lOkStatus := Zap_VerStatus()
  Endif

* If Zap_VerStatus()==.t.

  If lOkStatus == .t.
        lTestaStatus := .f.
    
    cNumero := Alltrim(Lista->Telefone)
        cMsg    := Alltrim(Lista->MSG)
    cPdf    := Lista->Arquivo
    cGrafico:= ' Enviando...'+Str(nQtdMsgEnviadas++,5)+' de '+Str(nQtdMSgEnviar,5)

        Centra(24,'Enviando Whastapp....'+cNumero+cGrafico)

     If Alltrim(cPdf)=='PASTA'
      If Zap_Envia_Pasta(cNumero) ==.f.
        Centra(24,'Erro Envio.. ')
        lTestaStatus := .t.
         Endif
     Else
     * IF EnviarMsgTexto(cNumero,cMsg,cPdf)  # .T.
     *    Centra(24,'Erro Envio.. ')
     * Else
*          IF HHasKey( hHash, 'message' )
*             Trav_reg()
*             Repla Lista->RETORNO With ALLTRIM(hHash['message'])
*
*             Centra(24,'Enviando Whastapp....'+cNumero+' RETORNO....'+ALLTRIM(hHash['message']) )
*          ENDIF 
*
*          IF HHasKey( hHash, 'accountStatus' )
*          Trav_reg()
*          Repla Lista->DATAENV  With Dtoc(Date())+' '+Time()
*          ENDIF 
*          Destrava() 
*          Inkey(1)
 *       Endif
      Endif
   Else
       Centra(24,'Verifique, Celular nao esta conectado no ZAP!')
   Endif
Endif
Skip+1
If LastKey()==27    
   Exit
Endif
if Eof()
   Exit
*  Go top
Endif
Enddo
Close all
Return nil

//------------------------------------------------------------------------------------
Function Zap_VerStatus()
Local i
*Local Url :='http://api2.megaapi.com.br:10248/status?'   ///logout
*Local cToken := "demo12345678910"
Local Url    :='http://api2.megaapi.com.br:15358/status?'// sendfilebase64?'
Local cToken := "M_CI33zodtF1UisZAD"

Local cRetorno :=''
Local mTemporal:= 'c:\temp\'
    Url += "token="+cToken
    xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP")
    xmldoc:setTimeouts(1000*60, 1000*60, 0, 0)
    xmldoc:open("GET", url, .f.)
    xmldoc:SetRequestHeader( "Content-Type", "application/json;charset=utf-8"  )
   *xmldoc:SetRequestHeader( "token" , cToKen )
   *xmldoc:SetRequestHeader( "Connection", "Keep-Alive"  )

   Texto :=''
   lErroEnvio := .f.
   Try
    xmldoc:send(Texto)
    
   Catch oError
        CRLF := ''
        cErrorTmp :="Error: "  + Transform(oError:GenCode, nil) + CRLF +;
                    "SubC: "   + Transform(oError:SubCode, nil) + CRLF +;
                    "OSCode: "  + Transform(oError:OsCode,  nil) + CRLF +;
                    "SubSystem: " + Transform(oError:SubSystem, nil) + CRLF +;
                    "Mensagem: " + oError:Description
     
       *Alert("Erro ao chamar metodo SEND de HttpRequest (Registro envio)"+chr(10)+cErrorTmp )
        lErroEnvio := .t.
   End 

   If lErroEnvio == .t.
      Return .f. // cErrorTmp
   Endif

   DO WHILE xmldoc:readyState <> 4
      MILLISEC(1000)
   ENDDO

   Linha :=xmldoc:responseText
   Linha2:=xmldoc:ResponseBody()

   MemoWrit(mTemporal+'revisao2.txt',Linha2)
   MemoWrit(mTemporal+'revisao1.txt',Linha )

   hHash2 := Hash()

   
   hb_jsondecode( Linha,@hHash2 )
            
   IF VALTYPE(hHash2) != 'H'
     *Alert( 'Algo deu errado, verifique Endereço/token da API')
      RETURN(.F.)
   ENDIF 
   
   IF len(hHash2)<0
      *Alert('Algo deu errado, verifique Endereço/token da API ou retorno vazio, tente novamente')
      RETURN(.F.)
   ENDIF 

   IF HHasKey( hHash2, 'accountStatus' ) // True
      If hHash2['accountStatus']  // True
     if HHasKey( hHash2, 'state' ) 
           If hHash2['state']=='connected'
           Return .t. // Concentaro
        Endif
      Endif
      Endif
   ENDIF
RETURN .f.

//---------------------------------------------------------------------------
Static Function ZAP_PegaQrCodi()
Local i
*Local Url :='http://api2.megaapi.com.br:10248/qrcode?'
*Local cToken := "demo12345678910"
Local Url    :='http://api2.megaapi.com.br:15358/qrcode?'// sendfilebase64?'
Local cToken :=  "M_CI33zodtF1UisZAD"
Local cRetorno :=''
Local mTemporal:= 'c:\temp\'

IF MSGCONF("Confirma a Obtencao QrCodi,Faca logout antes! ","1") == .f.
   Return nil
Endif

    Url += "token="+cToken
    Alerta(Url)
   *xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP.5.0")
    xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP")
    xmldoc:setTimeouts(1000*60, 1000*60, 0, 0)
    xmldoc:open("GET", url, .f.)
    xmldoc:SetRequestHeader( "Content-Type", "application/json;charset=utf-8"  )
   *xmldoc:SetRequestHeader( "token" , cToKen )
   *xmldoc:SetRequestHeader( "Connection", "Keep-Alive"  )

   Texto :=''
   lErroEnvio := .f.
   Try
    xmldoc:send(Texto)
    
   Catch oError
        CRLF := ''
        cErrorTmp :="Error: "  + Transform(oError:GenCode, nil) + CRLF +;
                    "SubC: "   + Transform(oError:SubCode, nil) + CRLF +;
                    "OSCode: "  + Transform(oError:OsCode,  nil) + CRLF +;
                    "SubSystem: " + Transform(oError:SubSystem, nil) + CRLF +;
                    "Mensagem: " + oError:Description
     
       * Alert("Erro ao chamar metodo SEND de HttpRequest (Registro envio)"+chr(10)+cErrorTmp )
        lErroEnvio := .t.
   End 

   If lErroEnvio == .t.
      Return cErrorTmp
   Endif

   DO WHILE xmldoc:readyState <> 4
      MILLISEC(1000)
   ENDDO

   Linha :=xmldoc:responseText
   Linha2:=xmldoc:ResponseBody()

   MemoWrit(mTemporal+'revisao2.txt',Linha2)
   MemoWrit(mTemporal+'revisao1.txt',Linha )

   nInicio := ["qrCode":"data:image/png;base64,]
   nPos    := At(nInicio,Linha)
   cDados  := Substr(Linha,nPos+Len(nInicio),30000)
   cDados  := StrTran(cDados,["}],'')
    

    MemoWrit(mTemporal+'revisao1.txt',cDados,.f. )

    cDados = hb_base64Decode(cDados)
    MemoWrit(mTemporal+'QrCodi.jpg',cDados,.f.)
! (mTemporal+'QrCodi.jpg')
RETURN .t.

//------------------------------------------------------------------------------------
Function ZAP_Logout()
Local i
*Local Url :='http://api2.megaapi.com.br:10248/logout?'   ///logout
*Local cToken := "demo12345678910"
Local Url    :='http://api2.megaapi.com.br:15358/logout?'// sendfilebase64?'
Local cToken := "M_CI33zodtF1UisZAD"

Local cRetorno :=''
Local mTemporal:= 'c:\temp\'
IF MSGCONF("Tem certeza que deseja fazer o Logout do WhastApp(Mega)","1") == .f.
   Return nil
Endif

    Url += "token="+cToken
   *xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP.5.0")
    xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP")
    xmldoc:setTimeouts(1000*60, 1000*60, 0, 0)
    xmldoc:open("GET", url, .f.)
    xmldoc:SetRequestHeader( "Content-Type", "application/json;charset=utf-8"  )
   *xmldoc:SetRequestHeader( "token" , cToKen )
   *xmldoc:SetRequestHeader( "Connection", "Keep-Alive"  )

   Texto :=''
   lErroEnvio := .f.
   Try
    xmldoc:send(Texto)
    
   Catch oError
        CRLF := ''
        cErrorTmp :="Error: "  + Transform(oError:GenCode, nil) + CRLF +;
                    "SubC: "   + Transform(oError:SubCode, nil) + CRLF +;
                    "OSCode: "  + Transform(oError:OsCode,  nil) + CRLF +;
                    "SubSystem: " + Transform(oError:SubSystem, nil) + CRLF +;
                    "Mensagem: " + oError:Description
     
       * Alert("Erro ao chamar metodo SEND de HttpRequest (Registro envio)"+chr(10)+cErrorTmp )
        lErroEnvio := .t.
   End 

   If lErroEnvio == .t.
      Return cErrorTmp
   Endif

   DO WHILE xmldoc:readyState <> 4
      MILLISEC(1000)
   ENDDO

   Linha :=xmldoc:responseText
   Linha2:=xmldoc:ResponseBody()

   *MemoWrit(mTemporal+'revisao2.txt',Linha2)
   *MemoWrit(mTemporal+'revisao1.txt',Linha )

   hHash2 := Hash()

   hb_jsondecode( Linha2, @hHash )
            
   IF VALTYPE(hHash2) != 'H'
     // Alert( 'Algo deu errado, verifique Endereço/token da API')
      RETURN(.F.)
   ENDIF 
   
   IF len(hHash2)<0
   //   Alert('Algo deu errado, verifique Endereço/token da API ou retorno vazio, tente novamente')
      RETURN(.F.)
   ENDIF 

   IF HHasKey( hHash2, 'state' )
      If ALLTRIM(hHash2['state']) # 'connected'
         Return .f.
      Endif
   ENDIF 

RETURN .t.

//------------------------------------------------------------------------
STATIC Function ROTINAS()
LOCAL OP := 1, TELA01 := SAVESCREEN(00,00,MaxRow(),MaxCol())
Local opcao := 7
Local cZapStatus:= 'OFFLINE-VERIFIQUE CELULAR'

do while .t.
    OPCAO := 10
        If Zap_VerStatus()==.t.
       cZapStatus:= 'ONLINE-PRONTO PARA USO'

    Endif
        *AADD( OPCAO,{ "Verificar STATUS Coneccao WhatsApp(Mega)  "+cZapStatus,"080"  ,{ || Alerta(iif(Zap_VerStatus()==.t.,'Ok-Operando','Offline')) ,'Zap_VerStatus()'   } } )
        *AADD( OPCAO,{ "Logout Servico Whastapp MEGA              "+Space(Len(cZapStatus)),"080"  ,{ || ZAP_Logout() ,'ZAP_Logout()'   } } )
        *AADD( OPCAO,{ "Pegar QRCodi                              "+Space(Len(cZapStatus)),"080"  ,{ || ZAP_PegaQrCodi() ,'ZAP_PegaQrCodi()'   } } )
        *AADD( OPCAO,{ "Enviar uma Mensagem Teste para o JAF      "+Space(Len(cZapStatus)),"080"  ,{ || EnviarMsgTexto("14997140865",'JAF, mensagem de teste!','',.t.),[EnviarMsgTexto("14996114611",'JAF, mensagem de teste!','',.t.)]   } } )
        *AADD( OPCAO,{ "Enviar Mensagem AVulso                    "+Space(Len(cZapStatus)),"080"  ,{ || Zap_avulso(),''} } )
        *AADD( OPCAO,{ "Robo de envio de ZAP ( MSGZAP.DBF)        "+Space(Len(cZapStatus)),"080"  ,{ || RoboZap(),''} } )
    
    *Setcolor('NN*/RB+,Y/GR')    
        setcolor("W/BR+,n+/gr+*,n,n,n/w*")

    @ 03,05 clear to 23,65
    @ 02,04 to 24,66 DOUBLE

        @ 02,05 say padc('R O T I N A S  / F U N C O E S ',61) Color('w/G')

    @ 03,11 say cZapStatus
    @ 05,11 prompt '1-Verificar STATUS Coneccao WhatsApp(Mega)'
    @ 07,11 PROMPT '2-Logout Servico Whastapp MEGA           '
    @ 09,11 PROMPT '3-Gerar QRcodi                            '
    @ 11,11 PROMPT '4-Enviar uma Mensagem Teste para o JAF       '
    @ 13,11 PROMPT '5-Enviar Mensagem AVulso           '
    @ 15,11 PROMPT '6-Robo de envio de ZAP ( MSGZAP.DBF)      '
    @ 17,11 PROMPT '7-Marca todos os Contatos          '
    @ 19,11 PROMPT '8-Descamarca todos os Contatos         '
    @ 21,11 PROMPT '9-Checa todos contato com zap ou sem         '
    @ 23,11 PROMPT '10-VOLTA MENU                  '
        menu to opcao
    Do case
           case opcao==10
        Exit
           case opcao==1
        Alerta(iif(Zap_VerStatus()==.t.,'Ok-Operando','Offline'))
           case opcao==2
        ZAP_Logout()
           case opcao==3
        ZAP_PegaQrCodi()
           case opcao==4
        EnviarMsgTexto("14997140865",'JAF, mensagem de teste!','',.t.)
           case opcao==5
        Zap_avulso()
           case opcao==6
        Alerta(iif(Zap_VerStatus()==.t.,'Ok-Operando','Offline'))
        RoboZap()
        ALERT('PROCESSO FINALIZADO... ',{'ENTER FINALIZA!'},'W/BR+',10)
        QUIT
       case opcao==7
        MarcaTodos()
       case opcao==8
        DesMarcaTodos()
       case opcao==9
        ChecaTodosContatos()

    EndCAse
Enddo
Restscreen(00,00,MaxRow(),MaxCol(),tela01 )
return nil

//------------------------------------------------
Static Function Zap_avulso()
Local cMsg := Space(100)
Local cNumero := Space(12)
Local GetList := {}

If Zap_VerStatus()==.f.
   Alerta('Verifique o celular, não esta online/Conectado!')
   Return nil
Endif

CAIXATEXTO(10,5,15,90,"....### MENSAGEM A VULSO ZAP ###...2","BG+/NB+","NN/NN","D")
@ 12,06 say 'Nr. Celular com WhatsApp :' Get cNumero pict '999999999999'
@ 14,06 say 'Mensagem:' Get cMsg 
Read
IF MSGCONF("Enviar Mensagem ","1") == .t.
   EnviarMsgTexto(Alltrim(cNumero),Alltrim(cMsg),'',.t.)
Endif
FechaJanela()
Return Nil

//------------------------------------------------
Static Function Zap_Envia_Pasta(cNumero)
Local nLista := Directory("c:\temp\Zap\*.jpeg","D")
Local i
Local lok := .t.

For i:= 1 To Len(nLista)
   
     cArquivo := 'c:\temp\zap\'+nLista[i,1]
     lok:= EnviarMsgTexto(cNumero,'Ofertas La Villa!!!',cArquivo,.f.,.t.)

      IF HHasKey( hHash, 'message' )
         Trav_reg()
         Repla Lista->RETORNO With ALLTRIM(hHash['message'])
     Centra(24,'Enviando Whastapp....'+cNumero+' RETORNO....'+ALLTRIM(hHash['message']) )
      ENDIF 

      IF HHasKey( hHash, 'accountStatus' )
      Trav_reg()
      Repla Lista->DATAENV  With Dtoc(Date())+' '+Time()
      ENDIF 
     *Destrava() 
      If lOk == .f.
         Exit
      Endif 
Next
Return lok

Function Centra(l,c)
@ MaxRow(),00 say padc(c,MaxCol()) Color('WW+/RR+')
Return Nil

Function Alerta(c)
Alert(c)
return nil

Function MSGCONF(c)
Local op := 2
If op:= Alert(c,{'SIM','NAO'})==1
   Return .t.
endif
return .f.

Function CAIXATEXTO(l1,c1,l2,c2,c)
@ l1,c1 clear to l2,c2
@ l1-1,c1 say c
return nil

Function FechaJanela()
return .t.

//---------------------------------------------------
Static Function MarcaTodos()
Local nQtd := 100
Local nreg := 0
Local TELA01 := SAVESCREEN(00,00,MaxRow(),MaxCol())
Local cMsg  := "La Villa, Ofertas!"+SPACE(100)

SETCOLOR('W/NN')
CLEAR
@ 09,10 say padc('PREENCHA DADOS PARA ENVIO ',80) COLOR('W/G+')
@ 10,10 SAY 'QUANTIDADE DE CONTATOS POR VEZ?' GET NQTD PICT '999999'
@ 10,10 say 'MENSAGEM ==>'
@ 12,10 Get cmsg  PICT "@S70"
READ
if lastkey()#27
    IF MSGCONF("Confirma MARCAO ! ","1") == .t.
       Go top
    
       Do while !Eof()
        if ! Empty(Contato->DataEnv) .and. nReg <= nQtd
             Trav_reg()
             Repla Contato->DataEnv With ''
             Repla Contato->MSg     With cMsg
             Repla Contato->Arquivo With 'PASTA'
             nreg++
        Endif
        Skip+1
       Enddo
       Commit
    Endif
Endif
Restscreen(00,00,MaxRow(),MaxCol(),tela01 )
Return nil

//---------------------------------------------------
Static Function DesMarcaTodos()
    IF MSGCONF("Confirma DESMARCACAO DE TODOS ! ","1") == .t.
       Go top
       Do while !Eof()
            Trav_reg()
             Repla Contato->DataEnv With DTOC(DATE())
             Repla Contato->MSg     With ''
             Repla Contato->Arquivo With ''
        Skip+1
       Enddo
       Commit
    Endif
Return nil

//------------------------------------------------------------
Static Function PESQNOME()
Local TELA01   := SAVESCREEN(00,00,MaxRow(),MaxCol())
Local cPesquisa:= Space(50)

SETCOLOR('W/NN')
CLEAR
@ 09,10 say padc('PESQUISA POR NOME',80) COLOR('W/G+')
@ 10,10 Get cPesquisa  PICT "@S70"
READ
if lastkey()#27
    IF MSGCONF("Confirma PESQUISA! ","1") == .t.
       cPesquisa:= upper(Alltrim(cPesquisa))
       Set filter to cPesquisa$Nome
       Go top
    Else
       set filter to 
    Endif
Endif
Restscreen(00,00,MaxRow(),MaxCol(),tela01 )
Return nil

//--------------------------------------------
Function GravaLog(cMsg)
Local cFileName := "c:\temp\logzap.txt"
Local hFile, cLine := "", n
Local cFieldAnt
Local CRLF    := Chr(13)+Chr(10)

//cLine := Dtoc(Date())+' '+Time()+CRLF 
cLine := cMsg +Time()+CRLF

If ! File( cFileName )    // Caso nao tenha cria o arquivo
     FClose( FCreate( cFileName ) )
Endif

Do Whil .T.
    If ( ( hFile := FOpen( cFileName, 1+16 ) ) # -1 )
        FSeek( hFile, 0, 2 )
        FWrite( hFile, cLine, Len( cLine ) )
        FClose( hFile )
        Exit
    Else
           Exit
    Endif
Enddo

Retu(.T.)

//------------------------------------------------------------------
Function Zap_checaContato(cNumero)
Local i

Local Url    :='http://api2.megaapi.com.br:15358/'// sendfilebase64?'
Local cToken := "M_CI33zodtF1UisZAD"
Local cRetorno :=''
Local mTemporal_:= 'c:\temp\'
Local cMsg     := 'testa contato'

    hHash := Hash()

    Url += 'checknumber?'
    Url += "token="+cToken

   *xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP.6.0")
    xmldoc = CREATEOBJECT("MSXML2.ServerXMLHTTP")
    xmldoc:setTimeouts(1000*60, 1000*60, 0, 0)
    xmldoc:open("POST", url, .f.)
    xmldoc:SetRequestHeader( "Content-Type", "application/json;charset=utf-8"  )
    xmldoc:SetRequestHeader( "token" , cToKen )

   Texto :='{'+;
        [ "phone": "55]+Alltrim(cNumero)+["}]

   lErroEnvio := .f.
   Try
    xmldoc:send(Texto)
    
   Catch oError
        CRLF := ''
        cErrorTmp :="Error: "  + Transform(oError:GenCode, nil) + CRLF +;
                    "SubC: "   + Transform(oError:SubCode, nil) + CRLF +;
                    "OSCode: "  + Transform(oError:OsCode,  nil) + CRLF +;
                    "SubSystem: " + Transform(oError:SubSystem, nil) + CRLF +;
                    "Mensagem: " + oError:Description
     
       * Alert("Erro ao chamar metodo SEND de HttpRequest (Registro envio)"+chr(10)+cErrorTmp )
        lErroEnvio := .t.
   End 

   If lErroEnvio == .t.
      Return .f. // cErrorTmp
   Endif

   DO WHILE xmldoc:readyState <> 4
      MILLISEC(1000)
   ENDDO

   Linha :=xmldoc:responseText
   Linha2:=xmldoc:ResponseBody()

   cTxtGerado := StrZero(Int(hb_random(10000)),5)

   MemoWrit(mTemporal_+'revisao2_'+cTxtGerado+'.txt',Texto)
   MemoWrit(mTemporal_+'revisao1_'+cTxtGerado+'.txt',Linha2 )

   hb_jsondecode( Linha2, @hHash )
            
   IF VALTYPE(hHash) != 'H'
      * Alert( 'Algo deu errado, verifique Endereço/token da API')
       RETURN(.F.)
   ENDIF 
   
   IF len(hHash)<0
      *Alert('Algo deu errado, verifique Endereço/token da API ou retorno vazio, tente novamente')
      RETURN(.F.)
   ENDIF 
   IF HHasKey( hHash, 'accountStatus' )
      Trav_reg()
      If hHash['accountStatus']==.f.
     Repla Contato->retorno With hHash['message']
     Repla Contato->Temzap  With 'NT'
      Else
     Repla Contato->retorno With hHash['message']
     Repla Contato->Temzap  With 'OK'
      Endif
   Endif
RETURN .t.

//---------------------------------------------------------------------
Static Function ChecaTodosContatos()
Local nReg := Reccount()
Local nAtu := 1
If Zap_VerStatus()==.f.
   Alerta('TEM QUE ESTA ATIVO O CELULAR?')
   Return nil
Endif

IF MSGCONF("Confirma Analise de todos os contatos ! ","1") == .t.
       Go top
       Do while !Eof()  
            If !Empty(Contato->TemZap)
            Skip+1;Loop
        Endif
                Centra(24,'Aguarde.. o termino.....'+Contato->Telefone+' Aguarde...'+Str(natu++,5)+'/'+Str(nReg,5))
        Zap_checaContato(Contato->Telefone)
        Skip+1
       Enddo
Endif
Commit
Return nil

10 horas atrás, kapiaba disse:

Very good, amanhã, vou testar.

Compilo utilizado a pdf.lib.

Frazato,

#include "cxwin.ch"
#include "jaf.ch"

Frazato, onde acho a PDF.LIB? E estes  Includes, são necessários?

Obg. abs.

Utilizo as libs hbhpdf.lib  e pdf.lib

não e necessario os arquivos includes, esqueci de retirar..

Frazato

Tarde!

Uso assim, todos os relatorio gero um Txt e importo para o DBF e gero o PDF.

Compilo utilizado a pdf.lib.

Frazato

 

#include "inkey.ch"
#include "cxwin.ch"
#include "jaf.ch"

Function Main()
   setcursor(0)
   REQUEST DBFCDX
   RDDSETDEFAULT("dbfcdx")
   DBSETDRIVER("dbfcdx")

   cARQ :='c:\temp\rela0008.txt'

   Sele 1
   use c:\temp\Preview alias Preview

   GERA_PDF(cARQ)

Return nil

*******************
FUNC GERA_PDF(cARQ,cVisualiza) 
******************* 
Private AMSG, CIMG 
PRIVATE oDlgHabla:=NIL 
AMSG := {} 
set(105,1) 
set(106,1) 

IF cARQ=Nil 
   cARQ="TEMP.PRN" 
Endif 

centra(24,"Aguarde Gerando Documento PDF...")
nSeq := 0

Do While ! Eof()
   nSeq++
   If ! File("p:\temp\JAF_"+StrZero(nSeq,4)+'.PDF')
        cFILE3 := "p:\temp\JAF_"+StrZero(nSeq,4)+'.PDF'
        Exit
   Endif
   If nSeq  >=9999
      Alerta("Faca a limpeza da pasta p:\temp\")
   Endif
Enddo

Sele Preview

nOpcao := AlertJAF("DESTINO"+;
                              ' ',{"### Normal ###",;
                                   "### Compactado DRE ###",;
                                   "### Romaneio ###" },"WW+/BR+,BB+/N" )
If nOpcao==1
    PdfNew(cFile3,nFonte,842,595,1,1,,,)
Elseif nopcao ==2
    PdfNew(cFile3,nFonte,595,842,1,1,,,)
Elseif nopcao ==3
    nFonte := 12
    PdfNew(cFile3,nFonte,842,595,1,1,,,)
Endif

//--- Atual ate 07.02.2014
//PdfNew(cFile3,8,842,595,1,1,,,)
// - 06-06-2019
//PdfNew(cFile3,7,842,595,1,1,,,)
*PdfNew(cFile3,nFonte,842,595,1,1,,,)

*Pdfsetfont( _cFont, _nType, _nSize, cId )
cFile := "fundo.jpg"

PdfStartPage( {""} , .T. )
//PdfImage(cFile,0,0)

dbgotop() 
cCONT=0
cQuebra:= .f.
Do while !eof() 
  *cLinha := Linha           // Busca linha de impressao
   cLinha  := l001+l002+l003+l004+l005+l006+l007+l008+l009+l010
   cCONT=cCONT+1
   cLinha  := StrTran(cLinha,'Ä','=')
   Aadd(AMSG,cLinha)
   I=0
   For I:= 1 to Len(cLinha)
       //---- Ajusta caracter
       If Substr(cLinha,i,1)==Chr(12)
          cQuebra:= .t.
          Exit
       Endif
   Next
   if cQuebra==.t.
      PdfDrawPage( AMSG ) 
      PdfEndPage() 
      PdfStartPage( {""} , .T. )
      cQuebra:= .f.
      AMSG   := {}  // Sei-la para quebra a pagina corretamente conforme o cabecario
      cCONT=0 
   ENDIF 
   dbskip() 
enddo 

PdfDrawPage( AMSG ) 
PdfEndPage() 
PdfEnd() 
IF oDlgHabla#NIL 
   oDlgHabla:CLOSE() 
ENDIF
*If cVisualiza=="S"
*   Abre_aqrquivo( cFile3 )
*Else
    Alerta('Criado arquivo....'+cFile3)
    Return cFile3
*Endif
return nil 

******************************************************************************** 
***************INCIO DA FUNCAO DE ABRIR ARQUIVOS******************************** 
******************************************************************************** 
// Open help file with associated viewer application 
FUNCTION Abre_aqrquivo( cHelpFile ) 
   LOCAL nRet, cPath, cFileName, cFileExt 
   HB_FNameSplit( cHelpFile, @cPath, @cFileName, @cFileExt ) 
   nRet := _OpenHelpFile( cPath, cHelpFile ) 
RETURN nRet 

#pragma BEGINDUMP 
  // #pragma comment( lib, "shell32.lib" ) 
   #include "hbapi.h" 
   #include <windows.h> 
   HB_FUNC( _OPENHELPFILE ) 
   { 
     HINSTANCE hInst; 
     LPCTSTR lpPath = (LPTSTR) hb_parc( 1 ); 
     LPCTSTR lpHelpFile = (LPTSTR) hb_parc( 2 ); 
     hInst = ShellExecute( 0, "open", lpHelpFile, 0, lpPath, SW_SHOW ); 
     hb_retnl( (LONG) hInst ); 
     return; 
   } 
#pragma ENDDUMP 
******************************************************************************** 
***************FIM DA FUNCAO DE ABRIR ARQUIVOS********************************** 
******************************************************************************** 
 

Tarde! com a Pesquisa em campo com indice e rapido mais pesquisar sem o indice fica lento, cheguei a fazer um tempo a trás mais desistir não tinha muito onde usar e tá lenta mais tinha me ajudado na época.

 

Frazato

Function Main()
/*By Joao Frazato
  Jaf Desenvolvimentos
  Pesquisa Geral - Ta lenta
*/

   REQUEST DBFCDX
   RDDSETDEFAULT("dbfcdx")
   DBSETDRIVER("dbfcdx")


   set confirm    On
   set deleted    on
   set bell       off
   set scoreboard off
   set date       british
   set epoch      to 1950
   Set date format to "DD/MM/YYYY"

   set exclusive off

   mTemporal := 'c:\temp\'
   cLocaServ := 'c:\temp\'
   cLocaServ := 'c:\servidor\dba\'
   cLocaServ := ''

   Set Defa to ( cLocaServ )

   BuscaGeral('c:\servidor\dba\')
Return nil

//------------------------------------------------
Function BuscaGeral(cLocal)
Local ListaDbf := {}
Local cPasta   := cLocal

Lista := {}
cPesq :='PERDIGAO'
*cPesq := '53196'
Aadd(ListaDbf,'Produto.dbf')
Aadd(ListaDbf,'Inventa1.dbf')

for i:= 1 to Len(ListaDbf)
    Close all

    cArq := cPasta+ListaDbf[i]
    @ 00,00 say cArq
    Use (cArq) Alias Tmp
    sele tmp
    Go top
    nTotReg := RecCount()
    nRegAtu := 0

    Do while ! Eof()
      cString := ''
      @ 02,00 say 'Aguarde....Termino...'+Str(nRegAtu++/nTotReg*100,7,2)+'%'
      for x:= 1 to FCount()
            If FieldType(x)=="C"
               cString+= FieldGet(x)
           * ElseIF FieldType(x)=="N"
           *    cString+= Str(FieldGet(x))
            Endif
      Next
      If cPesq$cString
         nPosInicial:= At(cPesq,cString)
         If nPosInicial > 15
            nPosInicial := nPosInicial -14
         Endif
         cString2    := SubStr(cString,nPosinicial,50)
         Aadd(Lista,cArq+'|Reg:'+Str(recno(),11)+'-'+cString2)
      Endif
      @ 24,00 say cString
      Skip+1
    Enddo

*      Lista := {}
*      *Centra(24,"Selecionando Registro(s) "+Time())
*      cPesq := '*'+Alltrim(cPesq) +'*'
*      cLista:= {}
*      Do While OrdWildSeek(cPesq,.t.)
*           Aadd(Lista,Str(recno(),11)+'-'+Tmp->DESCRICAO )
*           *Centra(24,"Selecionando Registro(s) "+Str(nReg++,5))
*       Enddo
       nPos := achoice(08,13,23,83,Lista,.t.,,)
*
*    *Dbedit(01,00,24,79)
Next
Return Nil

 

Bom dia!

Acabei de enviar uma NFe para SP colocando 0.01 no valor total e informando o desconto de 0.01 e o liquido e passou, ufa!

 

 

 

Bom dia! tive esse mesmo problema mais consegui pegar no site os lotes e enviados e apartir deles gerei os arquivos dos cupons   com a rotina abaixo:

 

#include "inkey.ch"
#INCLUDE "FILEIO.CH"

/* Compile usando
   Hbmk2 desdobra hbct.hbc
   By Frazato : frazato@ibest.com.br

*/ 

Function Main()
SetMode(23,80)
Clear
@ 00,00 say Padc('...### DESDOBRA DE ARQUIVO SAT(Direto Sefaz)###...',MaxCol()) Color('w+/r')
@ 01,00 say Padc('...### By Frazato (14) 99714-0865 ###...',MaxCol())
@ 02,00 say replica('_',MaxCol())

mListaArq  := Directory("*.xml","N")
@ 03,00 say 'Total de Arquivo(s) sefaz.....'+Str(Len(mListaArq),7) 
nLin := 4
wValorArq := 0
wValorArq := 0
wQtdArq   := 0

For i:= 1 to Len(mListaArq)
    cArquivo := mListaArq[i,1]
    MostraItens(cArquivo,nLin++)
    *Delete File to (cArquivo)
    If nLin >= MaxCol()-2
       nLin := 4
    Endif
Next
mListaArqSaidas  := Directory("CFe\*.xml","N")
cMsg1  := 'Total de Arquivo(s) Gerado(s)..'+Str(Len(mListaArqSaidas),15)
Alert('Processo terminado!'+cMsg1)
Return nil

//--------------------------------------------------------------------------------
Function MostraItens(cFileDanfe,nLinhaTela)
cPastaSaida := 'CFe\'
nRet        := DirMake('CFe')
    if !file(cFileDanfe)  
       alert('Arquivo nao esta na pasta....'+cFileDanfe)
    Endif
     

    Linha       := Memoread(cFileDanfe)
    nLinhalidas := 0
    Linhatotal  := Len(Linha)
    cLinhaTxt   := Linha
    cArqXmlLido := Linha

    Do While .t.
            cLidos := PegaDados('CFe',Alltrim(cLinhaTxt),.t.,'CFe' )
            Linha  := cLidos
                    
            cArqSaida := PegaNomeXmlChave(cLidos)
            If cArqSaida#'ERROXML'
                GravaSaida(cPastaSaida+'CFe'+cArqSaida+'.xml',cLidos)
                
                cArquivo_ := cPastaSaida+'CFe'+cArqSaida+'.xml'
                wQtdArq   := PegaValorCupom( PegaDados('total',Alltrim(cLidos),.t.,'total') )
                wValorArq += wQtdArq 
                
                @ nLinhaTela,00 say 'Desdobrando....'+cArquivo_ + Space(10) + Str(wQtdArq,5)+Space(5)+Transf(wValorArq,'@EZ 9999,999.99')
                @ 03,50 say 'R$ Pasta....'+Transf(wValorArq,'@EZ 9999,999.99')
    
            Endif
            cDadosItem := cLidos
            If Linha=='0'
               Exit
            Endif
            nSize         := Linhatotal-nLinhaLidas
            cLinha        := Right(cLinhaTxt,nSize)
            cLinhaTxt     := cLinha
            If nLinhaLidas >= Linhatotal
               Exit
            Endif
    Enddo
Return nil
//------------------------------------------------------
Function GravaSaida(cArq,cTexto)
Local Handle := FCreate(cArq)
             If Ferror() # 0
                   Alert("Impossivel Criar o Arquivo:"+Chr(10)+;
                         cArq   )

              Endif
              Fwrite(Handle,'<CFe'+Alltrim(cTexto)+'</CFe>')
              FClose(Handle)
Return nil
              
//------------------------------------------------------
Function PegaNomeXmlChave(cLinha)
Local nPosIni  := At([Id="CFe],cLinha)
If nPosIni==0
   Return 'ERROXML'
Endif
cRet := Substr(cLinha,nPosIni+7,44)
Return  ( cRet)
    
//------------------------------------------------------
Function PegaDados(cProc,cLinha,lItem,cTexto2)
Local InicioDoDado :=Iif(cTexto2==Nil,"<"+cProc+">" , "<"+cProc )
Local FinalDoDado := Iif(cTexto2==Nil,"</"+cProc+">",'</'+cTexto2+'>')
Local nPosIni     := At(InicioDoDado,cLinha)
Local nPosFim     := At(FinalDoDado,cLinha)
Local cRet        := '0'
Local x
If nPosIni==0 .or. nPosFim==0
   Return cRet
Endif
cRet := Substr(cLinha,nPosIni+Len(IniciodoDado),nPosFim-nPosIni-Len(FinalDoDado)+1)
If lItem ==.t.
   nLinhalidas  += nPosFim
Endif
Return  ( cRet)
//------------------------------------------------------------
Static Function PegaValorCupom(cLinha)
Local nPos1  := At('<vCFe>',cLinha)
Local nPos2  := At('</vCFe>',cLinha)
Local cTraco := Substr(cLinha,nPos1+6,nPos2)
Return Val(cTraco)

 

http://www.pctoledo.com.br/forum/viewtopic.php?f=4&t=17940

Boa tarde!!!

Tenho um menu onde tenho as funções gerada no executável e gostaria de saber como vcs fazem pra chegar a existencia da mesma no arquivo HRB e executar apartir o HRB!

Como uso Gtwvw fiz da seguinte maneira:

1 - Crie um arquivo INI contendo as funções a serem usada pelo HRB

2- Carrego no inicio do sistema todos os HRB

3 - Quando vou montar os menus chego o INI e tendo a nova função não monto o menu, crio um novo menu com as atualizações ( Isso tá tosco ainda) e uso função com nome diferente no HRB, tipo cadcliente(), HRB_cadcliente()

a minha parte de usar o mesmo menu do sistema para executar a função do HRB da muito ruim, mais indo.

Gostaria de saber como vcs fazem ou uma outra maneira de pensar.

Mais já tá a meu contento.

Obrigado, 

Frazato

Como você faz para tratar isso em tempo de execução, tipo quando executar um "HRB" ou rotina compilada em vosso sistema?

Frazato

Existe alguma maneira de usar os arquivo.ch sem ter que colocar dentro do PRG?

Frazato

Ufa ! consegui fazer funcionar do jeito que eu queria( Até agora), de dentro do programa principal executar  crie uma funcao que executa 

 __HrbLoad( fileHRB )  e boa já era agora quero criar uma situação para trocar em tempo de execução uma rotina, tipo caso exista uma rotina/arquivo executa ao inves de usar o existente no arquivo.exe

Obrigado, vou lutando!!!!

Frazato

Legal!! e possível eu criar um prg com todas as funções/rotinas e carregar antes do prg com a minha função especifica?

Frazato

Bom dia!!

Fiz o teste usando funções simples de alert() funciona, mais como faço para usar uma rotina de relatorio, onde as funções de telas, *.ch, e funções de perguntas estão em outro PRG, tenho que colocar todas as funções e *.ch dentro do mesmo prg pra compilar?

Frazato

Já tentei mudar a um tempo atrás para mysql mais não tive sucesso, hoje uso alguns acesso via mysql mais o grosso do sistema e dbf, utilizo acesso remoto usando o Go-Global com velocidade local, por curiosidade tenho aqui no mercado uma frente de caixa da Gz sistemas que era em CLIPPER/DOS/DBF ( avião de rapido) hoje tá em linux/Java/Mysql ta uma carroça, a me desanima para tentar mudar novamente!

Frazato

Meus sinceros pêsames a família, tive pouco contato com ele mais era uma pessoa fantástica.

Bom dia! tenho um processo igual ao que vc esta tentando montar mais não compartilho a impressora, fiz um programa que roda como serviço na maquina em que está instalado a impressora fisica que fica monitorando um pasta onde estão os arquivos txt pronto e simplesmente copio para impressora, no meu caso tenho impressora diferentes em portas diferentes ai direciono de acordo com o formato e o tipo de saída.

Fiz usando o xharbour 99.7 e gtwvw.

Obs : Coloque a o servidor como serviço para evitar que o usuário feche o programa e no caso de rede o serviço não enxerga compartilhamento ou seja você terá que copiar o arquivo na maquina servidor ( sofri muito até descobrir..rs)

Frazato

Boa tarde! Edvaldo, gostaria de saber ser você consegui fazer uso da função da clisitef para pegar o número do cartão ( Trilhas), estou tentando aqui e estou tendo o mesmo problema que você teve de não retornar nada e nem acionar o visor, desde já agradeço a ajuda.

Frazato

frazato@ibest.com.br

Bom dia! tem este código que utilizo, porem por algum motivo ele não funciona para mais de 10 locais, de uma olhada se ajuda qualquer coisa me avise.

Bom dia! você poderia me informar em qual campos se informa os valores de outras, fazendo um favor.

Boa tarde!

Estou fazendo uma rotina para envio de arquivo xml de nota fiscal eletronica usando CDO.MESSAGE baseado nesta rotina e funciona para BOL/IBEST/HOTMAIL os demais não tive como testar, so que tenho alguns problemas não envia email em todas as maquinas, tive que desabilitar o antivirus e não consigo enviar varios email para destinatarios diferentes e de vez en quando ela não funciona, se alguem tiver uma ideia para me ajudar agradeço.

Frazato

Frazato

Aqui no mercado tem Pdv da Gz sistema e nele tem a opção de utilizar senha de fiscal no Caixa, aqui a coisa e bem mais simples, pois se o leitor for serial não se consegui fazer a leitura sem ser pelo sistema, caso seja teclado até é possivel ver a senha sendo digitada. no sistema e montado apenas um Get com que não mostra oque esta sendo digitado e no cartao nao imprimi o codigo em numeros apenas as barras, mais oque garante que o usuario nao digite a senha e simples, o cartao tem que esta sempre com o fiscal e tudo que feito no cartao fica gravado em arquivos de log de alteração, caso pegue algum alteração feita pelo operador sem a leitura do cartao, manda embora ( isso resolve), cheguei a trabalhar com PDV unisys que tinha teclado com chaves e as operadoras passavam a perna, ate vc começar a mandar embora.

Frazato

Frazato

Bom dia a um tempo atras tive que fazer algo para o microterminal Wilbor usando socket, de uma olhada.

http://www.pctoledo.com.br/forum/viewtopic.php?f=4&t=7934

frazato

Frazato

Bom dia! tenho uma rotina que faz a leitura do XML e importa para o meu sistema de ERP. já cheguei a testar a rotina do Lailton mais após mudar o endereço do Sefaz não uso mais, hj uso um programa da SIM consultoria que faz a captura do XML pelo site do SEFAZ sem ter que digitar o CAPTCHA com quase 100% de retorno dos dados ( claro sem o PIS e Cofins).

segue o link.

http://www.pctoledo.com.br/forum/viewtopic.php?f=43&t=9528&hilit=lerdanfe

Frazato

Frazato