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

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 10-05-2011
WPascal WPascal is offline
Miembro
 
Registrado: Oct 2010
Posts: 26
Poder: 0
WPascal Va por buen camino
Problema al eliminar un archivo con funcion Deletefile

Hola, Estoy haciendo una aplicacion que busque los archivos y carpetas ocultas en la raiz de un disco y los desoculte, hasta ahi no tengo problema, pero también el programa debe borrar los accesos directos que encuentre, aqui es donde me está dando problema, lo estoy haciendo con la función deleteFile, pero no borra nada. Entonces quisiera que me ayudaran en que me estoy equivocando. En el form tengo un DriverComboBox1 con Name=disco y un button1.

El codigo es el siguente:

Código Delphi [-]
 
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, StrUtils;
type
  TFPrincipal = class(TForm)
    Button1: TButton;
    Disco: TDriveComboBox;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FPrincipal: TFPrincipal;
implementation
{$R *.dfm}
procedure listar1( sDirectorio: string; var Resultado1: TStringList );
var
  Busqueda: TSearchRec;
  iResultado: Integer;
begin
    iResultado :=  FindFirst( sDirectorio+':\'+'*.*', faAnyFile, Busqueda );
  while iResultado = 0 do
  begin
    if (busqueda.Attr=FaDirectory+FaHidden) or (busqueda.Attr=FaHidden) then{  (busqueda.Attr=FaDirectory) }
      begin
        Resultado1.Add(busqueda.Name);
      end;
      iResultado := FindNext( Busqueda );
  end;
  FindClose( Busqueda );
end;
procedure listar2( sDirectorio: string; var Resultado2: TStringList );
var
  Busqueda: TSearchRec;
  iResultado: Integer;
begin
  iResultado :=  FindFirst( sDirectorio+':\'+ '*.lnk', faArchive, Busqueda );
  while iResultado = 0 do
  begin
    if busqueda.Attr=faArchive  then
    begin
      Resultado2.Add(busqueda.Name);
    end;
    iResultado := FindNext( Busqueda );
  end;
  FindClose( Busqueda );
end;

procedure TFPrincipal.Button1Click(Sender: TObject);
var
a,b:Tstringlist;
i:integer; Unidad,x:String; Eli:Boolean;
begin
  Unidad:=Disco.Drive; //por ejemplo C
  a:=TstringList.Create; b:=TStringList.Create;
  listar1(Unidad,a); //en a:stringlist guardo los archivos y carpetas ocultos encontrados
  ShowMessage(a.Text);
  listar2(Unidad,b); //en b:stringlist guardo los archivos que sean .lnk
  ShowMessage(b.text);

  try
  for i:=0 to a.InstanceSize-1 do
  begin
    x:=Unidad+':\'+a[i];
    SetFileAttributes (PChar(x), FILE_ATTRIBUTE_NORMAL)
  end;
  for i:=1 to b.InstanceSize-1 do
  begin
    deleteFile(PChar(Unidad+':\'+b[i]));  //aqui es donde intento borrar los archivos .lnk
  end;
  except
    ShowMessage('listo!');
  end;
end;
end.
De antemano gracias por su ayuda.

Última edición por WPascal fecha: 10-05-2011 a las 14:32:46.
Responder Con Cita
  #2  
Antiguo 10-05-2011
Avatar de Ñuño Martínez
Ñuño Martínez Ñuño Martínez is offline
Moderador
 
Registrado: Jul 2006
Ubicación: Ciudad Catedral, Españistán
Posts: 5.704
Poder: 18
Ñuño Martínez Va camino a la famaÑuño Martínez Va camino a la fama
Lo de los enlaces no lo sé, la verdad, siempre ha sido muy confuso para mi, pero tengo que decirte que hay un error gordísimo en tu código, ¡y es que no destruyes los TStringList! Recuerda que Pascal no tiene colector de basuras, así que cada vez que ejecutes ese método te quitará un poco de memoria que nunca recuperarás hasta que no cierres el programa.
__________________
Proyectos actuales --> Allegro 5 Pascal ¡y Delphi!|MinGRo Game Engine
Responder Con Cita
  #3  
Antiguo 10-05-2011
WPascal WPascal is offline
Miembro
 
Registrado: Oct 2010
Posts: 26
Poder: 0
WPascal Va por buen camino
Cita:
Empezado por Ñuño Martínez Ver Mensaje
Lo de los enlaces no lo sé, la verdad, siempre ha sido muy confuso para mi, pero tengo que decirte que hay un error gordísimo en tu código, ¡y es que no destruyes los TStringList! Recuerda que Pascal no tiene colector de basuras, así que cada vez que ejecutes ese método te quitará un poco de memoria que nunca recuperarás hasta que no cierres el programa.
Hola,gracias por la respuesta, ya incluí la liberacion del los dos stringlist, pero aun no me funciona quedaría:

.
.
.
Código Delphi [-]
try
  for i:=0 to a.InstanceSize-1 do
  begin
    x:=Unidad+':\'+a[i];
    SetFileAttributes (PChar(x), FILE_ATTRIBUTE_NORMAL)
  end;
  for i:=0 to b.Count-1 do
  begin
    deleteFile(PChar(Unidad+':\'+b.strings[i]));
  end;
  except
    ShowMessage('listo!');
  end;
  a.Free; b.Free;   //Aqui libero los SL
end;
end.

Última edición por WPascal fecha: 10-05-2011 a las 16:29:20.
Responder Con Cita
  #4  
Antiguo 10-05-2011
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: Dec 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.040
Poder: 29
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 behold
Hola WPascal.

Probá de esta manera:
Código Delphi [-]
(* Descubre archivos, carpetas ocultos y elimina archivos .LNK. Devuelve nombres en TS *)
procedure MuestraYSacaLNK(const Ruta: string; TS: TStrings);
var
  SR: TSearchRec;
begin
  if FindFirst(Ruta+'*.*', $FF, SR) = 0 then
  begin
    repeat
      SetFileAttributes(PChar(SR.Name), FILE_ATTRIBUTE_NORMAL);
      if UpperCase(ExtractFileExt(SR.Name)) = '.LNK' then
        DeleteFile(Ruta + SR.Name)
      else if(SR.Name <> '.')and(SR.Name<>'..') then
        TS.Add(SR.Name)
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;

Llamada:
Código Delphi [-]
begin
  Memo1.Clear;
  MuestraYSacaLNK('C:\TU_RUTA\', Memo1.Lines);
end;

Saludos.
__________________
Daniel Didriksen

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

Última edición por ecfisa fecha: 10-05-2011 a las 16:59:38.
Responder Con Cita
  #5  
Antiguo 10-05-2011
WPascal WPascal is offline
Miembro
 
Registrado: Oct 2010
Posts: 26
Poder: 0
WPascal Va por buen camino
Cita:
Empezado por ecfisa Ver Mensaje
Hola WPascal.

Probá de esta manera:

Código Delphi [-]
(* Descubre archivos, carpetas ocultos y elimina archivos .LNK. Devuelve nombres en TS *)
procedure MuestraYSacaLNK(const Ruta: string; TS: TStrings);
var
SR: TSearchRec;
begin


Saludos.
ok, ya pruebo, saludos
Responder Con Cita
  #6  
Antiguo 10-05-2011
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: Dec 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.040
Poder: 29
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 behold
Me olvidaba... Si necesitas que el resultado resida en un TStringList, sería:
Código Delphi [-]
var
  TStr: TStrings;
begin
  TStr:= TStringList.Create;
  try
    MuestraYSacaLNK('C:\TEMPORAL\',TStr);
    // Operaciones que desees
    //...
  finally
    TStr.Free;
  end;

Saludos.
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita
  #7  
Antiguo 10-05-2011
WPascal WPascal is offline
Miembro
 
Registrado: Oct 2010
Posts: 26
Poder: 0
WPascal Va por buen camino
Hola Ecfisa, cogí una parte del código que me recomendaste y lo metí en el segundo procedure listar2 y ya me resultó.
El codigo quedó así:

Código Delphi [-]
 
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, StrUtils;
type
  TFPrincipal = class(TForm)
    Button1: TButton;
    Disco: TDriveComboBox;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FPrincipal: TFPrincipal;
implementation
{$R *.dfm}
procedure listar1( sDirectorio: string; var Resultado1: TStringList );
//hay que especificar el directorio y crear el stringlist
var
  Busqueda: TSearchRec;
  iResultado: Integer;
begin
  iResultado :=  FindFirst( sDirectorio+':\'+'*.*', faAnyFile, Busqueda );
  while iResultado = 0 do
  begin
    if (busqueda.Attr=FaDirectory+FaHidden) or (busqueda.Attr=FaHidden) then{  (busqueda.Attr=FaDirectory) }
      begin
        Resultado1.Add(busqueda.Name);
      end;
      iResultado := FindNext( Busqueda );
  end;
  FindClose( Busqueda );
end;
procedure listar2( sDirectorio: string; var Resultado2: TStringList );
var
  Busqueda: TSearchRec;
  iResultado: Integer;
begin
  iResultado :=  FindFirst( sDirectorio+':\'+ '*.lnk', faArchive, Busqueda );
  while iResultado = 0 do
  begin
    if busqueda.Attr=faArchive  then
    begin
      if UpperCase(ExtractFileExt(Busqueda.name)) = '.LNK' then
      DeleteFile(sDirectorio+':\' + Busqueda.Name)
    end;
    iResultado := FindNext( Busqueda );
  end;
  FindClose( Busqueda);
end;

procedure TFPrincipal.Button1Click(Sender: TObject);
var
a,b:Tstringlist;
i:integer; Unidad,x:String; Eli:Boolean;
begin
  Unidad:=Disco.Drive;
  a:=TstringList.Create; b:=TStringList.Create;
  listar1(Unidad,a);
  listar2(Unidad,b);

  try
  for i:=0 to a.InstanceSize-1 do
  begin
    x:=Unidad+':\'+a[i];
    SetFileAttributes (PChar(x), FILE_ATTRIBUTE_NORMAL)
  end;
  except
    ShowMessage('listo!');
  end;
  a.Free; b.Free;
end;
end.

La verdad es que me salió de suerte pues apenas estoy empezando a aprender el manejo de archivos.
Gracias nuevamente Ecfisa por tus efectivas soluciones.
Saludos y que estés bien.
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
Problema con deletefile y delphi2009 PaCmAn72 API de Windows 3 31-08-2010 11:23:09
problemas con deletefile sargento elias Conexión con bases de datos 2 20-05-2008 17:56:34
eliminar extencion de un archivo... Greco Varios 2 14-11-2007 22:32:36
DeleteFile en API y Delphi onlytk API de Windows 2 20-12-2005 14:36:04
Eliminar registros de un archivo xml jgutti Varios 0 25-05-2004 22:51:38


La franja horaria es GMT +2. Ahora son las 17:09:22.


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