unit uEnviosTipsaClient;

{
  uEnviosTipsaClient.pas
  Implementación TIPSA (DinaPaq) del cliente de envíos genérico.

  Descripción:
    Implementa la interfaz IEnviosClient para el transportista TIPSA usando
    el API SOAP DinaPaq. Las peticiones XML se construyen manualmente para
    mayor robustez ante cambios de versión del servicio.

  URL Producción:
    Login: https://ws.tipsa-dinapaq.com/SOAP?service=LoginWSService
    Serv:  https://ws.tipsa-dinapaq.com/SOAP?service=WebServService
  URL Validación:
    Login: https://wsval.tipsa-dinapaq.com/SOAP?service=LoginWSService
    Serv:  https://wsval.tipsa-dinapaq.com/SOAP?service=WebServService
}

interface

uses
  System.SysUtils, System.Classes, System.Net.HttpClient, System.Net.URLClient,
  System.NetEncoding, uEnviosTypes;

type
  TTipsaEnviosClient = class
  private
    FConfig       : TEnviosConfig;
    FSessionGUID  : string;
    FURLLogin     : string;
    FURLServ      : string;

    function BuildEnvelope(const ABody: string): string;
    function PostSOAP(const AURL, AAction, ABody: string): string;
    function ExtractNode(const AXML, ANodeName: string): string;
    function FormatFechaRec(const ADate: TDateTime): string;
    function FormatHoraRec(const ADateTime: TDateTime): string;
    function FormatFechaEnvio(const ADate: TDateTime): string;
    function XmlEscape(const AText: string): string;
  public
    constructor Create(const AConfig: TEnviosConfig);

    function Login: Boolean;
    function GrabaEnvio(const AParams: TEnvioParams): TEnvioResult;
    function GetEtiqueta(const ARef: string; APDF: Boolean = True;
                         AIdRepDet: Integer = 233): TBytes;
    function GetEstados(const ARef: string): TArray<TEstadoEnvio>;
    function GrabaRecogida(const AParams: TRecogidaParams): TRecogidaResult;

    property SessionGUID: string read FSessionGUID;
  end;

implementation

uses
  System.DateUtils, Vcl.Dialogs;

const
  NS_SOAPENV = 'http://schemas.xmlsoap.org/soap/envelope/';
  NS_TEMPURI = 'http://tempuri.org/';

constructor TTipsaEnviosClient.Create(const AConfig: TEnviosConfig);
var
  LBaseURL: string;
  LPos: Integer;
begin
  inherited Create;
  FConfig := AConfig;

  if AConfig.Entorno then
    LBaseURL := AConfig.UrlPruebas
  else
    LBaseURL := AConfig.UrlProduccion;

  // Fallback si no está configurada la URL en BD
  if Trim(LBaseURL) = '' then
  begin
    if AConfig.Entorno then
      LBaseURL := 'https://wsval.tipsa-dinapaq.com/SOAP'
    else
      LBaseURL := 'https://ws.tipsa-dinapaq.com/SOAP';
  end;

  // Limpiar parámetros de query antiguos si los hay en la base de datos
  LPos := Pos('?service=', LBaseURL);
  if LPos > 0 then
    LBaseURL := Copy(LBaseURL, 1, LPos - 1);

  if LBaseURL.EndsWith('/') then
    Delete(LBaseURL, Length(LBaseURL), 1);

  FURLLogin := LBaseURL + '?service=LoginWSService';
  FURLServ  := LBaseURL + '?service=WebServService';
end;

function TTipsaEnviosClient.XmlEscape(const AText: string): string;
begin
  Result := AText
    .Replace('&',  '&amp;',  [rfReplaceAll])
    .Replace('<',  '&lt;',   [rfReplaceAll])
    .Replace('>',  '&gt;',   [rfReplaceAll])
    .Replace('"',  '&quot;', [rfReplaceAll])
    .Replace('''', '&apos;', [rfReplaceAll]);
end;

function TTipsaEnviosClient.FormatFechaRec(const ADate: TDateTime): string;
begin
  Result := FormatDateTime('yyyy/mm/dd', ADate);
end;

function TTipsaEnviosClient.FormatHoraRec(const ADateTime: TDateTime): string;
begin
  Result := FormatDateTime('yyyy/mm/dd hh:nn:ss', ADateTime);
end;

function TTipsaEnviosClient.FormatFechaEnvio(const ADate: TDateTime): string;
begin
  Result := FormatDateTime('yyyy-mm-dd', ADate);
end;

function TTipsaEnviosClient.BuildEnvelope(const ABody: string): string;
begin
  Result :=
    '<?xml version="1.0" encoding="UTF-8"?>' +
    '<soapenv:Envelope xmlns:soapenv="' + NS_SOAPENV + '"' +
    ' xmlns:tem="' + NS_TEMPURI + '">' +
    '<soapenv:Header>' +
    '<tem:ROClientIDHeader><tem:ID>' + FSessionGUID + '</tem:ID></tem:ROClientIDHeader>' +
    '</soapenv:Header>' +
    '<soapenv:Body>' + ABody + '</soapenv:Body>' +
    '</soapenv:Envelope>';
end;

function TTipsaEnviosClient.PostSOAP(const AURL, AAction, ABody: string): string;
var
  LClient  : THTTPClient;
  LRequest : TStringStream;
  LResponse: IHTTPResponse;
begin
  Result := '';
  LClient := THTTPClient.Create;
  try
    LClient.ConnectionTimeout := 15000;
    LClient.ResponseTimeout   := 30000;
    LClient.CustomHeaders['SOAPAction'] := AAction;
    LClient.ContentType := 'text/xml;charset=utf-8';

    LRequest := TStringStream.Create(ABody, TEncoding.UTF8);
    try
      LResponse := LClient.Post(AURL, LRequest);
      Result := LResponse.ContentAsString(TEncoding.UTF8);
    finally
      LRequest.Free;
    end;
  finally
    LClient.Free;
  end;
end;

function TTipsaEnviosClient.ExtractNode(const AXML, ANodeName: string): string;
var
  LPosOpen, LPosClose, LStart: Integer;
begin
  Result := '';
  
  // Buscar con namespace, ej: ":NodeName"
  LPosOpen := Pos(':' + ANodeName, AXML);
  if LPosOpen = 0 then
    // Buscar sin namespace, ej: "<NodeName"
    LPosOpen := Pos('<' + ANodeName, AXML);
    
  if LPosOpen = 0 then Exit;
  
  // Localizar el cierre de la etiqueta de apertura '>' (que puede contener atributos)
  LStart := Pos('>', AXML, LPosOpen);
  if LStart = 0 then Exit;
  Inc(LStart);
  
  // Buscar la etiqueta de cierre </
  LPosClose := Pos('</', AXML, LStart);
  while LPosClose > 0 do
  begin
    // Validar que la etiqueta de cierre se corresponda con el nombre de nuestro nodo
    if (Pos(ANodeName + '>', AXML, LPosClose) > 0) and 
       (Pos(ANodeName + '>', AXML, LPosClose) < LPosClose + 15) then
    begin
      Result := Copy(AXML, LStart, LPosClose - LStart);
      Exit;
    end;
    LPosClose := Pos('</', AXML, LPosClose + 2);
  end;
end;

// ---------------------------------------------------------------------------
function TTipsaEnviosClient.Login: Boolean;
var
  LBody, LResponse, LResult, LError: string;
begin
  Result := False;
  FSessionGUID := '';
  LBody :=
    '<?xml version="1.0" encoding="UTF-8"?>' +
    '<soapenv:Envelope xmlns:soapenv="' + NS_SOAPENV + '"' +
    ' xmlns:tem="' + NS_TEMPURI + '">' +
    '<soapenv:Header>' +
    '<tem:ROClientIDHeader><tem:ID></tem:ID></tem:ROClientIDHeader>' +
    '</soapenv:Header>' +
    '<soapenv:Body>' +
    '<tem:LoginWSService___LoginCli>' +
    '<tem:strCodAge>' + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAge>' +
    '<tem:strCod>' + XmlEscape(FConfig.CodCliente) + '</tem:strCod>' +
    '<tem:strPass>' + XmlEscape(FConfig.Password) + '</tem:strPass>' +
    '</tem:LoginWSService___LoginCli>' +
    '</soapenv:Body></soapenv:Envelope>';

  try
    LResponse := PostSOAP(FURLLogin, 'LoginWSService___LoginCli', LBody);
  except
    on E: Exception do
      raise Exception.CreateFmt('Error de conexión con %s: %s', [FConfig.NombreTransp, E.Message]);
  end;

  LResult := ExtractNode(LResponse, 'Result');
  LError  := ExtractNode(LResponse, 'strError');

  if SameText(Trim(LResult), 'true') and (Trim(LError) = '0') then
  begin
    FSessionGUID := ExtractNode(LResponse, 'strSesion');
    Result := FSessionGUID <> '';
  end
  else
  begin
    if LError = '' then
    begin
      LError := ExtractNode(LResponse, 'faultstring');
      if LError = '' then
        LError := Copy(LResponse, 1, 250);
    end;
    raise Exception.CreateFmt('Login %s fallido. Error: %s', [FConfig.NombreTransp, LError]);
  end;
end;

// ---------------------------------------------------------------------------
function TTipsaEnviosClient.GrabaEnvio(const AParams: TEnvioParams): TEnvioResult;
var
  LBody, LResponse: string;
begin
  Result.OK := False;
  if FSessionGUID = '' then
    raise Exception.Create('Debe llamar a Login() antes de GrabaEnvio().');

  LBody :=
    '<tem:WebServService___GrabaEnvio24>' +
    '<tem:strCodAgeCargo>' + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeCargo>' +
    '<tem:strCodAgeOri>'   + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeOri>' +
    '<tem:dtFecha>'        + FormatFechaEnvio(Now) + '</tem:dtFecha>' +
    '<tem:strCodTipoServ>' + XmlEscape(AParams.CodTipoServ) + '</tem:strCodTipoServ>' +
    '<tem:strCodCli>'      + XmlEscape(FConfig.CodCliente) + '</tem:strCodCli>' +
    '<tem:strNomOri>'      + XmlEscape(AParams.NomOri) + '</tem:strNomOri>' +
    '<tem:strDirOri>'      + XmlEscape(AParams.DirOri) + '</tem:strDirOri>' +
    '<tem:strPobOri>'      + XmlEscape(AParams.PobOri) + '</tem:strPobOri>' +
    '<tem:strCPOri>'       + XmlEscape(AParams.CPOri)  + '</tem:strCPOri>' +
    '<tem:strTlfOri>'      + XmlEscape(AParams.TlfOri) + '</tem:strTlfOri>' +
    '<tem:strNomDes>'      + XmlEscape(AParams.NomDes) + '</tem:strNomDes>' +
    '<tem:strDirDes>'      + XmlEscape(AParams.DirDes) + '</tem:strDirDes>' +
    '<tem:strPobDes>'      + XmlEscape(AParams.PobDes) + '</tem:strPobDes>' +
    '<tem:strCPDes>'       + XmlEscape(AParams.CPDes)  + '</tem:strCPDes>' +
    '<tem:strCodPais>'     + XmlEscape(AParams.CodPais) + '</tem:strCodPais>' +
    '<tem:strTlfDes>'      + XmlEscape(AParams.TlfDes) + '</tem:strTlfDes>' +
    '<tem:intPaq>'         + IntToStr(AParams.NumBultos) + '</tem:intPaq>' +
    '<tem:strRef>'         + XmlEscape(AParams.Referencia) + '</tem:strRef>' +
    '<tem:boInsert>true</tem:boInsert>' +
    '<tem:strContenido>'   + XmlEscape(AParams.Observaciones) + '</tem:strContenido>' +
    '</tem:WebServService___GrabaEnvio24>';

  try
    LResponse := PostSOAP(FURLServ, 'WebServService___GrabaEnvio24', BuildEnvelope(LBody));
  except
    on E: Exception do begin Result.Error := 'Error de conexión: ' + E.Message; Exit; end;
  end;

  Result.AlbaranTransportista := Trim(ExtractNode(LResponse, 'strAlbaranOut'));
  Result.GuidTransportista    := Trim(ExtractNode(LResponse, 'strGuidOut'));
  Result.CodAgeDestino        := Trim(ExtractNode(LResponse, 'strCodAgeDesOut'));
  Result.TipoEnvio            := Trim(ExtractNode(LResponse, 'strTipoEnvOut'));
  try Result.FechaEntrega := StrToDateTime(Copy(Trim(ExtractNode(LResponse,'dtFecEntrOut')),1,10)); except Result.FechaEntrega := 0; end;

  Result.OK := Result.AlbaranTransportista <> '';
  if not Result.OK then
    Result.Error := 'API no devolvió nº albarán. Resp: ' + Copy(LResponse, 1, 500);
end;

// ---------------------------------------------------------------------------
function TTipsaEnviosClient.GetEtiqueta(const ARef: string; APDF: Boolean;
                                         AIdRepDet: Integer): TBytes;
var
  LBody, LResponse, LBase64, LFormato: string;
begin
  SetLength(Result, 0);
  if FSessionGUID = '' then
    raise Exception.Create('Debe llamar a Login() antes de GetEtiqueta().');
  if APDF then LFormato := 'pdf' else LFormato := 'zpl';
  LBody :=
    '<tem:WebServService___ConsEtiquetaEnvio6>' +
    '<tem:strCodAgeOri>'    + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeOri>' +
    '<tem:strCodAgeCargo>'  + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeCargo>' +
    '<tem:StrAlbaran>'      + XmlEscape(ARef) + '</tem:StrAlbaran>' +
    '<tem:intIdRepDet>'     + IntToStr(AIdRepDet) + '</tem:intIdRepDet>' +
    '<tem:strFormato>'      + LFormato + '</tem:strFormato>' +
    '</tem:WebServService___ConsEtiquetaEnvio6>';
  try
    LResponse := PostSOAP(FURLServ, 'WebServService___ConsEtiquetaEnvio6', BuildEnvelope(LBody));
  except
    on E: Exception do raise Exception.CreateFmt('Error al obtener etiqueta: %s', [E.Message]);
  end;
  LBase64 := Trim(ExtractNode(LResponse, 'strEtiqueta'));
  if LBase64 = '' then
    raise Exception.CreateFmt('No se recibió etiqueta para el albarán %s', [ARef]);
  Result := TNetEncoding.Base64.DecodeStringToBytes(LBase64);
end;

// ---------------------------------------------------------------------------
function TTipsaEnviosClient.GetEstados(const ARef: string): TArray<TEstadoEnvio>;
var
  LBody, LResponse, LCData, LEntry: string;
  LPos, LEnd, LCount: Integer;
  LEstado: TEstadoEnvio;

  function ExtractAttr(const AXml, AAttr: string): string;
  var PA, VS, VE: Integer;
  begin
    Result := '';
    PA := Pos(AAttr + '="', AXml);
    if PA = 0 then Exit;
    VS := PA + Length(AAttr) + 2;
    VE := Pos('"', AXml, VS);
    if VE > VS then Result := Copy(AXml, VS, VE - VS);
  end;

begin
  SetLength(Result, 0);
  if FSessionGUID = '' then
    raise Exception.Create('Debe llamar a Login() antes de GetEstados().');
  LCount := 0;
  LBody :=
    '<tem:WebServService___ConsEnvEstados>' +
    '<tem:strCodAgeCargo>' + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeCargo>' +
    '<tem:strCodAgeOri>'   + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeOri>' +
    '<tem:strAlbaran>'     + XmlEscape(ARef) + '</tem:strAlbaran>' +
    '</tem:WebServService___ConsEnvEstados>';
  try
    LResponse := PostSOAP(FURLServ, 'WebServService___ConsEnvEstados', BuildEnvelope(LBody));
  except
    on E: Exception do raise Exception.CreateFmt('Error al consultar estados: %s', [E.Message]);
  end;
  LPos := Pos('<![CDATA[', LResponse);
  LEnd := Pos(']]>', LResponse);
  if (LPos = 0) or (LEnd = 0) then Exit;
  LCData := Copy(LResponse, LPos + 9, LEnd - LPos - 9);
  LCount := 0;
  LPos := 1;
  repeat
    LPos := Pos('<ENV_ESTADOS ', LCData, LPos);
    if LPos = 0 then Break;
    LEnd := Pos('/>', LCData, LPos);
    if LEnd = 0 then Break;
    LEntry := Copy(LCData, LPos, LEnd - LPos + 2);
    LEstado.IdEstado   := StrToIntDef(ExtractAttr(LEntry, 'I_ID'), 0);
    LEstado.Codigo     := StrToIntDef(ExtractAttr(LEntry, 'V_COD_TIPO_EST'), -1);
    LEstado.CodUsuario := ExtractAttr(LEntry, 'V_COD_USU_ALTA');
    try LEstado.FechaHora := StrToDateTime(ExtractAttr(LEntry, 'D_FEC_HORA_ALTA')); except LEstado.FechaHora := 0; end;
    LEstado.Descripcion := EstadoDescripcionTIPSA(LEstado.Codigo);
    SetLength(Result, LCount + 1);
    Result[LCount] := LEstado;
    Inc(LCount);
    LPos := LEnd + 2;
  until LPos = 0;
end;

// ---------------------------------------------------------------------------
function TTipsaEnviosClient.GrabaRecogida(const AParams: TRecogidaParams): TRecogidaResult;
var
  LBody, LResponse: string;
begin
  Result.OK := False;
  if FSessionGUID = '' then
    raise Exception.Create('Debe llamar a Login() antes de GrabaRecogida().');

  LBody :=
    '<tem:WebServService___GrabaRecogida10>' +
    '<tem:strCodAgeSol>'    + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeSol>' +
    '<tem:strCodAgeCargo>'  + XmlEscape(FConfig.CodAgencia) + '</tem:strCodAgeCargo>' +
    '<tem:dtFecRec>'        + FormatFechaRec(AParams.FechaRecogida) + '</tem:dtFecRec>' +
    '<tem:dtHoraRecIni>'    + FormatHoraRec(AParams.HoraIni) + '</tem:dtHoraRecIni>' +
    '<tem:dtHoraRecFin>'    + FormatHoraRec(AParams.HoraFin) + '</tem:dtHoraRecFin>' +
    '<tem:intBul>'          + IntToStr(AParams.NumBultos) + '</tem:intBul>' +
    '<tem:strNomOri>'       + XmlEscape(AParams.NomOri)     + '</tem:strNomOri>' +
    '<tem:strTipoViaOri>'   + XmlEscape(AParams.TipoViaOri) + '</tem:strTipoViaOri>' +
    '<tem:strDirOri>'       + XmlEscape(AParams.DirOri)     + '</tem:strDirOri>' +
    '<tem:strNumOri>'       + XmlEscape(AParams.NumOri)     + '</tem:strNumOri>' +
    '<tem:strCPOri>'        + XmlEscape(AParams.CPOri)      + '</tem:strCPOri>' +
    '<tem:strTlfOri>'       + XmlEscape(AParams.TlfOri)     + '</tem:strTlfOri>' +
    '<tem:strNomDes>'       + XmlEscape(AParams.NomDes)     + '</tem:strNomDes>' +
    '<tem:strTipoViaDes>'   + XmlEscape(AParams.TipoViaDes) + '</tem:strTipoViaDes>' +
    '<tem:strDirDes>'       + XmlEscape(AParams.DirDes)     + '</tem:strDirDes>' +
    '<tem:strNumDes>'       + XmlEscape(AParams.NumDes)     + '</tem:strNumDes>' +
    '<tem:strPobDes>'       + XmlEscape(AParams.PobDes)     + '</tem:strPobDes>' +
    '<tem:strCPDes>'        + XmlEscape(AParams.CPDes)      + '</tem:strCPDes>' +
    '<tem:strTlfDes>'       + XmlEscape(AParams.TlfDes)     + '</tem:strTlfDes>' +
    '<tem:strObs>'          + XmlEscape(AParams.Observaciones) + '</tem:strObs>' +
    '<tem:strCodCli>'       + XmlEscape(FConfig.CodCliente) + '</tem:strCodCli>' +
    '<tem:strPersContacto>' + XmlEscape(AParams.PersContacto) + '</tem:strPersContacto>' +
    '<tem:strCodTipoServ>'  + XmlEscape(AParams.CodTipoServ) + '</tem:strCodTipoServ>' +
    '<tem:strRef>'          + XmlEscape(AParams.Referencia) + '</tem:strRef>' +
    '<tem:strObsDes>'       + XmlEscape(AParams.ObsDes)     + '</tem:strObsDes>' +
    '<tem:strContenido>'    + XmlEscape(AParams.Contenido)  + '</tem:strContenido>' +
    '</tem:WebServService___GrabaRecogida10>';

  ShowMessage('Llamada API Tipsa (GrabaRecogida10):' + #13#10 +
              'URL: ' + FURLServ + #13#10 +
              'SOAPAction: WebServService___GrabaRecogida10' + #13#10 +
              'XML completo (SOAP Envelope):' + #13#10 + BuildEnvelope(LBody));

  try
    LResponse := PostSOAP(FURLServ, 'WebServService___GrabaRecogida10', BuildEnvelope(LBody));
  except
    on E: Exception do begin Result.Error := 'Error de conexión: ' + E.Message; Exit; end;
  end;

  Result.CodRecogida      := Trim(ExtractNode(LResponse, 'strCodOut'));
  Result.GuidTransportista := Trim(ExtractNode(LResponse, 'strGuidOut'));
  Result.CodAgeOrigen     := Trim(ExtractNode(LResponse, 'strCodAgeOriOut'));
  Result.CodAgeDestino    := Trim(ExtractNode(LResponse, 'strCodAgeDesOut'));
  try Result.FechaAlta := StrToDateTime(Copy(Trim(ExtractNode(LResponse,'dtFecHoraAltaOut')),1,19)); except Result.FechaAlta := 0; end;

  Result.OK := Result.CodRecogida <> '';
  if not Result.OK then
    Result.Error := 'API no devolvió código de recogida. Resp: ' + Copy(LResponse, 1, 500);
end;

end.