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

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