Ley antifraude 2021 (VERIFACTU) - Programas informáticos

[Delphier]

Os lo pongo , Por si le sirve a alguien como Idea o como ayuda.


El componente Requiere Delphi 12 , me baso en enviar XML preparados previamente almacenados con un certificado también almacenado en el software.

Bàsicamente le cargamos el certificado , el password un XML y lo enviamos.

unit VerifactuHTTPRIO;

interface

uses
  System.SysUtils,
  System.Classes,
  Soap.Rio,
  Dialogs,
  Xml.XMLDoc,
  Xml.XMLIntf,
  Soap.SOAPHTTPClient,
  Soap.SOAPHTTPTrans;



type

  TBeforeExecuteEvent = procedure(const MethodName: string; SOAPRequest: TStream) of object;
  TAfterExecuteEvent  = procedure(const MethodName: string; SOAPResponse: TStream) of object;

  TVerifactuHTTPRIO = class(THTTPRIO)


  private
    { Private declarations }
    FCertificate    : TMemoryStream;
    FCertPassword   : String;
    FXMLRequest     : TStringList;
    FXMLResponse    : TStringList;
    FOnAfterExecute : TAfterExecuteEvent;
    FOnBeforeExecute: TBeforeExecuteEvent;
    function StreamToString(aStream: TStream): string;
  protected
    { Protected declarations }
    procedure DoAfterExecute(const MethodName: string; Response: TStream); override;
    procedure DoBeforeExecute(const MethodName: string; Request: TStream); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property OnAfterExecute: TAfterExecuteEvent read FOnAfterExecute write FOnAfterExecute;
    property OnBeforeExecute: TBeforeExecuteEvent read FOnBeforeExecute write FOnBeforeExecute;
    property Certificate   : TMemoryStream  read FCertificate write FCertificate;
    property CertPassword  : String  read FCertPassword write FCertPassword;
    property XMLRequest    : TStringList  read FXMLRequest write FXMLRequest;
    property XMLResponse   : TStringList  read FXMLResponse write FXMLResponse;

  end;

procedure Register;

implementation


constructor TVerifactuHTTPRIO.Create(AOwner: TComponent);
Begin
  Inherited Create(Aowner);

  FCertificate := TMemoryStream.Create;
  FXMLRequest  := TStringList.Create;
  FXMLResponse := TStringList.Create;

End;

destructor TVerifactuHTTPRIO.Destroy;
begin

  FCertificate.Free;
  FXMLRequest.Free;
  FXMLResponse.Free;

  inherited;
end;


procedure TVerifactuHTTPRIO.DoBeforeExecute(const MethodName: string; Request: TStream);
begin

  // Si hay XMLRequest la enviamos
  if FXMLRequest.Count > 0 then
  Begin
     Request.Position := 0; // Importante
     FXMLRequest.SaveToStream(Request);
  End;


  // Cetificado
  HTTPWebNode.ClientCertificate.Stream   := Certificate;
  HTTPWebNode.ClientCertificate.Password := CertPassword;


  if Assigned(FOnBeforeExecute) then
  begin
    FOnBeforeExecute(MethodName, Request);
    Request.Position := 0;
  end;

end;

procedure TVerifactuHTTPRIO.DoAfterExecute(const MethodName: string; Response: TStream);
var RespuestaXML : String;
begin

  // Asignamos la respuesta y Maquillamos XML
  RespuestaXML := StreamToString(Response);

  RespuestaXML := Xml.XMLDoc.FormatXMLData(RespuestaXML);

  FXMLResponse.Text := RespuestaXML;


  if Assigned(FOnAfterExecute) then
  begin
    FOnAfterExecute(MethodName, Response);
    Response.Position := 0;
  end;

end;


function TVerifactuHTTPRIO.StreamToString(aStream: TStream): string;
var
  SS: TStringStream;
begin
  if aStream <> nil then
  begin
    SS := TStringStream.Create('');
    try
      SS.CopyFrom(aStream, 0);
      Result := SS.DataString;
    finally
      SS.Free;
    end;
  end else
  begin
    Result := '';
  end;
end;


procedure Register;
begin
  RegisterComponents('Componentes Verifactu', [TVerifactuHTTPRIO]);
end;

end.

Como Usar:

procedure TFormSoap.Button2Click(Sender: TObject);
var direccion_envio : String;
begin


direccion_envio := 'https://prewww1.aeat.es/wlpl/TIKE-CONT/ws/SistemaFacturacion/VerifactuSOAP';

// Cargar el certificado
VerifactuRIO.Certificate.LoadFromFile('MiCertificado.pfx');
VerifactuRIO.CertPassword := '1234';


// Cargar el XMl  enviar , de fichero o de texto
VerifactuRIO.XMLRequest.LoadFromFile('XML_Envio_Verifactu.xml');

// Llamada
GetsfPortTypeVerifactu(False, direccion_envio, VerifactuRIO).RegFactuSistemaFacturacion(nil);

// Aquí tenemnos la respues
VerifactuRIO.XMLResponse.Text;

end;

Un Saludo