Hilos: Excepcion al cerrar la aplicacion

[ecfisa]

Hola ElGatitoTapatio.

El error que estas recibiendo no se debe a la ejecución del Thread. Puede provocarlo el código invocado dentro del método EnviarDocumentos o bién otro ajeno a la unidad uHilos, códigos que en ambos casos no puedo evaluar.

Verificarlo esto es muy simple. Basta con hacerte otra unidad en la que quites todo lo foráneo a la ejecución del Thread y respetes el resto.

Por ejemplo:

Código Delphi [-]
unit Unit2;

interface

uses
  Windows,  SysUtils, Classes;

type
  TEnviarTemporales = class( TThread )
  private
    Handle : HWND;
  protected
    procedure EnviarDocumentos;
    procedure Execute; override;
  public
    constructor Create(EHandle:HWND; ThreadPriority: TThreadPriority);
  end;

implementation

uses Unit1; // en tu caso main

constructor TEnviarTemporales.Create(EHandle:HWND; ThreadPriority: TThreadPriority);
begin
  inherited Create(False);
  Handle := EHandle;
end;

procedure TEnviarTemporales.EnviarDocumentos;
var
   NetResource: TNetResource;
   vRuta,NuevaRuta : PChar;
   Error,Diagonal : String;
   ErrCode,i : integer;
   Listado,ListadoEliminar : TStrings;
begin
    Listado := TStringList.Create;
    ListadoEliminar := TStringList.Create;
    try
      { INICIO CODIGO REEMPLAZADO PARA PRUEBA }
      for i:= 1 to 50 do
      begin
        Form1.Caption := IntToStr(i); // tu caso: main.Caption := IntToStr(i);
        Sleep(20);
      end;
      { FIN CODIGO REEMPLAZADO PARA PRUEBA }
    finally
      Listado.Free;
      ListadoEliminar.Free;
    end;
end;

procedure TEnviarTemporales.Execute;
begin
  Synchronize(EnviarDocumentos);
  Terminate;
end;
end.

Y luego verás que se lo puede llamar una o n veces que no presenta ningún error durante o al cerrar la aplicacion:

Código Delphi [-]
...
implementation

uses Unit2; 

var
  HEnviarTemporales  : TEnviarTemporales;

procedure TForm1.FormDblClick(Sender: TObject);
begin
  if not Assigned(HEnviarTemporales) then
  begin
    HEnviarTemporales := TEnviarTemporales.Create(Handle, tpNormal);
    HEnviarTemporales := nil;
  end;
end;

Saludos.

[ElGatitoTapatio]

ecfisa Gracias por tu respuesta, creo me queda claro lo que me explicas, ahora mi pregunta es como puedo darme cuenta del problema especifico para corregirlo?, creo que me podria contestar solo borrando partes del codigo y ejecutando, pero creo que es una pista el que, si ejecuto los mismos procedimientos fuera del hilo corren perfectamente, solo cuando los meto al hilo es el problema.... alguna idea que se les ocurra para tomar camino por ese lado?

[[nlsgarcia]]

ElGatitoTapatio,

Empezado por ElGatitoTapatio

...Hilo a mi aplicación para realizar un proceso de copiado de archivos...el hilo se ejecuta correctamente...cuando cierro mi aplicacion me genera una excepcion...

Revisa este código:

Código Delphi [-]
constructor TEnviarTemporales.Create(EHandle:HWND; ThreadPriority: TThreadPriority);
begin
  
   inherited Create(False);

   // Establece la prioridad del hilo (tpNormal es el default).
   Priority := ThreadPriority;  

   Handle:= EHandle;

end;

procedure TEnviarTemporales.Execute;
begin

  // Indica que el hilo sera destruido de forma automática por el VCL cuando este finalize.
  FreeOnTerminate := True;

  // Verifica si el hilo se ha finalizado
  if not Terminated then
     Synchronize(EnviarDocumentos);

end;

function TEnviarTemporales.CopiarDocumentos(destino,ruta : String): Integer;
var
...
begin
...
   // Verifica si el hilo se ha finalizado
   if Not Terminated then
      Result:= ShFileOperation(F);
end;

procedure TEnviarTemporales.EnviarDocumentos;
var
...
begin
...
   for i := 0 to Listado.Count-1 do
   begin
      // Verifica si el hilo se ha finalizado
      if Terminated then Exit;
   ...
   end
...
end;

procedure Tfrm_main.FreeNewThread(Sender: TObject);
begin
   // Asegura que la instancia no tenga ninguna referencia
   HEnviarTemporales := nil;
end;

procedure Tfrm_main.EnviarTemporales;
begin
   if not Assigned(HEnviarTemporales) then
   begin

      HEnviarTemporales := TEnviarTemporales.Create(Handle, tpNormal);

      // Este procedimiento se ejecuta al finalizar el hilo
      HEnviarTemporales.OnTerminate := FreeNewThread;

   end
end;

// Si quieres finalizar el hilo en cualquie instante antes de su finalización
procedure Tfrm_main.EndNewThread;
begin
   // Envía una señal de finalización al hilo
   HEnviarTemporales.Terminate;
end

El código anterior sugiere un mecanismo de control para la finalización ordenada del hilo en función del problema planteado, sin embargo te sugiero probar lo indicado en el Msg #2 y hacer los ajustes que sean necesarios.

Espero sea útil

Nelson.

[ElGatitoTapatio]

nlsgarcia Gracias por los comentarios, de entrada me sirve para aprender mas sobre los hilos, por otra parte lo estaré probrando y les aviso.

[ElGatitoTapatio]

Bueno aqui estan mis conclusiones:

1.- Probé lo que me sugirió el compañero nlsgarcia, lamentablemente me siguió marcando error.
2.- Y pues me di a la tarea de ir comentando codigo y probando y llegué al problema, la funcion XDel. Esta funcion la estoy importando o tomando u oteniendo o como de se diga de una DLL que utilizo en mi proyecto, mi solucion fue sacar esa funcion de la dll y agregarla a la unidad del Hilo y efectivamente santo remedio.

Como no me gusta quedarme con la espinita dentro, alguien me podria explicar porque pasa esto cuando desde un hilo utilizo funciones de librerias externas? digo cosas tontas que se me ocurren es que al liberar el hilo se libere la dll o algo asi, pero ustedes son los expertos. Alguien sabe la respuesta?

Como comentario quiero decir que tambien probe utilizando mas funciones de la dll y efectivamente cuando hago esto es cuando me sucede el error.

Agrego la funcion solo como +info.

Código Delphi [-]
...
type
  TEnviarTemporales = class( TThread )
  private
    Handle : HWND;
  protected
    function  CopiarDocumentos(destino,ruta : String): Integer;
    function  XDel(From: TStrings): integer;
    procedure EnviarDocumentos;
    procedure Execute; override;
  public
    constructor Create(EHandle:HWND; ThreadPriority: TThreadPriority);
  end;

...

// ++ Elimna una lista de archivos
function TEnviarTemporales.XDel(From: TStrings): integer;
var
  FS: SHFILEOPSTRUCT;
  SFrom: string;
begin
  Result:= -1;
  if(From.Count > 0) then
  begin

    SFrom:= StringReplace(From.Text, #13+#10, #0, [rfReplaceAll]);

    ZeroMemory(@FS, sizeof(SHFILEOPSTRUCT));
    FS.wnd:= Handle;
    FS.wFunc:= FO_DELETE;
    FS.pFrom:= PCHAR(SFrom + #0);
    FS.pTo:= nil;
    FS.fFlags:= FOF_NOCONFIRMATION;

    Result:= SHFileOperation(FS);
  end;
end;

Y les agradeszo nuevamente por su valiosa ayuda!

[ecfisa]

Empezado por ElGatitoTapatio

pero creo que es una pista el que, si ejecuto los mismos procedimientos fuera del hilo corren perfectamente, solo cuando los meto al hilo es el problema.... alguna idea que se les ocurra para tomar camino por ese lado?

Realmente lamento no poder probar en este momento el resto del código. Si el problema no está en el hilo ni en los procedimientos que has probado por separado, no se...

Aunque no pareciera ser el causante del problema, y por las dudas, probá de este modo para asergurarte que WNetCancelConnection2 se ejecute:

Código Delphi [-]
procedure TEnviarTemporales.EnviarDocumentos;
var
   NetResource: TNetResource;
   vRuta,NuevaRuta : PChar;
   Error,Diagonal : String;
   ErrCode,i : integer;
   Listado,ListadoEliminar : TStrings;
begin
  with ServidorAlmacenamiento,frm_main do
  begin
    Listado:= TStringList.Create;
    ListadoEliminar:= TStringList.Create;
    if not Activo then Exit;
    // ++ Buscar si hay documentos temporales
    ArchivosdeRuta(AlmacenamientoTemporal,Listado);
    // Si esto ocurre, es decir, si no hubo archivos entonces se sale
    //y por ende termina el hilo y no ocurre el error, el problema es cuando continua
    if Listado.Count = 0 then Exit;
    StatusBar.Panels.Items[2].Text:= 'Transfiriendo documentos temporales...';
    vRuta:= PChar(Ruta);
    NetResource.dwType := RESOURCETYPE_DISK;
    NetResource.lpLocalName := nil;
    NetResource.lpRemoteName := vRuta;
    NetResource.lpProvider := nil;
    // ++ Si el almacenamiento no es el temporal
    if not Local and not Abierto then
    begin
      try // (1) Conectar el acceso
        if (Usuario = '') then
          ErrCode := WNetAddConnection2(NetResource, nil, nil, CONNECT_TEMPORARY)
        else
          ErrCode := WNetAddConnection2(NetResource, PChar(Pass), PChar(Usuario), CONNECT_TEMPORARY);

        case ErrCode of
             5 : Error:= 'ERROR_ACCESS_DENIED';
            85 : Error:= 'ERROR_ALREADY_ASSIGNED';
            67 : Error:= 'ERROR_BAD_NET_NAME';
            86 : Error:= 'ERROR_INVALID_PASSWORD';
          1203 : Error:= 'ERROR_NO_NET_OR_BAD_PATH';
          1222 : Error:= 'ERROR_NO_NETWORK';
          else Error:= IntToStr(ErrCode);
        end;

        if ErrCode <> 0 then
        begin
          Mensaje(3,-1,'','Error al conectar al servidor de almacenamiento. ('+Error+')');
          hLog('Error al conectar al servidor de almacenamiento. ('+Error+')');
        end;
//**********    end;  (Línea anulada)

        // ++ Intentar copiar los archivos
        try
          if AlmacenamientoTemporal[Length(AlmacenamientoTemporal)] <> '\' then
            Diagonal := ''      // Almacenamiento temporal contiene la ruta local de los archivos
          else
            Diagonal:= '\';
          for i := 0 to Listado.Count-1 do
          begin
            NuevaRuta:= PChar(vRuta+AnsiReplaceStr(Listado[i],frm_main.AlmacenamientoTemporal,Diagonal));;
            // ++ Verificar si existe el archivo y respaldar version actual
            if FileExists(NuevaRuta) then
            begin
              ErrCode:= CopiarDocumentos(NuevaRuta,AnsiReplaceStr(NuevaRuta,ExtractFileExt(NuevaRuta),
              FormatDateTime('_ddmmy  yyy_hhnnss',Now)+ExtractFileExt(NuevaRuta)));
              if ErrCode <> 0 then hLog('No se pudo respaldar la version del archivo. ('+NuevaRuta+
                ')('+IntToStr(ErrCode)+')');
            end;
            // ++ Copiar los documentos
            ErrCode:= CopiarDocumentos(PChar(Listado[i]),NuevaRuta);
            if ErrCode <> 0 then
              hLog('No se pudo transferir el archivo al servidor de almacenamiento. ('+NuevaRuta+
                ')('+IntToStr(ErrCode)+')')
            else
            begin
              if DBConectada then
                RegistrarActividad(26,-1,GetPCName,MidStr(ExtractFileName(NuevaRuta),1,30));
              ListadoEliminar.Add(Listado[i]);
            end;
          end;

          // ++ Eliminar archivos copiados
          XDel(Handle,ListadoEliminar);
          StatusBar.Panels.Items[2].Text:= '';
        except
          on E: Exception do
          begin
            StatusBar.Panels.Items[2].Text:= '';
            hLog('Error al transferir los documentos al servidor de almacenamiento.('+E.Message+')');
          end;
        end;

//*******      if not Local and not Abierto then (Linea anulada)
      // (*) Desconectar el acceso
      finally
        ErrCode := WNetCancelConnection2(vRuta, CONNECT_UPDATE_PROFILE, True);
        Listado.Free;
        ListadoEliminar.Free;
      end;
    end;
end;

Saludos.