Certificado o firma digital en archivo XML. AEAT

[rafa1963]

Buenas tardes compañeros, estoy intentando firmar con mi certificado digital con Delphi un archivo XML ya creado y no sé exactamente como crearlo.
Se que tengo que crear un dodo <signature>. La verdad es que no tengo mucha idea de como poder hacerlo.
Agradecería muchísimo vuestras opiniones y sugerencias.

Gracias.

[NANAUJ1970]

Una buena forma de hacerlo es usando autofirma. Lo puedes descargar gratuitamente e instalarlo. Este accede al almacen de certificados de windows.

Aqui tienes un codigo en D7 para firmar un xml usando el metodo de autofirma. Hay que pasarle los parametros nombre del fichero xml normal y el nombre que quieres que cree firmado.

Código Delphi [-]
USES    Capicom_TLB,....

procedure FirmarXML(const XMLFileName: string; const SignedXMLFileName: string);
var
  CertStore: IStore;
  Certs: ICertificates;
  Cert: ICertificate2;
  i: Integer;
  CertName: string;
  CertBuscar: string;
  TempVar: OleVariant;
  TempCert: ICertificate;
  AliasCertificado: string;
  AutoFirmaPath: string;
  RutaAutoFirma: string;
  certpassword: string;
  Comando: string;
begin


  AutoFirmaPath:=ansilowercase(f.Buscarautofirmapath);
  AutoFirmaPath := trim(StringReplace(AutoFirmaPath, '"%1"', '', [rfReplaceAll]));
  AutoFirmaPath := trim(StringReplace(AutoFirmaPath, 'autofirma.exe', 'AutoFirmaCommandLine.exe', [rfReplaceAll]));
  if autoFirmaPath='' then  begin
      f.Aviso('error','No Se Encuentra AutoFirma En Registro '+autoFirmaPath);
      exit;
  end;
  rutaAutoFirma:=extractfilePath( autoFirmaPath )+'AutoFirmaCommandLine.exe';
  if not FileExists(rutaAutoFirma) then begin
      f.Aviso('error','No Se Encuentra Ejecutable AutoFirma '+rutaAutoFirma);
      exit;
  end;
  // AutoFirmaPath := 'C:\Program Files\AutoFirma\AutoFirma\AutoFirmaCommandLine.exe'; // path indicado manualmente

  try
    // Verificar que AutoFirma est� instalado
    if not FileExists(AutoFirmaPath) then
    begin
      ShowMessage('AutoFirma no encontrado en: ' + AutoFirmaPath);
      Exit;
    end;

    // Abrir el almac�n de certificados del usuario actual
    CertStore := CoStore.Create;
    CertStore.Open(CAPICOM_CURRENT_USER_STORE, 'My', CAPICOM_STORE_OPEN_READ_ONLY);
    Certs := CertStore.Certificates;

    // Buscar certificado por coincidencia en el SubjectName
    CertBuscar := 'nombreparcial'; // Cambiar por parte del nombre del certificado
    Cert := nil;
    for i := 1 to Certs.Count do
    begin
      TempVar := Certs.Item[i];
      if Supports(TempVar, ICertificate, TempCert) then
      begin
        if Pos(CertBuscar, TempCert.SubjectName) > 0 then
        begin
          Cert := TempCert as ICertificate2;
          AliasCertificado := TempCert.SubjectName;
          f_entrada.Memo1.Lines.Add('Certificado encontrado: ' + AliasCertificado);
          Break;
        end;
      end;
    end;

    if Cert = nil then
    begin
      ShowMessage('Certificado no encontrado con: ' + CertBuscar);
      Exit;
    end;

    AliasCertificado := ExtraerCN(TempCert.SubjectName);

    //AliasCertificado := 'ANTONIO_FLORES_41000000Z'; // SI QUIERES ESPECIFICAR EL NOMBRE DIRECTAMENTE

    // Construir el comando
    RutaAutoFirma := ExtractShortPathName(AutoFirmaPath);
    Comando := Format('%s sign -format xades -i "%s" -o "%s" -store windows -password "" -alias "%s"',
                    [RutaAutoFirma, XMLFileName, SignedXMLFileName, AliasCertificado]);

    // Ejecutar AutoFirma y esperar que termine
    ExecuteAndWait(Comando);


    // Verificar si se gener� el archivo firmado
    if not FileExists(SignedXMLFileName) then
      ShowMessage('Error firmando el XML.')

  except
    on E: Exception do begin
      ShowMessage('Excep: Error al firmar XML: ' + E.Message);
    end;
  end;

end;

procedure ExecuteAndWait(const aCommando: string);
var
  tmpStartupInfo: TStartupInfo;
  tmpProcessInformation: TProcessInformation;
  tmpProgram: String;
begin
  tmpProgram := trim(aCommando);
//  f_entrada.Memo1.Lines.add('Executing: ' + tmpProgram); // Mostrar la instrucción que se ejecuta
  FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0);
  with tmpStartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    wShowWindow := SW_HIDE;
  end;

  if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW,
    nil, nil, tmpStartupInfo, tmpProcessInformation) then
  begin
    // loop every 10 ms
    while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do
    begin
      Application.ProcessMessages;
    end;
    CloseHandle(tmpProcessInformation.hProcess);
    CloseHandle(tmpProcessInformation.hThread);
  end
  else
  begin
    RaiseLastOSError;
  end;
end;

[NANAUJ1970]

El problema que yo tengo es que me de errores al enviar el xml a preproduccion con cualquier codigo usando librerias de D7 con indy9,etc. Y prefiero no hacerlo con curl, ya que este necesita el certificado en pfx y su contraseña, y seria mas comodo hacerlo usando los certificacos del almacen de windows..

Alguien tiene un codigo en Delphi7 que funcione bien para enviar los xml usando un certificado personal del almacen de windows?

gracias de antemano.