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.
Código:
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:
Código:
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