Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 31-05-2013
ElGatitoTapatio ElGatitoTapatio is offline
Miembro
 
Registrado: nov 2006
Posts: 38
Poder: 0
ElGatitoTapatio Va por buen camino
Hilos: Excepcion al cerrar la aplicacion

Buen día para todos, llevo 2 días tratando de agregar un Hilo a mi aplicacion para realizar un proceso de copiado de archivos. Me explico un poco, estoy desarrollando un sistema el cual tenga la posibilidad de enviar a un servidor archivos que fueron grabados de forma local y temporal en el equipo. Este proceso quiero que se ejecute sin que mi aplicacion se detenga a que termine el proceso, por lo tanto lo metí a un hilo. El problema es el siguiente, el hilo se ejecuta correctamente, es decir, si copia los archivos si es que existen, pero cuando cierro mi aplicacion me genera una excepcion de memoria (Access Violation). La verdad es que no tengo experiencia con hilos, en realidad es mi primer hilo, por lo tanto pido de su ayuda para localizar mi ERROR. Les anexo mi codigo. (cabe señalar que la excepcion solo ocurre cuando si encontro y copio los archivos)

Unidad donde declaro el hilo:

Código Delphi [-]
unit uHilos;

interface

uses
  Classes, ExtCtrls, Windows, ComCtrls, System.SysUtils, StrUtils, ShellApi;

type
  TEnviarTemporales = class( TThread )
  private
    Handle : HWND;
  protected
    function  CopiarDocumentos(destino,ruta : String): Integer;
    procedure EnviarDocumentos;
    procedure Execute; override;
  public
    constructor Create(EHandle:HWND; ThreadPriority: TThreadPriority);
  end;

implementation

uses main;

function TEnviarTemporales.CopiarDocumentos(destino,ruta : String): Integer;
var
    F : TShFileOpStruct;
    sOrigen, sDestino : String;
begin
    Result := 0;
    sOrigen := destino+ #0;
    sDestino := ruta+ #0;

    with F do
    begin
      Wnd   := Handle;
      wFunc := FO_COPY;
      pFrom := @sOrigen[1];
      pTo   := @sDestino[1];
      fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SIMPLEPROGRESS or FOF_NOERRORUI;
    end;

    Result:= ShFileOperation(F);
end;


procedure TEnviarTemporales.EnviarDocumentos;
var
   NetResource: TNetResource;
   vRuta,NuevaRuta : PChar;
   Error,Diagonal : String;
   ErrCode,i : integer;
   Listado,ListadoEliminar : TStrings;
begin
   with ServidorAlmacenamiento,frm_main do   // ServidorAlmacenamiento es una variable de tipo registro donde guardo info del servidor asi mismo si esta o no activa
    begin
       Listado:= TStringList.Create;
       ListadoEliminar:= TStringList.Create;
       if not Activo then Exit;

       // ++ Buscar si hay documentos temporales
       ArchivosdeRuta(AlmacenamientoTemporal,Listado);    // Funcion para regresar los archivos que se encontraron y los guarda en la variable Listado
       if Listado.Count = 0 then Exit;     // 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 

       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
           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;
       // ++ 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;
       // ++ Desconectar el acceso
       if not Local and not Abierto then
        ErrCode := WNetCancelConnection2(vRuta, CONNECT_UPDATE_PROFILE, True);
       Listado.Free;
       ListadoEliminar.Free;
    end;
end;

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

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

end.

Y esto es lo que tengo declarado en el formulario principal:

Código Delphi [-]
Var
  HEnviarTemporales  : TEnviarTemporales; // Hilo para el envio de temporales

...

procedure Tfrm_main.FormDblClick(Sender: TObject);
begin
  EnviarTemporales;
end;

...
procedure Tfrm_main.EnviarTemporales;
begin
  HEnviarTemporales:= TEnviarTemporales.Create(Handle, tpNormal);
  //HEnviarTemporales.FreeOnTerminate:= True;
end;

Como podrán ver hago la prueba de la ejecucion del hilo cuando doy doble clic a la forma.

ustedes siempre me sacan de broncas, por favor ayudenme nuevamente!!! ya me comienza a doler el coco...

Gracias y saludos!!!
Responder Con Cita
  #2  
Antiguo 01-06-2013
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Poder: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
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.
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....

Última edición por ecfisa fecha: 01-06-2013 a las 00:40:41.
Responder Con Cita
  #3  
Antiguo 01-06-2013
ElGatitoTapatio ElGatitoTapatio is offline
Miembro
 
Registrado: nov 2006
Posts: 38
Poder: 0
ElGatitoTapatio Va por buen camino
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?
Responder Con Cita
  #4  
Antiguo 01-06-2013
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
ElGatitoTapatio,

Cita:
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.

Última edición por nlsgarcia fecha: 01-06-2013 a las 01:29:45.
Responder Con Cita
  #5  
Antiguo 01-06-2013
ElGatitoTapatio ElGatitoTapatio is offline
Miembro
 
Registrado: nov 2006
Posts: 38
Poder: 0
ElGatitoTapatio Va por buen camino
nlsgarcia Gracias por los comentarios, de entrada me sirve para aprender mas sobre los hilos, por otra parte lo estaré probrando y les aviso.
Responder Con Cita
  #6  
Antiguo 01-06-2013
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Poder: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Cita:
Empezado por ElGatitoTapatio Ver Mensaje
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.
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita
  #7  
Antiguo 01-06-2013
ElGatitoTapatio ElGatitoTapatio is offline
Miembro
 
Registrado: nov 2006
Posts: 38
Poder: 0
ElGatitoTapatio Va por buen camino
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!
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Aplicacion Delphi lanza Excepcion 0x0eedfade Sieg Varios 4 29-07-2010 15:10:21
Cómo cerrar otra aplicacion desde mi aplicacion en Delphi 7 Gaby123 API de Windows 5 04-01-2007 23:44:51
Aplicacion con varios Hilos de Ejecución samantha jones Varios 1 02-03-2005 18:27:24
Cerrar Aplicacion Nathan API de Windows 3 22-03-2004 20:03:43


La franja horaria es GMT +2. Ahora son las 15:32:02.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi