[ludan508]

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.