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
procedure TTimbrado.Execute;
begin
inherited;
FreeOnTerminate := True;
end;
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;
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;
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;
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);
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.