Delphi 7 - RESTFul API
 

¡Hola estimados!

Actualmente utilizo Delphi 7 + BDE + Firebird 2.0 + QuickReport y se me ha presentado la necesidad de consumir un RESTFul API en formato JSON para evaluar un proveedor.

No soy experto en este tipo de desarrollo.

Tengo las siguientes inquietudes para saber cuál sería la decisión más adecuada.

¿Delphi 7 soporta RESTFul API y formato JSON? de ser así, ¿Qué proceso debo agotar para poder adecuarlo?

o

¿Es más factible comprar la licencia de Delphi 13 edición Profesional, asumiendo que tiene lo necesario para consumir RESTFul API y manejar formato JSON?

Saludos.-

En principio puedes usar Indy y alguna biblioteca para uso de json.
También depende exactamente de qué "REST" vas a usar.
Aunque desde luego que con las últimas versiones de Delphi lo vas a tener más fácil porque ya trae componentes para ello.

Para la parte de la API yo utilizo siempre una variante de este DataModule.
Solo modifico las variables privadas i el WS_Inicializa para rellenarlas.
Además de esto, si el contenido es XML a veces tengo que tocar código en la función ClearData().

Tienes que tener las Indi10 instaladas.
Además de esto, para que funcione IdSSLOpenSSL debes tener junto al ejecutable la versión de las dll de openssl.
openssl.exe
ssleay32.dll
libeay32.dll

Estoy utilizando esto con Delphi 6 para conectar a
Prestashop (contenido XML)
Woocommerce (contenido JSON)
DHL (contenido JSON)
SEUR (contenido JSON)
SMSPubli (contenido JSON)
Varias APIs a medida (contenido xml, JSON, imágenes)

Básicamente la utilizo así:

Código Delphi [-]
begin
  if not DMNombreAPI.WS_Inicializa(xConfiguracionURL.AsString, xConfiguracionACCESS_TOKEN.AsString, False) then
     ShowMessage(_('Error al inicializar servicio NombreServicio'));
  [...]


begin
  Resultado := DMNombreAPI.WS_Add('companies', json, Respuesta);
  if (Resultado = 201) then
     // Creado Correctamente
     // Tratar Respuesta
  else
     // Tratar Error

Código Delphi [-]
unit UDMNombreAPI;

interface

uses
  SysUtils, Classes;

type
  TDMHubSpot = class(TDataModule)
     procedure DataModuleCreate(Sender: TObject);
  private
     { Private declarations }
     WSSecureProtocol: boolean;
     WSDebug: boolean;
     WSURL: string;
     WSToken: string;
     procedure ClearCData(aJSON: TStrings);
     function WS_DoPost(Metodo, Resource: string; id: string; Opciones: string; Contenido, Respuesta: TStrings; aContentType: string = ''): integer;
  public
     { Public declarations }
     function WS_Inicializa(aURL, aToken: string; aDebug: boolean): boolean;
     function WS_Add(Resource: string; Contenido, Respuesta: TStrings; ContentType: string = ''): integer;
     function WS_Delete(Resource, id: string; Respuesta: TStrings; ContentType: string = ''): integer;
     function WS_Edit(Resource, id: string; Contenido, Respuesta: TStrings; ContentType: string = ''): integer;
     function WS_Get(Resource, id, Opciones: string; Respuesta: TStrings; ContentType: string = ''): integer;
  end;

var
  DMNombreAPI : TDMNombreAPI;

implementation

uses UDMMain, IdHttp, IdSSLOpenSSL;

{$R *.dfm}

procedure TDMNombreAPI.DataModuleCreate(Sender: TObject);
begin
  WSSecureProtocol := True;
  WSDebug := False;
  WSURL := '';
  WSToken := '';     
end;

procedure TDMNombreAPI.ClearCData(aXML: TStrings);
begin
  // Limpia el XML
end;

function TDMNombreAPI.WS_Add(Resource: string; Contenido, Respuesta: TStrings; ContentType: string): integer;
begin
  /// Crea recurso xml y lo devuelve en Respuesta.
  /// El resultado es el codigo de respuesta HTTP

  Result := WS_DoPost('POST', Resource, '', '', Contenido, Respuesta);
  if (Result = 200) then
     ClearCData(Respuesta);
end;

function TDMNombreAPI.WS_Delete(Resource, id: string; Respuesta: TStrings; ContentType: string): integer;
begin
  /// Borra recurso con id y lo devuelve en Respuesta.
  /// El resultado es el codigo de respuesta HTTP

  Result := WS_DoPost('DELETE', Resource, id, '', nil, Respuesta);
  if (Result = 200) then
     ClearCData(Respuesta);
end;

function TDMNombreAPI.WS_DoPost(Metodo, Resource, id, Opciones: string; Contenido, Respuesta: TStrings; aContentType: string): integer;
var
  aURL : string;

  Http : TIdHTTP;
  SSL : TIdSSLIOHandlerSocketOpenSSL;
  Resp : string;

  AContent, AResponse : TStream;

  function StringsToUTF8Stream(Strings: TStrings): TStringStream;
  var
     utf8Str : UTF8String;
  begin
     utf8Str := UTF8Encode(Strings.Text);
     Result := TStringStream.Create(utf8Str);
  end;

begin
  /// Ejemplo de conexion:
  /// curl --request POST \
  /// --url https://example.com/api/service \
  /// --header 'User-Agent: insomnia/11.3.0' \
  /// --header 'api-key: 1cf766c1-ff92-40b8-8a85-************'

  // Construyo la URL
  if WSSecureProtocol then
     aURL := 'https://'
  else
     aURL := 'http://';

  aURL := aURL + WSURL + '/' + Resource;
  if (id <> '') then
     aURL := aURL + '/' + id;

  if (Opciones > '') then
     aURL := aURL + Opciones;

  // Transmision
  Http := TIdHTTP.Create(nil);
  SSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);

  AResponse := TStringStream.Create('');
  try
     DMMain.LogIni('WebService');
     DMMain.Log('URL: ' + aURL);
     if Assigned(Contenido) then
        DMMain.Log('Content: ' + #13#10 + Contenido.Text);

     if Assigned(Contenido) then
     begin
        // Contenido.SaveToStream(AContent);
        if (aContentType = 'application/application/json') then
        begin
           AContent := TStringStream.Create(Contenido.Text);
           // Contenido.SaveToStream(AContent);
        end
        else
           AContent := StringsToUTF8Stream(Contenido);

        AContent.Position := 0;
     end
     else
     begin
        AContent := TStringStream.Create('');
     end;

     SSL.SSLOptions.Method := sslvTLSv1_2;   // Forzar TLS 1.2
     SSL.SSLOptions.SSLVersions := [sslvTLSv1_2];

     Http.IOHandler := SSL;
     if (aContentType = '') then
        Http.Request.ContentType := 'application/json; charset=UTF-8'
     else
        Http.Request.ContentType := aContentType; // 'application/x-www-form-urlencoded';

     // ShowMessage('Metodo:'+Metodo+#13#10+'Resource:'+Resource+#13#10+'Contenido:'+Contenido.text+#13#10+'  ContentType:'+Http.Request.ContentType);

     Http.Request.CustomHeaders.Clear;
     // Variable api-key
     Http.Request.CustomHeaders.Add('api-key: ' + WSToken);
     {
     // Agregar variables de Header
     // Headers.Add('Username='+Token);
     // Headers.Add('Authorization='+Token);
     // Headers.Add('ws_key='+Token);
     // Http.Request.CustomHeaders.Add('x-version: 3.1.0');
     }

     {
     // Autenticacion mediante Token "Authorization: Bearer"
     Http.Request.CustomHeaders.Add('Authorization: Bearer ' + WSToken);
     }

     {
     // Autenticacion ásica mediante usuario y clave
     Http.Request.BasicAuthentication := True;
     Http.Request.UserName := WSUsername;
     Http.Request.Password := WSPassword;
     }

     DMMain.Log('Http. CustomHeaders: ' + #13#10 + Http.Request.CustomHeaders.Text);
     DMMain.Log('aContentType: ' + aContentType);
     DMMain.Log('ContentType: ' + Http.Request.ContentType);

     try
        if (Metodo = 'POST') then
           Resp := Http.Post(aURL, AContent);
        if (Metodo = 'GET') then
           Resp := Http.Get(aURL);
        if (Metodo = 'PUT') then
           Resp := Http.Put(aURL, AContent);
        if (Metodo = 'DELETE') then
           Resp := Http.Delete(aURL);

        Respuesta.Text := (Resp);
        Result := Http.ResponseCode;
     except
        on E: EIdHTTPProtocolException do
        begin
           // Aquí capturas los errores HTTP (400, 401, 500, etc.)
           Respuesta.Text := E.ErrorMessage;   // el body de la respuesta del servidor
           Result := E.ErrorCode;              // el código HTTP (400, 401...)
        end;
        on E: Exception do
        begin
           // Otros errores (timeout, conexión, etc.)
           Respuesta.Text := E.Message;
           Result := -1;
        end;
     end;

     DMMain.Log('ResponseCode: ' + IntToStr(Result));
     DMMain.Log('Response: ' + Respuesta.Text);
  finally
     DMMain.LogFin('');
     Http.Free;
     SSL.Free;
     AContent.Free;
     AResponse.Free;
  end;
end;

function TDMNombreAPI.WS_Edit(Resource, id: string; Contenido, Respuesta: TStrings; ContentType: string): integer;
begin
  /// Modifica recurso de xml y lo devuelve en Respuesta.
  /// El resultado es el codigo de respuesta HTTP

  Result := WS_DoPost('PUT', Resource, id, '', Contenido, Respuesta);
  if (Result = 200) then
     ClearCData(Respuesta);
end;

function TDMNombreAPI.WS_Get(Resource, id, Opciones: string; Respuesta: TStrings; ContentType: string): integer;
begin
  /// Obtiene recurso y lo devuelve en Respuesta.
  /// El resultado es el codigo de respuesta HTTP
  /// Opciones : filter, display, sort, limit

  Result := WS_DoPost('GET', Resource, id, Opciones, nil, Respuesta);
  if (Result = 200) then
     ClearCData(Respuesta);
end;

function TDMNombreAPI.WS_Inicializa(aURL, aToken: string; aDebug: boolean): boolean;
begin
  /// aURL debe ser la base de la URL para crear la dirección del servicio.
  /// NO DEBE TERMINAR EN "/".

  Result := True;

  WSURL := aURL;
  WSToken := aToken;
  WSDebug := aDebug;

  WSSecureProtocol := True;
  if Copy(LowerCase(WSURL), 1, 8) = 'https://' then
  begin
     WSURL := Copy(WSURL, 9, Length(WSURL));
  end
  else
  if Copy(LowerCase(WSURL), 1, 7) = 'http://' then
  begin
     WSSecureProtocol := False;
     WSURL := Copy(WSURL, 8, Length(WSURL));
  end;
end;

end.

Para tratar JSON una buena opción es la librería uLkJSON.

Ejemplo:

Código Delphi [-]
procedure TDMDHL.NuevoPaquete(typeCode: string; weight, Length, Width, Height: double; customerReference_value, customerReference_typeCode, description, labelDescription: string);
var
  content, package, dimensions, customerReference : TlkJSONobject;
  packages, customerReferences : TlkJSONlist;
begin
  // Verificar si ya existe el nodo parcels
  if Envio.Field['content'] <> nil then
     content := TlkJSONobject(Envio.Field['content'])
  else
  begin
     content := TlkJSONobject.Create;
     Envio.Add('content', content);
  end;

  // Verificar si ya existe el nodo parcels
  if content.Field['packages'] <> nil then
     packages := TlkJSONlist(content.Field['packages'])
  else
  begin
     packages := TlkJSONlist.Create;
     content.Add('packages', packages);
  end;

  package := TlkJSONobject.Create;
  packages.Add(package);
  // ["1CE","2BC","2BP","2BX","3BX","4BX","5BX","6BX","7BX","8BX","CE1","TBL","TBS","WB1","WB2","WB3","WB6  ","XPD"]
  if Trim(typeCode) > '' then
     package.Add('typeCode', typeCode);
  package.Add('weight', weight);

  dimensions := TlkJSONobject.Create;
  package.Add('dimensions', dimensions);
  dimensions.Add('length', Length);
  dimensions.Add('width', Width);
  dimensions.Add('height', Height);
  [...]

Estupendos consejos y código :)
^\||/^\||/^\||/

Solo me quedaba mencionar que DMMain.Log(), DMMain.LogIni() y DMMain.LogFin() son procedimiento que guardan strings en un archivo.
Solo lo hacen si está establecida la directiva de compilación Debug

Código Delphi [-]
  TDMMain = class(TDataModule)
  [...]
  private
     { Private declarations }
     ContadorLog: integer;
     InicioLog: array[1..20] of TDateTime;
     [...]

procedure TDMMain.Log(s: string);
{$IFDEF Debug}
var
  F : TextFile;
  FileName : string;
{$ENDIF}
begin
  {$IFDEF Debug}
  FileName := ChangeFileExt(Application.ExeName, '.log');
  AssignFile(F, FileName);
  try
     Append(F);
  except
     try
        Rewrite(F);
     except
        on e: Exception do
           ShowMessage('Error al abrir fichero : ' + FileName + #13#10 + e.Message);
     end;
  end;
  WriteLn(F, FormatDatetime('[yyyy-mm-dd hh:nn:ss.zzz] ', Now) + s);
  CloseFile(F);
  {$ENDIF}
end;

procedure TDMMain.LogIni(s: string);
var
  espacio : string;
  i : integer;
begin
  Inc(ContadorLog);
  espacio := '';
  for i := 2 to ContadorLog do
     espacio := espacio + '   ';
  if (ContadorLog < 20) then
     InicioLog[ContadorLog] := Now;
  Log('I - ' + espacio + s);
end;

procedure TDMMain.LogFin(s: string);
var
  espacio : string;
  i : integer;
begin
  espacio := '';
  for i := 2 to ContadorLog do
     espacio := espacio + '   ';
  if (ContadorLog < 20) then
     Log('F - ' + espacio + FormatDatetime('[nn:ss.zzz]', Now - InicioLog[ContadorLog]) + ' - ' + s)
  else
     Log('F - ' + espacio + FormatDatetime('[nn:ss.zzz]', Now - Now) + ' - ' + s);
  if (ContadorLog > 0) then
     Dec(ContadorLog);
end;

Ya tengo tarea! :)

Validaré cuál de las opciones sería la más conveniente y luego les cuento según nuestro caso.

¡Muchas gracias Casimiro y duilioisola por sus valiosas y pronta respuestas!

Yo también he usado en varias ocasiones la libería ulkJSON. Funciona muy bien con Delphi 7.
Hay varias entradas en el blog donde puedes ver cómo se usa.

En concreto esta:
https://neftali.clubdelphi.com/habla...weathermap-12/

Puedes ver cómo conectarte a un WebService utilizando Indy y cómo "parsear" los resultados utilizando la librería ulkJSON.
El código está disponible y puedes echarle un vistazo.

Gracias Neftali!

Estuve explorando el código del proyecto que indicas en Delphi 7.

Voy a probar con Indy 9 y la libería ulkJSON. Empezaré realizando peticiones HTTP GET y creando contenido en formato JSON.

Les dejaré saber cómo me fue.

Saludos.-

Hice la petición HTTP GET y lanzó la excepción:

Investigando encontré que está relacionado a que debo de actualizar a Indy 10 y los demás componentes que bien indicó duilioisola.

Tienes que usar Indy 10.

Hola!

Ya pude instalar Indy 10 y todo marcha bien.

Comparto implementación HTTPS GET.

Código Delphi [-]
unit Unit1;

interface
uses IdHTTP, uLkJSON, SysUtils, Dialogs, IdCTypes,
  IdSSLOpenSSLHeaders, IdBaseComponent, IdComponent, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL;

function ObtenerDatosJSON(const URL: string): TlkJSONobject;

implementation

function ObtenerDatosJSON(const URL: string): TlkJSONobject;
var
  Http: TIdHTTP;
  LHandler: TIdSSLIOHandlerSocketOpenSSL;
  Respuesta: string;
begin
  Result := nil;
  Http := TIdHTTP.Create(nil);
  try
    LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
    try
      Http.IOHandler := LHandler;
      LHandler.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
      
      // Realizar el HTTP GET
      Respuesta := Http.Get(URL);
      
      // Parsear la respuesta a objeto JSON
      Result := TlkJSON.ParseText(Respuesta) as TlkJSONobject;
    except
      on E: Exception do
        ShowMessage('Error: ' + E.Message);
    end;
  finally
    Http.Free;
    LHandler.Free;
  end;
end;

end.

Aqui su consumo. En Form1 debe ser agregada la libreria uLkJSON y Unit1

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
var
  JsonObj: TlkJSONobject;
  ValorNombre: string;
begin
  JsonObj := ObtenerDatosJSON(FPrincipal.URLPolaris +
  'autenticacion/token?authtoken=' + FPrincipal.AccesTokenPolaris);
  if Assigned(JsonObj) then
  begin
    try
      // Acceder a un campo (ejemplo: {"data": "xyz"})
      ValorNombre := JsonObj.getString('data');
      ShowMessage(ValorNombre);
    finally
      JsonObj.Free; // ¡Importante liberar memoria!
    end;
  end;

end;

El próximo ejercicio que haré será realizar una petición HTTPS POST.

Saludos.-

^\||/^\||/^\||/

¡Hola!

Todo funciona correctamente con la implementacion de HTTPS POST.

Código Delphi [-]
procedure EnviarECF(FacturaJSON:string);
var
  IdHTTP: TIdHTTP;
  RequestBody: TStringStream;
  ResponseBody: string;
  JsonString: string;
  URL: string;
  // If using HTTPS, an IOHandler is needed
  LHandler: TIdSSLIOHandlerSocketOpenSSL;
begin
  URL := 'https://example.com/api/endpoint';
  IdHTTP := TIdHTTP.Create(nil);
  RequestBody := TStringStream.Create('');

  try
      // *** If the URL is HTTPS, create and assign the SSL IOHandler ***
      try
        LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
        LHandler.SSLOptions.Method := sslvTLSv1_2;
        LHandler.SSLOptions.SSLVersions := [sslvTLSv1_2];
        IdHTTP.IOHandler := LHandler;
        // Configure SSL options if necessary (TLS version, etc.)

        JsonString := FacturaJSON; // Your JSON data

        IdHTTP.Request.Accept := 'application/json';
        IdHTTP.Request.ContentType := 'application/json'; // Set content type

        // Write JSON string to the stream
        RequestBody.WriteString(JsonString);
        RequestBody.Position := 0; // Reset stream position to the beginning

        // Perform the POST request
        ResponseBody := IdHTTP.Post(URL, RequestBody);

        // Process the response 
        ShowMessage('Response: ' + ResponseBody);

    except
      on E: EIdHTTPProtocolException do
        ShowMessage('HTTP Error: ' + E.Message + ' ' + E.ErrorMessage);
      on E: Exception do
        ShowMessage('Error: ' + E.Message);
    end;
  finally
    // Free objects
    FreeAndNil(RequestBody);
    FreeAndNil(IdHTTP);
    // IOHandler is freed with IdHTTP if it is the owner
  end;

end;

Así consumimos el procedure anterior desde un formulario. Memo1 contiene el JSON.

Código Delphi [-]

procedure TFeCFEnvio.btEnviarClick(Sender: TObject);
begin

EnviarECF(Memo1.Lines.Text);

end;

Seguimos evaluando proveedores.

Nuevamente muchas gracias!
Saludos.-