TipClienHTTP()

HMG en Español

Moderator: Rathinagiri

Post Reply
User avatar
edufloriv
Posts: 238
Joined: Thu Nov 08, 2012 3:42 am
DBs Used: DBF, MariaDB, MySQL, MSSQL, MariaDB
Location: PERU

TipClienHTTP()

Post by edufloriv »

Saludos amigos,

Tengo este pequeño .prg para realizar una consulta a una api:

Code: Select all

* ------------------------------------------------------ *
* SISTEMA     :                                          *
* PRG         :                                          *
* CREADO      :                                          *
* ACTUALIZADO :                                          *
* AUTOR       :                                          *
* COMENTARIOS :                                          *
* ------------------------------------------------------ *

#include <hmg.ch>

REQUEST HB_LANG_ESWIN
REQUEST HB_CODEPAGE_ESWIN
REQUEST HB_LANG_ES
REQUEST HB_CODEPAGE_ES850

FUNCTION MAIN

   HB_LANGSELECT( "ES" )
   HB_SetCodePage("ESWIN")

   DEFINE WINDOW Win_1;
      AT 0,0 ;
      WIDTH 640 HEIGHT 460 ;
      TITLE 'Consulta RUC' ;
      ON INIT INISETS() ;
      MAIN

      DEFINE MAIN MENU
         POPUP "&Operaciones"
            ITEM '&1. Buscar RUC'                  ACTION TestRuc()
         END POPUP
      END MENU

   END WINDOW

   CENTER WINDOW Win_1
   ACTIVATE WINDOW Win_1

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
* FUNCION...: INISETS
* COMENTARIO: INICIALIZA LOS SETEOS DEL SISTEMA.
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC INISETS

SET BELL       Off
SET CONSOLE    Off
SET CURSOR     Off
SET DATE TO BRIT
SET DELETED    On
SET DELIMITERS Off
SET ECHO       Off
SET EPOCH TO 1990
SET MESSAGE TO 22 CENTER
SET SAFETY     Off
SET SCOREBOARD Off
SET TALK       Off
SET WRAP       On
SETMODE(25,80)
ALTD(0)

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

Proc TestRuc

LOCAL lOk := .T.
LOCAL oHttp, cHtml
LOCAL cToken := "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJlbWFpbCI6ImVkdWZsb3JpdkBnbWFpbC5jb20ifQ.tKHlgSo271x3D53nHP6Bj0otErLGg5T-9-75krfLkAw"
LOCAL cRUC   := "10074902419"
LOCAL cURL   := "https://dniruc.apisperu.com/api/v1/ruc/" + cRUC + "?token=" + cToken
   msginfo( cURL )
   oHttp := TIPClientHttp():New( cURL )
   IF oHttp:open()
      cHtml := oHttp:readAll()
      memowrit( "RUC.txt", cHtml )
      oHttp:close()
   ENDIF

RETURN
Pero me devuelve este error:
httperror.png
httperror.png (8.9 KiB) Viewed 1820 times
Recuerdo haber realizado un programilla similar hace tiempo y no tuve ningún problema. ¿ He olvidado algo ?.

Gracias anticipadas y saludos a todos.

Eduardo Flores Rivas


LIMA - PERU
User avatar
Claudio Ricardo
Posts: 367
Joined: Tue Oct 27, 2020 3:38 am
DBs Used: DBF, MySQL, MariaDB
Location: Bs. As. - Argentina

Re: TipClienHTTP()

Post by Claudio Ricardo »

Corrige al sabio y lo harás más sabio, Corrige al necio y lo harás tu enemigo.
WhatsApp / Telegram: +54 911-63016162
User avatar
edufloriv
Posts: 238
Joined: Thu Nov 08, 2012 3:42 am
DBs Used: DBF, MariaDB, MySQL, MSSQL, MariaDB
Location: PERU

Re: TipClienHTTP()

Post by edufloriv »

Hola Claudio,

Mil gracias, me lanzaste el cable que me hacia falta. Al final, la respuesta era una que ya hace un tiempo muy amablemente EDK me alcanzó, solo hacia falta realizar algunas modificaciones.

Envió la solución por si a alguien le hace falta:

Code: Select all

* ------------------------------------------------------ *
* SISTEMA     :                                          *
* PRG         :                                          *
* CREADO      :                                          *
* ACTUALIZADO :                                          *
* AUTOR       :                                          *
* COMENTARIOS :                                          *
* ------------------------------------------------------ *

MEMVAR _HMG_SYSDATA
#include "hmg.ch"
#include "hblang.ch"

REQUEST HB_LANG_ESWIN
REQUEST HB_CODEPAGE_ESWIN
REQUEST HB_LANG_ES
REQUEST HB_CODEPAGE_ES850
REQUEST DBFCDX

FUNCTION MAIN

   HB_LANGSELECT( "ES" )
   HB_SetCodePage("ESWIN")

   DEFINE WINDOW Win_1;
      AT 0,0 ;
      WIDTH 640 HEIGHT 460 ;
      TITLE 'Consulta RUC' ;
      ON INIT INISETS() ;
      MAIN

      DEFINE MAIN MENU
         POPUP "&Operaciones"
            ITEM '&1. Buscar RUC'                  ACTION TestRuc()
         END POPUP
      END MENU

   END WINDOW

   CENTER WINDOW Win_1
   ACTIVATE WINDOW Win_1

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
* FUNCION...: INISETS
* COMENTARIO: INICIALIZA LOS SETEOS DEL SISTEMA.
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC INISETS

SET BELL       Off
SET CONSOLE    Off
SET CURSOR     Off
SET DATE TO BRIT
SET DELETED    On
SET DELIMITERS Off
SET ECHO       Off
SET EPOCH TO 1990
SET MESSAGE TO 22 CENTER
SET SAFETY     Off
SET SCOREBOARD Off
SET TALK       Off
SET WRAP       On
SETMODE(25,80)
ALTD(0)

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

Proc TestRuc

LOCAL lOk := .T.
LOCAL oHttp, cHtml
LOCAL cToken := "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJlbWFpbCI6ImVkdWZsb3JpdkBnbWFpbC5jb20ifQ.tKHlgSo271x3D53nHP6Bj0otErLGg5T-9-75krfLkAw"
LOCAL cRUC   := "10074902419"
LOCAL cURL   := "https://dniruc.apisperu.com/api/v1/ruc/" + cRUC + "?token=" + cToken

   oRestApi := OpenRestApi()
   IF ! EMPTY(oRestApi)
      cHtml := SendRestApi( oRestApi , cURL )
      memowrit( "RUC.txt", cHtml )
   ENDIF

RETURN


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
* FUNCION   : OpenRestApi
* COMENTARIO:
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

FUNC OpenRestApi

LOCAL oRestApi := ""
LOCAL nTimeOut := 20  //seconds

//Init
BEGIN SEQUENCE WITH {|o| break(o)}
	oRestApi := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" )
//                          nResolve         nConnect        nSend               nRecieve
	oRestApi:setTimeouts( nTimeout * 1000 , nTimeout * 1000 , nTimeout * 1000 , nTimeout * 1000 )
RECOVER
     MsgStop( "Microsoft XML Core Services (MSXML) 6.0 is not installed."+CRLF+;
          "Download and install MSXML 6.0 from http://msdn.microsoft.com/xml"+CRLF+;
          "before continuing.")
END SEQUENCE

RETURN( oRestApi )


*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
* FUNCION   : SendRestApi
* COMENTARIO:
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

FUNC SendRestApi( oRestApi, cUrl , cBody , cToken , cMethod )

LOCAL cReturn

DEFAULT cMethod := "GET" //<- aqui en algunos casos es "POST"

DO EVENTS

BEGIN SEQUENCE WITH {|o| break(o)}

	set( _SET_CODEPAGE, 'UTF8' )
	oRestApi:Open( cMethod , cUrl , .F. )
	oRestApi:setRequestHeader("Content-Type" , "application/x-www-form-urlencoded") //"application/json;charset=utf-8"
//	oRestApi:setRequestHeader("Authorization" , "Token token=" + cToken)
	oRestApi:Send() // cBody 
	set( _SET_CODEPAGE, "ESWIN" )

	IF oRestApi:Status <> 200
		BREAK "HTTP status: " + hb_NToS(oRestApi:status) + " "  + oRestApi:statusText 
   ELSE
      lEnviado := .T.
	ENDIF

	cReturn := oRestApi:ResponseBody()
	//or cReturn := oRestApi:ResponseText()

RECOVER USING oErr

	cReturn := "!ERROR!" + CRLF + HB_TRANSLATE( IF (ValType(oErr) = 'O', oErr:Description, oErr ), 'ESWIN')
 
END SEQUENCE
 	
RETURN cReturn
A todos los interesados recordar que TipClientHTTP() NO FUNCIONA CON URLs https:\\

Cordiales saludos a todos.

Eduardo Flores Rivas


LIMA - PERU
User avatar
danielmaximiliano
Posts: 2612
Joined: Fri Apr 09, 2010 4:53 pm
Location: Argentina
Contact:

Re: TipClienHTTP()

Post by danielmaximiliano »

edufloriv wrote: Tue Oct 19, 2021 10:29 pm

A todos los interesados recordar que TipClientHTTP() NO FUNCIONA CON URLs https:\\

Cordiales saludos a todos.
Hola Edu :
la Libreria HBtip funciona con direcciones HTTPs:// solo es necesario agregar la libreria HBssl

Code: Select all

METHOD New( oUrl, xTrace, oCredentials ) CLASS TIPClientHTTP

   ::super:new( oUrl, iif( hb_defaultValue( xTrace, .F. ), "http", xTrace ), oCredentials )

   ::nDefaultPort := iif( ::oUrl:cProto == "https", 443, 80 )
   ::nConnTimeout := 5000
   ::bChunked     := .F.

   hb_HCaseMatch( ::hHeaders, .F. )

   RETURN Self
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*

Saludos / Regards
DaNiElMaXiMiLiAnO

Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
User avatar
Claudio Ricardo
Posts: 367
Joined: Tue Oct 27, 2020 3:38 am
DBs Used: DBF, MySQL, MariaDB
Location: Bs. As. - Argentina

Re: TipClienHTTP()

Post by Claudio Ricardo »

Si usas https, para que el tunel funcione, hay que agregar en el include la libreria SSL, que no era necesaria para http.
(en ambos links que te pasé lo aclaran)
Puedes dejar tu funcion tal como estaba y con solo incluir la libreria te aceptará también url's https.
Corrige al sabio y lo harás más sabio, Corrige al necio y lo harás tu enemigo.
WhatsApp / Telegram: +54 911-63016162
Post Reply