Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Problema al eliminar un archivo con funcion Deletefile (https://www.clubdelphi.com/foros/showthread.php?t=73689)

WPascal 10-05-2011 14:28:03

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.

Ñuño Martínez 10-05-2011 15:43:55

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.

WPascal 10-05-2011 16:20:40

Cita:

Empezado por Ñuño Martínez (Mensaje 399548)
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.

ecfisa 10-05-2011 16:56:34

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.

WPascal 10-05-2011 17:01:22

Cita:

Empezado por ecfisa (Mensaje 399560)
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

ecfisa 10-05-2011 17:06:08

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.

WPascal 10-05-2011 17:41:00

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.


La franja horaria es GMT +2. Ahora son las 03:28:24.

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