Threads para Timbrar Documentos
 

Hola que tal, buen día, solicito de su apoyo para revisar el siguiente código, el cual estoy manejando hilos para el timbrado de las facturas electrónicas. Mi objetivo es tener un servidor de escucha, donde le estén llegando peticiones de timbrado, cuyo parámetro es la ruta del XML pendiente de timbrar, entonces cuando el servidor reciba dicha petición, creo un hilo para timbrar el documento fiscal, y retorno una cadena, el cual si este esta vacío, significa que se timbró correctamente, sino significa que hubo un error en el timbrado.

Si me funciona pero no me ejecuta el timbrado simultáneamente, sino que termina uno y continua con el otro.

A continuación muestro el código del mi hilo.

Código Delphi [-]
type
  TTimbrado = class(TThread)
  protected
    sRutaXMLSave: String;
    sPasswd: String;
    sRutaEmpresa: String;
    sRFC: String;
    xRutaXML: String;
    xRutaTimbre: WideString;

    procedure Execute; override;
    function fAbreArchivoRutas(sRFC: String): Boolean;
    function fExtraeRFC(wFileName: WideString): WideString;
    function fParse(xLlave, xText: WideString): WideString;
    procedure pTimbrado(Value: WideString);
  public
    wXMLTimbrado: WideString;
    
    property wXMLPendiente: WideString read wXMLTimbrado write pTimbrado;
  end;

const
  kFACTURACION_I: String = 'CONTPAQ I Facturacion';
  sRutaContpaq: String = 'C:\Compacw\Empresas\contpaqi_rutas.txt';

implementation

{ TTimbrado }

procedure TTimbrado.Execute;
begin
    inherited;
    FreeOnTerminate := True;
end;

{ Función para Abrir el Archivo de Datos ************************************ }
function TTimbrado.fAbreArchivoRutas(sRFC: String): Boolean;
var fFile: TextFile;
    sText: String;
    sLinea: TStringList;
    bResult: Boolean;
begin
    bResult := False;

    if FileExists(sRutaContpaq) then
    begin
        if Assigned(sLinea) then
            sLinea := TStringList.Create;

        try
            sLinea.Clear;

            AssignFile(fFile, sRutaContpaq);
            Reset(fFile);

            while not Eof(fFile) do
            begin
                sText := EmptyStr;
                Readln(fFile, sText);

                if Pos(sRFC, sText) > 0 then
                begin
                    sText := StringReplace(sText, '|', '","', [rfReplaceAll]);

                    sText := Copy(sText, 2, Length(sText));
                    SetLength(sText, Length(sText) - 2);

                    sLinea.CommaText := sText;

                    sRutaEmpresa  := sLinea[2];
                    sRutaXMLSave  := sLinea[3];
                    sPasswd       := sLinea[4];

                    bResult := True;
                end;
            end;            
        finally
            sLinea.Free;
        end;
    end;

    Result := bResult;
end;

{ Función para Extraer el RFC de un Archivo XML ***************************** }
function TTimbrado.fExtraeRFC(wFileName: WideString): WideString;
var xmlDocto: TXMLDocument;
    wCFDI, wResult: WideString;
    sRFC: String;
begin
    wResult := '';
    wCFDI   := '';
    sRFC    := '';

    if FileExists(wFileName) then
    begin
        xmlDocto := TXMLDocument.Create(Application);

        try
            xmlDocto.LoadFromFile(wFileName);
            xmlDocto.Active := True;

            if (Pos('Pago', wFileName) > 0) or (Pos('Nota_Credito', wFileName) > 0) then
                wCFDI := UTF8Decode(xmlDocto.DocumentElement.ChildNodes[1].XML)
            else
            begin
                wCFDI := UTF8Decode(xmlDocto.DocumentElement.ChildNodes[0].XML);

                if Pos('CfdiRelacionado', wCFDI) > 0 then
                    wCFDI := UTF8Decode(xmlDocto.DocumentElement.ChildNodes[1].XML);
            end;

            sRFC := fParse('Rfc="', wCFDI);

            wResult := sRFC;

            xmlDocto.Active := False;
        finally
            xmlDocto.Free;
        end;
    end;

    Result := wResult;
end;

{ Función para extraer el dato del nodo indicado en un XML ****************** }
function TTimbrado.fParse(xLlave, xText: WideString): WideString;
var p1, p2, ipo, ito: Integer;
begin
    p2  := 0;
    p1  := Pos(xLlave, xText);
    p1  := p1 + Length(xLlave);
    ito := Length(xText);

    for ipo := p1 to ito do
    begin
        if Copy(xText, ipo, 1) = '"' then
        begin
            p2 := ipo;
            Break;
        end;
    end;

    Result := Copy(xText, p1, (p2 - p1));
end;

{ Función para Timbrar ****************************************************** }
procedure TTimbrado.pTimbrado(Value: WideString);
var wResult: WideString;
    lError: Longint;
    lUUID: Array[0..255] of Char;
    sRFC: String;
    sRutaSave: String;
    bEsPago: Boolean;
begin
    wResult   := '';
    sRutaSave := EmptyStr;
    bEsPago   := False;

    if (Pos('Pago', Value) > 0) then
        bEsPago := True;

    sRFC := fExtraeRFC(Value);

    if sRFC <> EmptyStr then
    begin
        xRutaXML    := Value;
        xRutaTimbre := StringReplace(Value, 'CFDI_Pendientes', 'CFDI_Timbrados', [rfReplaceAll]);
        xRutaTimbre := TrimLeft(TrimRight(xRutaTimbre));

        if not fAbreArchivoRutas(sRFC) then
            wResult := 'No se encuentra el archivo sRutaContpaq'
        else
        begin
            try
                lError := fInicializaSDK();

                if lError <> 0 then
                    wResult := PChar(fMensajeError(lError))
                else
                begin
                    lError := fSetNombrePAQ(PChar(kFACTURACION_I));

                    if lError <> 0 then
                    begin
                        fTerminaSDK();
                        wResult := PChar(fMensajeError(lError))
                    end
                    else
                    begin
                        lError := fAbreEmpresa(PChar(sRutaEmpresa));

                        if lError <> 0 then
                        begin
                            fTerminaSDK();
                            wResult := PChar(fMensajeError(lError))
                        end
                        else
                        begin
                            lError := fInicializaLicenseInfo(1); // <-- Sistema:    0 = AdminPAQ    1 = CONTPAQ i® Factura Electrónica

                            if lError <> 0 then
                            begin
                                fTerminaSDK();
                                wResult := PChar(fMensajeError(lError))                            
                            end
                            else
                            begin
                                try
                                    if not bEsPago then
                                    begin
                                        lError := fTimbraXML(PChar(xRutaXML),
                                            '5',
                                            lUUID,
                                            '',
                                            PChar(sRutaXMLSave),
                                            PChar(sPasswd),
                                            PChar('c:\compacw\empresas\reportes\factiracopm\plantilla_factura_cfdi_1.htm'));
                                    end
                                    else
                                    begin
                                        lError := fTimbraComplementoPagoXML(PChar(xRutaXML),
                                            '5',
                                            lUUID,
                                            '',
                                            PChar(sRutaXMLSave),
                                            PChar(sPasswd),
                                            PChar('c:\compacw\empresas\reportes\factiracopm\Plantilla_REP_1.htm'));
                                    end;

                                    if lError <> 0 then
                                        wResult := PChar(fMensajeError(lError))
                                    else
                                    begin
                                        sRutaSave := xRutaTimbre;

                                        try
                                            if FileExists(sRutaXMLSave + lUUID + '.xml') then
                                                CopyFile(PChar(sRutaXMLSave + lUUID + '.xml'), PChar(sRutaSave), True);
                                        except
                                            on e: Exception do
                                            begin
                                                wResult := e.Message;
                                            end;
                                        end;

                                        fCierraEmpresa();
                                        fTerminaSDK();

                                        wResult := '';
                                    end;
                                except
                                    on e: Exception do
                                    begin
                                        wResult := e.Message;

                                        fCierraEmpresa();
                                        fTerminaSDK();
                                    end;
                                end;
                            end;
                        end;
                    end;
                end;
            except
                on e: Exception do
                begin
                    fCierraEmpresa();
                    fTerminaSDK();

                    wResult := e.Message;
                end;
            end;
        end;
    end
    else
        wResult := 'El XML por Timbrar no existe';

    wXMLTimbrado := wResult;
end;

Y el siguiente código es para llamar el hilo

Código Delphi [-]
    CoInitialize(nil);

    wResultado := fTimbrado(wRuta);

    if wResultado = '' then
        wRutaTimbre := 'Timbrado: ' + StringReplace(wRuta, 'CFDI_Pendientes', 'CFDI_Timbrados', [rfReplaceAll]);

Espero me puedan apoyar.

¿Estás llamando en algun momento al método Execute?
¿Puedes poner el código de cómo crear el Thread?

La documentación dice:
"Define the thread object's Execute method by inserting the code that should execute when the thread is executed. "

"Defina el método Execute en el objeto TThread insertando el código que debe ejecutarse cuando se lanza el hilo."

Threads para timbrar documentos
 

**********************************************************

Hola que tal, gracias por responder, :eek: olvide poner en foro el llamado al Thread.

La variable wRuta, contiene la ruta del XML a Timbrar, y wResultado, como su nombre lo dice, recibo el resultado del timbrado.

Así es como lo mando a llamar:

Código Delphi [-]
    CoInitialize(nil);

    TimbradoXML := TTimbrado.Create(False);
    TimbradoXML.wXMLPendiente := wRuta;
    TimbradoXML.Terminate;

    wResultado := TimbradoXML.wXMLTimbrado;

Vale. La cosa está un poco más clara...

Haces el Create con el parámetro a False, por lo tanto el thread se inicia automáticamente después de crearlo.
En ese momento se ejecuta el método Execute, que por lo que veo no hace nada (lo tienes vacío).
Ahí acabó la ejecución de tu hilo.
En ese momento llamas al Terminate ¿Para qué?
Luego lo que haces es ejecutar un método de tu clase (pTimbrado a través de la propiedad) que se ejecuta como cualquier otro método de cualquier otra clase, es decir, en el hilo principal de la aplicación.

=> Por eso tu ejecución es secuencial. Has creado una clase que deriva de TThread y no la usas.

Creo que tienes un error de concepto con los Threads. Revisa esto:
http://docwiki.embarcadero.com/Libra...TThread.Create

O en mi blog tienes algunos ejemplos sencillos que te ayudarán a entender cómo funcionan.
https://neftali.clubdelphi.com/ejemp...-sin-utilidad/
https://neftali.clubdelphi.com/ejemp...-ampliado-v-2/
https://neftali.clubdelphi.com/pendi...nd-tcontext3d/

Resumiendo mucho...
(1) Meter muchas cosas dentro de una clase que derive de TThread no significa que estés utilizando Threads.
(2) El método básico de la clase TThead es el método Execute. Lo que pongas ahí es lo que se ejecuta en un thread diferente al principal de la aplicación (en tu clase está vacío)
(3) Importantes además de Execute, son el Terminate y el Synchronize.

No se si me he explicado...

Threads para Timbrar Documentos
 

*****************************************************************************************

Buen día, definitivamente soy nuevo en esto de los Threads, realice estas modificaciones, y ya no hace nada :(

Revise tus códigos y veo que usas el Create y Synchonize y me siento muy confundido, como puedo realizar el llamada pTimbrado dentro del hilo.

Código Delphi [-]
type
  TTimbrado = class(TThread)
  protected
    procedure Execute; override;
    procedure pTimbrado;
  public
    wXMLxTimbrar: WideString;
    wXMLTimbrado: WideString;
    constructor Create(wXMLPendiente: WideString);
  end;

{ TTimbrado }

constructor TTimbrado.Create(wXMLPendiente: WideString);
begin
    inherited Create(False);
    wXMLxTimbrar := wXMLPendiente;
end;

procedure TTimbrado.Execute;
begin
    FreeOnTerminate := True;
    Synchronize(pTimbrado);
end;

procedure TTimbrado.pTimbrado;
var wResult: WideString;
    lError: Longint;
    lUUID: Array[0..255] of Char;
    sRFC: String;
    sRutaSave: String;
    bEsPago: Boolean;
begin
    inherited;
    FreeOnTerminate := True;

    wResult   := '';
    sRutaSave := EmptyStr;
    bEsPago   := False;

    if (Pos('Pago', wXMLxTimbrar) > 0) then
        bEsPago := True;

    sRFC := fExtraeRFC(wXMLxTimbrar);

    if sRFC <> EmptyStr then
    begin
        xRutaXML    := wXMLxTimbrar;
        xRutaTimbre := StringReplace(wXMLxTimbrar, 'CFDI_Pendientes', 'CFDI_Timbrados', [rfReplaceAll]);
        xRutaTimbre := TrimLeft(TrimRight(xRutaTimbre));

        if not fAbreArchivoRutas(sRFC) then
            wResult := 'No se encuentra el archivo sRutaContpaq'
        else
        begin
            try
                lError := fInicializaSDK();

                if lError <> 0 then
                    wResult := PChar(fMensajeError(lError))
                else
                begin
                    lError := fSetNombrePAQ(PChar(kFACTURACION_I));

                    if lError <> 0 then
                    begin
                        fTerminaSDK();
                        wResult := PChar(fMensajeError(lError))
                    end
                    else
                    begin
                        lError := fAbreEmpresa(PChar(sRutaEmpresa));

                        if lError <> 0 then
                        begin
                            fTerminaSDK();
                            wResult := PChar(fMensajeError(lError))
                        end
                        else
                        begin
                            lError := fInicializaLicenseInfo(1); // <-- Sistema:    0 = AdminPAQ    1 = CONTPAQ i® Factura Electrónica

                            if lError <> 0 then
                            begin
                                fTerminaSDK();
                                wResult := PChar(fMensajeError(lError))                            
                            end
                            else
                            begin
                                try
                                    if not bEsPago then
                                    begin
                                        lError := fTimbraXML(PChar(xRutaXML),
                                            '5',
                                            lUUID,
                                            '',
                                            PChar(sRutaXMLSave),
                                            PChar(sPasswd),
                                            PChar('c:\compacw\empresas\reportes\factiracopm\plantilla_factura_cfdi_1.htm'));
                                    end
                                    else
                                    begin
                                        lError := fTimbraComplementoPagoXML(PChar(xRutaXML),
                                            '5',
                                            lUUID,
                                            '',
                                            PChar(sRutaXMLSave),
                                            PChar(sPasswd),
                                            PChar('c:\compacw\empresas\reportes\factiracopm\Plantilla_REP_1.htm'));
                                    end;

                                    if lError <> 0 then
                                        wResult := PChar(fMensajeError(lError))
                                    else
                                    begin
                                        sRutaSave := xRutaTimbre;

                                        try
                                            if FileExists(sRutaXMLSave + lUUID + '.xml') then
                                                CopyFile(PChar(sRutaXMLSave + lUUID + '.xml'), PChar(sRutaSave), True);
                                        except
                                            on e: Exception do
                                            begin
                                                wResult := e.Message;
                                            end;
                                        end;

                                        fCierraEmpresa();
                                        fTerminaSDK();

                                        wResult := '';
                                    end;
                                except
                                    on e: Exception do
                                    begin
                                        wResult := e.Message;

                                        fCierraEmpresa();
                                        fTerminaSDK();
                                    end;
                                end;
                            end;
                        end;
                    end;
                end;
            except
                on e: Exception do
                begin
                    fCierraEmpresa();
                    fTerminaSDK();

                    wResult := e.Message;
                end;
            end;
        end;
    end
    else
        wResult := 'El XML por Timbrar no existe';

    wXMLTimbrado := wResult;
end;

y así lo llamo

Código Delphi [-]
CoInitialize(nil);

TimbradoXML := TTimbrado.Create(wRuta);
wResultado := TimbradoXML.wXMLTimbrado;

Pregunta offtopic:

¿Por qué medio atiende a los clientes el servidor?...
Pregunto esto porque dependiendo de esto, es muy posible que tu servidor ya atienda las peticiones con multi-threading.


Saludos!

Threads para Timbrar Documentos
 

El servidor de escucha esta hecho por Sockets, y efectivamente utiliza hilos para escuchar las peticiones de los clientes.

Para que se den una idea adjunto el código en Delphi 2007 del servidor de escucha.

Lo primero que debes intentar es colocar el código del timbrado dentro del Execute, o hacer la llamada al procedimiento de timbrado dentro de él.
Por otro lado el Synchonize es para sincronizar partes de tu hilo con el hilo prinpical, así que cuando usas el Synchonize, el código que lo utilize pasa a ejecutarse en el hilo prinicipal.
Para que me entiendas y simplificando mucho:

• Lo que hay en Execute se ejecuta en un hilo diferente al principal (lo que quieres).
• Cuando hay algo que no se puede usar dentro de un hilo porque no es "thread-safe" (por ejemplo acceso a componentes visuales) hay que usar Synchonize. Por eso si TODO lo que hay en el Execute lo llamas con Synchonize, le estás diciendo que TODO lo ejecute en el hilo principal.

Tal como o tienes ahora, quita el método Synchonize y has la llamada directamente a pTimbrado:

Código Delphi [-]
procedure TTimbrado.Execute; 
begin     
  FreeOnTerminate := True;     
  pTimbrado; 
end;

Ahora:

(a) Si todo lo que tienes dentro del procedimiento es "Thread-safe", debería funcionar correctamente.
(b) Si hay alguna parte que no es "thread-safe" dentro del procedimiento pTimbrado, esa parte es la que deberás extraer un un segundo procedimiento y llamarla con un Synchonize.

Por ejemplo (sólo para que lo entiendas), imaginemos que estas 2 líneas no fueran "thread-safe":

Código Delphi [-]
if FileExists(sRutaXMLSave + lUUID + '.xml') then   
  CopyFile(PChar(sRutaXMLSave + lUUID + '.xml'), PChar(sRutaSave), True);

Pues las pasarías a un procedimiento:

Código Delphi [-]
procedure CopiarFichero();
begin
  if FileExists(sRutaXMLSave + lUUID + '.xml') then   
    CopyFile(PChar(sRutaXMLSave + lUUID + '.xml'), PChar(sRutaSave), True);
end;

Y en su lugar pondrías:

Código Delphi [-]
...
try  
  Synchonize(CopiarFichero)
except on e: Exception do 
  begin
    wResult := e.Message;   
  end; 
end;
...

Al realizar el Execute, se ejecutaría todo lo que hay dentro en un thread diferente en paralelo con el hilo principal de la aplicación, al llegar al punto del CopiarFichero, se para el thread y el CopiarFichero se ejecuta en el thread principal (por lo tanto en ese punto no hay paralelismo) y seguidamente el resto del código se vuelve a ejecutar en el Thread en paralelo con el principal.

En resumen, el código del thread debe estar dento del Execute y las llamadas con Synchonize deben ser las mínimas posibles y lo más pequeñas posibles dentro del Thread cuando necesitamos que algo que no es "thread-safe" y se ejecute en el hilo principal(por ejemplo como he dicho cuando mosificamos controles visuales).