william

olá achei isso, veja se te ajuda. William // // Recuperar inventario da ANVISA para o SNGPC. // Manoel Angeiras, 2011 // #define STRU_TMP { { "NUMMS ", "C", 13, 0 }, { "NOMEPRO ", "C", 46, 0 },; { "NUMLOTE ", "C", 20, 0 }, { "QTDLOTE ", "N", 6, 0 } } *************** FUNCTION MAIN() *************** if !InternetOK() Alert("Sem conexão com a Internet. Verifique...") return .F. endif // // ABERTURA DAS FUNCOES PARA WEBSERVICE DO XHARBOUR // try http := CreateObject( "MSXML2.XMLHTTP" ) catch try http := CreateObject( "MSXML2.XMLHTTP" ) catch Alert("Erro na criação do objeto MSXML2.XMLHTTP : " + Ole2TxtError()) end end // // AS COMUNICACOES SEGUINTES FORAM BASEADAS NA MINHA OBSERVACAO DE LOGIN // MANUAL NO SITE DA ANVISA, USANDO UM WEB DEBUGGER // // // VERIFICAR A DISPONIBILIDADE DO SITE DA ANVISA // cRet := RequestOpen() // // CONFIGURAR E LER COOKIE CRIADO POR ESSA COMUNICACAO // cCookie := LerCookie() // // FAZER LOGIN NO SITE ANVISA // cRet := Login( alltrim( cCookie ), SEU_EMAIL, SUA_SENHA ) memowrit("lerinv.txt", cRet) // // SALVEI A RESPOSTA EM .TXT, MAS NA VERDADE UM XML, ACHO QUE Dµ PRA LER // COM A CLASSE TxmlDocument // cEmpresa := cRT := cNome := "" AchaToken("lerinv.txt", @cEmpresa, @cRT, @cNome) if empty( cEmpresa ) Alert("Problema na identificacao da empresa. Verifique...") return .F. endif if empty( cRT ) Alert("Problema na identificacao do Responsavel Tecnico. Verifique") return .F. endif // // SELECIONA A EMPRESA. TEM AQUI UMA LIMITACAO : O RESPONSAVEL TECNICO SO // PODE ESTAR LIGADO A UMA EMPRESA ( FARMACEUTICO NO INTERIOR DOS ESTADOS // PODEM CONTROLAR AT DUAS FARMACIAS/DROGARIAS ). SE POSSUIR MAIS DE UMA // EMPRESA, NAO LE CORRETAMENTE // cRet := SelEmpresa( cCookie, cEmpresa, cRT, cNome ) memowrit("lerinv.txt", cRet) cID1 := AchaToken2("lerinv.txt") // // SELECIONA RESPONSAVEL TECNICO // cRet := SelRT( cCookie, cEmpresa, cRT, cNome, cID1 ) // // LER MENU DO SITE ANVISA // LerMenu( cCookie ) // // LER INVENTARIO. ACHO QUE ESSE PASSO PODE SER DESCONSIDERADO // cRet := VerInv( cCookie ) memowrit("verinv.txt", cRet) // // CHAMO A TELA DE FINALIZACAO DO INVENTARIO, QUE CONTEM OS PRODUTOS COM OS // SEUS LOTES // cRet := FimInv( cCookie ) memowrit("lotesinv.txt", cRet) // // GRAVO O RESULTADO EM UM DBF PARA PROCESSAR DEPOIS // lRet := CriaDBF( "lotesinv.txt" ) RETURN lRet ***************************** STATIC FUNCTION REQUESTOPEN() ***************************** // // ENDERECO DE HOMOLOGACAO // http:Open( "GET", "http://homologacao.anvisa.gov.br/sngpc/", .F. ) http:SetRequestHeader( "Accept", "*/*" ) http:SetRequestHeader( "Accept-Language", "pt-br" ) http:SetRequestHeader( "Accept-Encoding", "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) // // ENDERECOS DE PRODUCAO // // http:Open( "GET", "https://sngpc.anvisa.gov.br/", .F. ) // http:SetRequestHeader( "Accept", "*/*" ) // http:SetRequestHeader( "Accept-Language", "pt-br" ) // http:SetRequestHeader( "Accept-Encoding", "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:send() response := http:statusText RETURN response *************************** STATIC FUNCTION LERCOOKIE() *************************** // // ENDERECO DE HOMOLOGACAO // http:Open( "GET", "http://homologacao.anvisa.gov.br/sngpc/includes/fundo.asp", .F. ) http:SetRequestHeader( "Accept", "image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-shockwave-flash, application/x-ms-application, application/x-ms-xbap, application/vnd.ms-xpsdocument, application/xaml+xml, application/x-silverlight, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*" ) http:SetRequestHeader( "Referer", "http://homologacao.anvisa.gov.br/sngpc/" ) http:SetRequestHeader( "Accept-Language", "pt-br" ) http:SetRequestHeader( "Accept-Encoding", "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) // // ENDERECO DE PRODUCAO // // http:Open( "GET", "https://sngpc.anvisa.gov.br/includes/fundo.asp", .F. ) // http:SetRequestHeader( "Accept", "image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-shockwave-flash, application/x-ms-application, application/x-ms-xbap, application/vnd.ms-xpsdocument, application/xaml+xml, application/x-silverlight, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*" ) // http:SetRequestHeader( "Referer", "https://sngpc.anvisa.gov.br/" ) // http:SetRequestHeader( "Accept-Language", "pt-br" ) // http:SetRequestHeader( "Accept-Encoding", "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:send() response := http:getResponseHeader("Set-Cookie") RETURN response ************************************************ STATIC FUNCTION LOGIN( cCookie, memail, msenha ) ************************************************ // // ENDERECO DE HOMOLOGACAO // http:Open( "POST", "http://homologacao.anvisa.gov.br/sngpc/includes/AcessoPersistir.asp", .F. ) http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) http:SetRequestHeader( "Referer" , "http://homologacao.anvisa.gov.br/sngpc/includes/login.asp" ) http:SetRequestHeader( "Accept-Language" , "pt-br" ) http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:SetRequestHeader( "Keep-Alive" , "115" ) http:SetRequestHeader( "Cookie" , cCookie ) http:SetRequestHeader( "Content-Type" , "application/x-www-form-urlencoded" ) // // ENDERECO DE PRODUCAO // // http:Open( "POST", "https://sngpc.anvisa.gov.br/includes/AcessoPersistir.asp", .F. ) // http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) // http:SetRequestHeader( "Referer" , "https://sngpc.anvisa.gov.br/includes/login.asp" ) // http:SetRequestHeader( "Accept-Language" , "pt-br" ) // http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) // http:SetRequestHeader( "Keep-Alive" , "115" ) // http:SetRequestHeader( "Cookie" , cCookie ) // http:SetRequestHeader( "Content-Type" , "application/x-www-form-urlencoded" ) http:send( "email=" + memail + "&senha=" + msenha + "&Entrar=Entrar" ) response := http:responseText RETURN response ****************************************************** STATIC FUNCTION SELEMPRESA( cCookie, cID, cRT, cNome ) ****************************************************** // // ENDERECO DE HOMOLOGACAO // http:Open( "POST", "http://homologacao.anvisa.gov.br/sngpc/includes/AcessoPersistir.asp", .F. ) http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) http:SetRequestHeader( "Referer" , "http://homologacao.anvisa.gov.br/sngpc/includes/AcessoPersistir.asp") http:SetRequestHeader( "Accept-Language" , "pt-br" ) http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:SetRequestHeader( "Keep-Alive" , "115" ) http:SetRequestHeader( "Cookie" , cCookie ) http:SetRequestHeader( "Content-Type" , "application/x-www-form-urlencoded" ) // // ENDERECO DE PRODUCAO // // http:Open( "POST", "https://sngpc.anvisa.gov.br/includes/AcessoPersistir.asp", .F. ) // http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) // http:SetRequestHeader( "Referer" , "https://sngpc.anvisa.gov.br/includes/AcessoPersistir.asp") // http:SetRequestHeader( "Accept-Language" , "pt-br" ) // http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) // http:SetRequestHeader( "Keep-Alive" , "115" ) // http:SetRequestHeader( "Cookie" , cCookie ) // http:SetRequestHeader( "Content-Type" , "application/x-www-form-urlencoded" ) http:send( "hidPasso=1&hidPessoaRepresentada=" + cID +; "&hidTipoPessoaRepresentada=&hidPessoaFisica=" + cRT +; "&hidNomeEmpresa=" + cNome +; "&hidRepresentante=&hiComboRepresentacao=&hiComboRepresenta=" + cID +; "&Representa=&Representacao=&IDPESSOAREPRESENTADA=" + cID ) response := http:responseText RETURN response ******************************************************* STATIC FUNCTION SELRT( cCookie, cID, cRT, cNome, cID1 ) ******************************************************* // // ENDERECO DE HOMOLOGACAO // http:Open( "POST", "http://homologacao.anvisa.gov.br/sngpc/includes/AcessoPersistir.asp", .F. ) http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) http:SetRequestHeader( "Referer" , "http://homologacao.anvisa.gov.br/sngpc/includes/AcessoPersistir.asp") http:SetRequestHeader( "Accept-Language" , "pt-br" ) http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:SetRequestHeader( "Keep-Alive" , "115" ) http:SetRequestHeader( "Cookie" , cCookie ) http:SetRequestHeader( "Content-Type" , "application/x-www-form-urlencoded" ) // // ENDERECO DE PRODUCAO // // http:Open( "POST", "https://sngpc.anvisa.gov.br/includes/AcessoPersistir.asp", .F. ) // http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) // http:SetRequestHeader( "Referer" , "https://sngpc.anvisa.gov.br/includes/AcessoPersistir.asp") // http:SetRequestHeader( "Accept-Language" , "pt-br" ) // http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) // http:SetRequestHeader( "Keep-Alive" , "115" ) // http:SetRequestHeader( "Cookie" , cCookie ) // http:SetRequestHeader( "Content-Type" , "application/x-www-form-urlencoded" ) http:send( "hidPasso=2&hidPessoaRepresentada=" + cID +; "&hidTipoPessoaRepresentada=1" +; "&hidPessoaFisica=" + cRT +; "&hidNomeEmpresa=" + cNome +; "&hidRepresentante=" + cID1 +; "&hiComboRepresentacao=RESPONS%C1VEL+T%C9CNICO" +; "&hiComboRepresenta=" + cID +; "&Representa=" + cID +; "&Representacao=" +; "&IDPESSOAREPRESENTADA=" + cID +; "&CBOTIPOS=1" ) response := http:responseText RETURN response ********************************** STATIC FUNCTION LERMENU( cCookie ) ********************************** // // ENDERECO DE HOMOLOGACAO // http:Open( "GET", "http://homologacao.anvisa.gov.br/sngpc/includes/menu.asp", .F. ) http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) http:SetRequestHeader( "Referer" , "http://homologacao.anvisa.gov.br/sngpc/includes/AcessoPersistir.asp") http:SetRequestHeader( "Accept-Language" , "pt-br" ) http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:SetRequestHeader( "Cookie" , cCookie ) // // ENDERECO DE PRODUCAO // // http:Open( "GET", "https://sngpc.anvisa.gov.br/includes/menu.asp", .F. ) // http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) // http:SetRequestHeader( "Referer" , "https://sngpc.anvisa.gov.br/includes/AcessoPersistir.asp") // http:SetRequestHeader( "Accept-Language" , "pt-br" ) // http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) // http:SetRequestHeader( "Cookie" , cCookie ) http:send() response := http:responseText RETURN response ********************************* STATIC FUNCTION VERINV( cCookie ) ********************************* // // ENDERECO DE HOMOLOGACAO // http:Open( "GET", "http://homologacao.anvisa.gov.br/sngpc/sngpc_frmVisualizaInventario.asp", .F. ) http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) http:SetRequestHeader( "Referer" , "http://homologacao.anvisa.gov.br/sngpc/includes/menu.asp") http:SetRequestHeader( "Accept-Language" , "pt-br" ) http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:SetRequestHeader( "Cookie" , cCookie ) // // ENDERECO DE PRODUCAO // // http:Open( "GET", "https://sngpc.anvisa.gov.br/sngpc_frmVisualizaInventario.asp", .F. ) // http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) // http:SetRequestHeader( "Referer" , "https://sngpc.anvisa.gov.br/includes/menu.asp") // http:SetRequestHeader( "Accept-Language" , "pt-br" ) // http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) // http:SetRequestHeader( "Cookie" , cCookie ) http:send() response := http:responseText RETURN response ********************************* STATIC FUNCTION FIMINV( cCookie ) ********************************* // // ENDERECO HOMOLOGACAO // http:Open( "GET", "http://homologacao.anvisa.gov.br/sngpc/sngpc_frmFinalizaInventario.asp", .F. ) http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) http:SetRequestHeader( "Referer" , "http://homologacao.anvisa.gov.br/sngpc/includes/menu.asp") http:SetRequestHeader( "Accept-Language" , "pt-br" ) http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) http:SetRequestHeader( "Host" , "homologacao.anvisa.gov.br" ) http:SetRequestHeader( "Connection" , "Keep-Alive" ) http:SetRequestHeader( "Cookie" , cCookie ) // // ENDERECO DE PRODUCAO // // http:Open( "GET", "https://sngpc.anvisa.gov.br/sngpc_frmFinalizaInventario.asp", .F. ) // http:SetRequestHeader( "Accept" , "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" ) // http:SetRequestHeader( "Referer" , "https://sngpc.anvisa.gov.br/includes/menu.asp") // http:SetRequestHeader( "Accept-Language" , "pt-br" ) // http:SetRequestHeader( "Accept-Encoding" , "gzip, deflate" ) // http:SetRequestHeader( "User-Agent" , "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; BTRS25991; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; AskTB5.6)" ) // http:SetRequestHeader( "Host" , "sngpc.anvisa.gov.br" ) // http:SetRequestHeader( "Connection" , "Keep-Alive" ) // http:SetRequestHeader( "Cookie" , cCookie ) http:send() response := http:responseText RETURN response ************************************************** STATIC FUNCTION ACHATOKEN( cFile, cEmp, cRT, cRS ) ************************************************** local aLines, nHand2, nA, nB, nPos, cRet := "" aLines := {} nHand2 := fopen( cFile ) cLine := "" while HB_FReadLine( nHand2, @cLine ) == 0 aadd( aLines, upper( cLine ) ) enddo aadd( aLines, cLine ) fClose( nHand2 ) for nA := 1 to len( aLines ) if ( nPos := at( '<INPUT TYPE="HIDDEN" NAME="HIDPESSOAFISICA" VALUE="', aLines[nA] ) ) # 0 for nB := nPos+51 to len( aLines[ nA ] ) if substr( aLines[ nA ], nB, 1 ) # '"' cRT += substr( aLines[ nA ], nB, 1 ) else exit endif next endif if ( nPos := at( "<OPTION VALUE='", aLines[nA] ) ) # 0 for nB := nPos+15 to len( aLines[ nA ] ) if substr( aLines[ nA ], nB, 1 ) # "<" cEmp += substr( aLines[ nA ], nB, 1 ) else exit endif next endif next x1 := x2 := "" lOK:= .F. for nA := 1 to len( cEmp ) if substr( cEmp, nA, 1 ) # "'" .and. !lOk x1 += substr( cEmp, nA, 1 ) else if !lOK nA++ lOk := .T. else x2 += substr( cEmp, nA, 1 ) endif endif next cEmp := x1 cRS := strtran( x2, " ", "+" ) RETURN *********************************** STATIC FUNCTION ACHATOKEN2( cFile ) *********************************** local aLines, nHand2, nA, nB, nPos, cRet := "" aLines := {} nHand2 := fopen( cFile ) cLine := "" while HB_FReadLine( nHand2, @cLine ) == 0 aadd( aLines, alltrim( upper( cLine ) ) ) enddo aadd( aLines, cLine ) fClose( nHand2 ) for nA := 1 to len( aLines ) if ( nPos := at( "<OPTION ID='", aLines[nA] ) ) # 0 for nB := nPos+12 to len( aLines[ nA ] ) if substr( aLines[ nA ], nB, 1 ) # "'" cRet += substr( aLines[ nA ], nB, 1 ) else exit endif next endif next RETURN cRet ******************************** STATIC FUNCTION CRIADBF( cFile ) ******************************** local aLines, nHand2, nA, nB, nPos, cRet := "" aLines := {} nHand2 := fopen( cFile ) cLine := "" while HB_FReadLine( nHand2, @cLine ) == 0 aadd( aLines, alltrim( upper( cLine ) ) ) enddo aadd( aLines, cLine ) fClose( nHand2 ) lMS := lNome := lLote := lQtd := .F. cMS := cNome := cLote := cQtd := "" aInv:= {} for nA := 1 to len( aLines ) // // LE O MS DO PRODUTO // if ( nPos := at( '<TD WIDTH="17%" CLASS="SEMBORDA" HEIGHT="20">', aLines[nA] ) ) # 0 for nB := nPos+45 to len( aLines[ nA ] ) if substr( aLines[ nA ], nB, 1 ) # "<" cMS += substr( aLines[ nA ], nB, 1 ) lMS := .T. else exit endif next endif // // LE O NOME DO PRODUTO // if ( nPos := at( '<TD WIDTH="50%" CLASS="SEMBORDA" HEIGHT="20">', aLines[nA] ) ) # 0 for nB := nPos+45 to len( aLines[ nA ] ) if substr( aLines[ nA ], nB, 1 ) # "<" cNome += substr( aLines[ nA ], nB, 1 ) lNome := .T. else exit endif next endif // // LE O LOTE DO PRODUTO // if ( nPos := at( '<TD WIDTH="18%" CLASS="SEMBORDA" HEIGHT="20">', aLines[nA] ) ) # 0 for nB := nPos+45 to len( aLines[ nA ] ) if substr( aLines[ nA ], nB, 1 ) # "<" cLote += substr( aLines[ nA ], nB, 1 ) lLote := .T. else exit endif next endif // // LE A QUANTIDADE DO PRODUTO // if ( nPos := at( '<TD WIDTH="15%" CLASS="SEMBORDA" HEIGHT="20">', aLines[nA] ) ) # 0 for nB := nPos+45 to len( aLines[ nA ] ) if substr( aLines[ nA ], nB, 1 ) # "<" cQtd += substr( aLines[ nA ], nB, 1 ) lQtd := .T. else exit endif next endif if lMS .and. lNome .and. lLote .and. lQtd aadd( aInv, { cMS, cNome, cLote, cQtd } ) lMS := lNome := lLote := lQtd := .F. cMS := cNome := cLote := cQtd := "" endif next if empty( aInv ) return .F. endif dbCreate( "TEMP.DBF", STRU_TMP ) use ("TEMP.DBF") alias tmp exclusive new if neterr() return .F. endif for nA := 1 to len( aInv ) tmp->(dbAppend()) tmp->numms := TiraPonto( aInv[ nA, 1 ] ) tmp->nomepro := aInv[ nA, 2 ] tmp->numlote := aInv[ nA, 3 ] tmp->qtdlote := val( aInv[ nA, 4 ] ) next tmp->(dbCloseArea()) RETURN .T. ******************************* STATIC FUNCTION TIRAPONTO( ms ) ******************************* local nA, nLen := len( alltrim( ms ) ), cRet := "" for nA := 1 to nLen if isdigit( substr( ms, nA, 1 ) ) cRet += substr( ms, nA, 1 ) endif next RETURN cRet ********************* FUNCTION InternetOK() ********************* local aHosts, cName, cAddress := "www.google.com.br" InetInit() aHosts := InetGetHosts( cAddress ) if aHosts == NIL .or. len(aHosts) == 0 InetCleanup() return .F. endif InetCleanup() RETURN .T.

Boa tarde, agora sim , terminei de adaptar a ultima versao do codigo do Daniel (14/12/2016) para funcionar com xharbour. Tambem arrumei o erro que as vezes nao aparecia o captcha. Caso a TIP.LIB do seu xharbour nao tiver a função HB_BASE64DECODE() ( as versoes mais recentes do xharbour nao tem) , segue no pacote a tip.lib que contem a funcao,, basta inclui-la no projeto. Abaixo o link para descarregar o pacote com o fonte (NFE.PRG). http://www.4shared.com/rar/hbk9ZBefba/nfedosite3.html Att. William Adami

Olá Alexandre, só uma dúvida , essa sua rotina precisa do resistor de 3k9 x 5 watts na linha telefonica ? Obrigado William segue o link da rotina http://www.4shared.com/rar/BkdfcaKNce/bina.html

Beleza Theotokos, consegui receber pelo yahoo. no gmail não veio nada, deve ser porque tem .EXE dentro do rar ... Era esse mesmo que eu tinha , muito obrigado . Abraço William

olá Kapiaba, esta rotina eu nao conhecia , vou verificar... Theotokos não recebi no meu e-mail, poderia enviar novamente ? segue meus dois e-mails: williamdebritoadami@gmail.com williamdebritoadami@yahoo.com.br Obrigado a todos

Boa noite eu tinha uma rotina que foi colocada em DICAS, feita em fivewin pelo Alexandre Pereira, mas perdi... Alguem tem aí pra me enviar ? obrigado William williamdebritoadami@gmail.com

Beleza HASA, vou procurar e ler a respeito. Muito obrigado William

ok HASA, então o Sped vai ser necessário? Onde encontro o layout ou manual disso? Obrigado William

Bom dia, uma dúvida sobre o SAT para quem já está utilzando. Como ficam o Sintegra, speed e outras exigencias anteriores? No SAT não vai precisar mais disso? Um amigo me disse que no SAT não vai mais precisar homologar PAF, que é só cadastrar a empresa/aplicativo na receita, é isso mesmo ? Obrigado William

Olá abaixo a forma como eu faço isso que vc quer usando objeto WScript.Shell. William Adami ccomando:="teste.bat" myrun(cComando) FUNCTION myRUN( cComando, nStyle, lWait, lShowResult ) local oShell, RET IF valtype( nStyle ) != "N" nStyle := 0 ENDIF IF ValType( lWait ) != "L" lWait := .T. ENDIF IF ValType( lShowResult ) != "L" lShowResult := .F. ENDIF oShell := CreateObject( "WScript.Shell" ) IF !GetEnv( "OS" ) == "Windows_NT" cComando += "start " + cComando ENDIF TRY RET := oShell:Run( "%comspec% /c " + cComando, nStyle, lWait ) CATCH msgstop("ERRO NO ENVIO DO COMANDO !","ERRO") END IF lShowResult .AND. RET > 0 .and. RET <= 32 msginfo( "Erro Win_Run(): " + ltrim( Str( RET ) ), " OK " ) ENDIF oShell := NIL Return IF( RET = 0, .T., .F. )

Olá Eduardo , esta eu posso tentar te responder. O oCBX:CalcularDadosBoletos() vai gerar a linha digitável, ou seja o numero do codigo de barras do boleto. Feito isso, pode-se pegar os dados necessarios para fazer o boleto , como no exemplo cCodigoAgencia := oCBX:CodigoAgencia cCodigoCedente := oCBX:CodigoCedente cNumeroCCorrente := oCBX:NumeroContaCorrente cCodigoCarteira := oCBX:CodigoCarteira cNrBanco := oCBX:NumeroBanco com a linha digitavel e os outros dados do boleto, vc pode inserir num arquivo temporario e gerar os boletos com a fastreport. Aqui no forum já foi postado uma vez os .FR3 de boletos de diversos bancos. Se precisar posso procurar e te enviar. Att. William

beleza Alessandro , colocando a pasta destino na url , aqui funcionou certinho. Obrigado William Adami

olá Kapiaba , testei de tudo que é jeito e pelo que eu percebi está com bug no Method UploadFile() por isso não grava o arquivo na pasta corretamente. Se vc testar dando o comando cwd("trab") e depois o comando list("trab") ele mostra o conteudo da pasta trab corretamente. Agora na funcao uploadfile() só grava na pasta raiz do ftp. Como eu sempre gravei na pasta raiz do ftp, nunca tinha percebido este bug.... William

olá Kapi, oFTP:Cwd("/teste") ou simplesmente oFTP:Cwd("teste") deveria funcionar , mas pelo que eu vi tem um bug na TIP.LIB nas versoes antes de abril de 2014. Se alguem tiver uma versao mais recente da tip.lib creio que esse bug ja foi resolvido. Veja o post do Enrico na lista de desenvolvedores do xharbour: 2014-04-27 22:25 UTC+0100 Enrico Maria Giordano <e.m.giordano@...> * source/tip/ftpcln.prg ! reverted the following change: ! fixed Cwd() method, it now sets oUrl:cPath on successEMG att. William Adami

Oscar realmente havia um erro na funcao lista() , quando nao existe nenhum arquivo ou pasta no ftp, ele dava o erro. Pode consertar assim na funcao lista(): .... IF oFTP:Open( cUrl ) aFiles := oFtp:listFiles() *** coloque isso aqui************ if len(aFiles)=0 msgalert("Nenhum arquivo encontrado .") oFTP:Close() return nil endif ****************************** cRoot := aFiles[1,1] que vai resolver o erro. quanto ao envio e recebimento, aqui e em todos os meus clientes nunca deu erro. Verifique se o caminho, ususario e senha estao certos. Abra o seu FTP com o filezilla e vai observando o que acontece. Att. William Adami

aqui 1 exemplo de como fazer via HTTP . Essa lib TIP.LIB é boa mesmo. *************** FUNCTION MAIN() *************** Local cURL, lRet:=.F. Local nTAMANHO:=0 LOCAL oConn cURL := "http://www.meusite.com.br/arquivo.rar" nTAMANHO := GET_FILE_SIZE('arquivo.rar') // aqui uso uma função em PHP para pegar o tamanho do arquivo TRY oConn := TipClientHttp():New(TURL():New(cURL)) oConn:nConnTimeout := 10000 oConn:exGauge := { | done, size| ShowGauge(done, size, nTAMANHO ) } IF oConn:Open(cURL) oConn:ReadToFile('c:\salva_nessa_pasta\nome_do_arquivo.rar') oConn:Close() ENDIF lRet:=.T. CATCH lRet:=.F. END RETURN(lRet) ****************************************** PROCEDURE SHOWGAUGE( nSent, nSize, nTotal) ****************************************** IF nSent > 0 @ 10,10 SAY STR(nSent/1000000)+" Mb de: " + str(nTotal/1000000)+ " Mb "+str((nSent/nTotal)*100,4) +" %" ENDIF RETURN ************************************ FUNCTION GET_FILE_SIZE(cCAMINHO_URL) ************************************ LOCAL nRET_BYTS:=0 LOCAL oHttp, cHtml:='' IF Empty( cCAMINHO_URL ) Return(nRET_BYTS) ENDIF TRY oHttp:= TIpClientHttp():new( "http://www.meusite.com.br/tamanhoArquivo.php?caminho="+alltrim(cCAMINHO_URL)) CATCH Return(nRET_BYTS) END IF oHttp:open() cHtml := oHttp:readAll() IF !EMPTY(cHtml) IF LEN(cHTML) > 0 .AND. LEN(cHTML) < 20 nRET_BYTS:=VAL(alltrim(cHTML)) ENDIF ENDIF ENDIF oHttp:close() RETURN(nRET_BYTS) a função tamanhoarquivo.php para pegar o tamanho do arquivo: <?php function obterTamanho($url){ if(file_exists($url)){ //SE O ARQUIVO EXISTE $tamanho = filesize($url); return $tamanho; } else{ return 'Arquivo não encontrado'; } } ?> <?php if(isset($_GET['caminho'])){ $caminho = $_GET['caminho']; echo obterTamanho($caminho); } ?> Os créditos deste exemplo vão para Leonardo Machado (Sygecom), do site Clipper on Line. Ele quem postou este exemplo lá. att. William Adami

Olá Kapi faça assim: oFTP:Cwd("www/pasta/sistema") // muda o diretorio no FTP obs.: aqui tem as funções de FTP da lib: METHOD New( oUrl, lTrace, oCredentials ) METHOD Open() METHOD Read( nLen ) METHOD Write( nLen ) METHOD Close() METHOD TransferStart() METHOD Commit() METHOD GetReply() METHOD Pasv() METHOD TypeI() METHOD TypeA() METHOD NoOp() METHOD Rest( nPos ) METHOD List( cSpec ) METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) METHOD Pwd() METHOD Cwd( cPath ) METHOD Dele( cPath ) METHOD Port() METHOD SendPort() METHOD Retr( cFile ) METHOD Stor( cFile ) METHOD Quit() METHOD ScanLength() METHOD ReadAuxPort() METHOD mget() // Method bellow contributed by Rafa Carmona METHOD LS( cSpec ) METHOD Rename( cFrom, cTo ) // new method for file upload METHOD UpLoadFile( cLocalFile, cRemoteFile ) // new method to download file METHOD DownLoadFile( cLocalFile, cRemoteFile ) // new method to create an directory on ftp server METHOD MKD( cPath ) METHOD RMD( cPath ) METHOD listFiles( cList ) METHOD MPut METHOD StartCleanLogFile() METHOD fileSize( cFileSpec ) Abraço William Adami

Ok brother , estamos aqui pra ajudar e ser ajudado ! Abraço William Adami

Olá Oscar, eu utilizo as funcoes de ftp nativas do xharbour. No link abaixo tem um exemplo completo em fivewin que eu fiz, funcoes para download e upload com barra de progresso. Apenas adicione a LIB TIP.LIB na compilação. Abraço William Adami LINK: http://www.4shared.com/rar/j7hmst-Jba/meuftp.html

Beleza Theotokos, isso resolveu meu problema. Fiz Assim: oRich:SetFontName("Tahoma") oRich:SetFontSize(18) oRich:GotoLine(oRich:GetLineCount()) oRich:InsertRTF(dtoc(date())) Obrigado a Todos William

Pessoal, obrigado pela atenção. Isso que eu quero é para ser utilizado em um prontuário médico. O médico tecla no botao e automaticamente é colocado a DATA na ultima linha do richedit. Em seguida o medico continua digitando o texto embaixo da data. Nao tem nada para ser substituido texto no final. Parece que pela primeira vez na vida , não vou conseguir fazer qualquer coisa com fivewin... :{ Abraço William

Amigos essa parece ser fácil mas não é: Tenho um richedit e 1 botao. Sempre que pulsar o botao, tem que inserir (adicionar) no final do texto richedit a data atual ( date() ) , só que com fonte Tahoma e size = 10. Lembrando que no richedit vai ter outros textos com fontes e tamanhos diferentes digitados pelo usuario , e sempre que clicar no botao, insere a data atual na ultima linha com fonte tahoma e size 10 , mas mantendo as caracteristicas do restante . Perguntei no forum inter , mas nem o Linares resolveu (ou nao teve tempo) Grato William Adami

Boa tarde, alguem já desenvolveu arquivo de Registro /Cancelamento de arquivo para o spc nacional ? Estou seguindo o layout mas é muito mal explicado. Alguem teria um exemplo de arquivo gerado com Inclusao e exclusao para eu comparar com o meu ? Grato William

bom dia , segue minha função para listar os dispositivos da rede. Era uma função antiga que eu tinha e funcionava com Windows XP. Mas pelo que nosso amigo João (Kapiaba) testou, não funcionava com windows 7 ou 8 ... Dei uma reformulada geral na função e agora funciona com win 7 . Por favor alguem teste em win 8 para ver se está funcionado , pois não tenho win 8 aqui.... Creio que com XP não vai funcionar mas dá pra arrumar. A diferença está no tamanho das strings retornadas pelo comando NET VIEW . No XP é um valor e no win7 é diferente. Quem precisar usar com XP me avise que eu explico como fazer. Obs. : Testei usando xharbour , não sei se funciona com Harbour. att. William Adami *************************** #Include "FiveWin.ch" * teste da fun‡Æo para mostrar * os dispositivos da rede function main local gg gg:=listarede() if gg[1] msgalert(oemtoansi("Esta‡Æo: ")+gg[2]+CRLF+"Nome: "+gg[3]+CRLF+"Tipo: "+gg[4] ) else msgalert(oemtoansi("Nenhum dispositivo selecionado !")) endif return nil ************************************************** * Nome...: ListaRede() * Fun‡ao.: Listar os dispositivos do grupo * de trabalho da rede * Retorno: array[4] .T. ou .F. (selecionou ou nÆo) * Nome da esta‡Æo * Nome do dispositivo * Tipo (disco ou impressora) * Adaptado por William Adami em 13/11/2014 ************************************************** Function ListaRede Local ncodigo,cestacao,nquantas,ocoment,odlg2 local vol:={.f.,"","",""},obrw,area:=select(),vldbf,cComando,ob[2] nquantas :=0 * cria arquivo dbf temporario na memoria vldbf:= {} AAdd(vldbf, {"quantas", "n", 4, 0 }) AAdd(vldbf, {"nome_imp", "c", 14, 0}) AAdd(vldbf, {"estacao", "c", 23, 0}) AAdd(vldbf, {"comentario", "c", 30, 0}) select 77 Hb_DbCreateTemp("CARIMP", vldbf) cComando = "net view > estacao.txt" myrun(cComando) * cria arquivo dbf temporario na memoria vldbf:= {} AAdd(vldbf, {"texto", "c", 100, 0}) select 78 Hb_DbCreateTemp("CARTES", vldbf) APPEND FROM estacao.txt SDF dbselectarea("CARTES") dbgotop() Do while !eof() if substr(CARTES->texto,1,2)#'\\' dbskip(1) loop endif dbselectarea('CARIMP') cestacao :=substr(CARTES->texto,1,23) ferase("ESTACAO.TXT") cComando = "net view "+cestacao+" > estacao1.txt" myrun(cComando) * cria arquivo dbf temporario na memoria vldbf:= {} AAdd(vldbf, {"texto", "c", 100, 0}) select 79 Hb_DbCreateTemp("CARTIM", vldbf) APPEND FROM estacao1.txt SDF dbselectarea("CARTIM") dbgotop() Do while !eof() if substr(CARTIM->texto,27,4)#'Disc'.AND.substr(CARTIM->texto,27,4)#'Impr' dbskip(1) loop else if substr(CARTIM->texto,27,4)<>'Disc' ocoment:="Impressora" else ocoment:="Disco" endif endif dbselectarea('CARIMP') append blank nquantas++ replace CARIMP->quantas with nquantas replace CARIMP->estacao with substr(CARTES->texto,1,23) replace CARIMP->nome_imp with ''+substr(CARTIM->texto,1,13) replace CARIMP->comentario with ocoment dbselectarea('CARTIM') dbskip(1) Enddo dbselectarea('CARTIM') CARTIM->(DBCLOSEAREA()) dbdrop("MEM:CARTIM") dbselectarea('CARTES') dbskip(1) Enddo dbselectarea('CARTES') CARTES->(DBCLOSEAREA()) dbdrop("MEM:CARTES") if file('ESTACAO.TXT') ferase('ESTACAO.TXT') endif if file ('ESTACAO1.TXT') ferase('ESTACAO1.TXT') endif dbselectarea('CARIMP') go top DEFINE DIALOG oDlg2 FROM 5, 2 TO 30, 55 TITLE "LISTA DE DISPOSITIVOS DA REDE" odlg2:lhelpicon:=.f. @ 1 , 0.8 LISTBOX obrw VAR cItem ; FIELDS carimp->NOME_IMP, ; carimp->ESTACAO, ; carimp->COMENTARIO ; HEADERS OemToAnsi( "NOME" ), ; OemToAnsi( "ESTACAO" ), ; OemToAnsi( "Tipo" ) ; OF odlg2 SIZE 200, 140 ; COLOR CLR_WHITE, CLR_GREEN ; ON DBLCLICK (vol:={ .t.,rtrim(carimp->estacao), rtrim(carimp->nome_imp),rtrim(carimp->comentario) },odlg2:end()) obrw:bKeyChar := {|nK| if( nK==VK_RETURN,(vol:={ .t., rtrim(carimp->estacao), rtrim(carimp->nome_imp),rtrim(carimp->comentario) },odlg2:end()) ,NIL)} @ 9, 8 BUTTON ob[1] PROMPT "&Ok" OF oDlg2 SIZE 40, 12 ACTION (vol:={ .t.,rtrim(carimp->estacao), rtrim(carimp->nome_imp),rtrim(carimp->comentario) },odlg2:end()) @ 9, 18 BUTTON ob[2] PROMPT "&Sair" OF oDlg2 SIZE 40, 12 ; ACTION (oDlg2:End() ) activate dialog odlg2 centered CARIMP->(DBCLOSEAREA()) dbdrop("MEM:CARIMP") select(area) Return vol FUNCTION myRUN( cComando, nStyle, lWait, lShowResult ) local oShell, RET IF valtype( nStyle ) != "N" nStyle := 0 ENDIF IF ValType( lWait ) != "L" lWait := .T. ENDIF IF ValType( lShowResult ) != "L" lShowResult := .F. ENDIF oShell := CreateObject( "WScript.Shell" ) IF !GetEnv( "OS" ) == "Windows_NT" cComando += "start " + cComando ENDIF TRY RET := oShell:Run( "%comspec% /c " + cComando, nStyle, lWait ) CATCH msgstop("ERRO NO ENVIO DO COMANDO !","ERRO") END IF lShowResult .AND. RET > 0 .and. RET <= 32 msginfo( "Erro Win_Run(): " + ltrim( Str( RET ) ), " OK " ) ENDIF oShell := NIL Return IF( RET = 0, .T., .F. )

o:=ownd:obar:acontrols[1]:hbitmap if o<>0 hbmp:=ownd:obar:acontrols[1]:hbitmap nbmpwidth := nbmpwidth(hbmp) nbmpheight:= nbmpheight(hbmp) larg:=nbmpwidth*nfactorwitdh alt:=nbmpheight*nfactorheight o:=resizebmp(o,larg ,alt ) ownd:obar:acontrols[1]:hbitmap:=o endif olá Eduardo, existe a função interna do fivewin RESIZEBMP() Acima um exemplo de como eu uso para redimensionar o bitmap de uma buttonbar. creio que é só adaptar para o xbrowse. Att. William Adami