Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2005.11.06;
Скачать: [xml.tar.bz2];

Вниз

file *.*   Найти похожие ветки 

 
LeonW ©   (2005-09-28 05:28) [0]

Привет! как дела? а можно ли сделать так - что бы программа искала на пример все файля *.txt или *.bmp и удаляла их????
приэтом стоит два винчестера.
посибо  с уважением Leon


 
dmitry501 ©   (2005-09-28 05:42) [1]

LeonW ©   (28.09.05 5:28)
Привет! дела хреново.
Можно. Используй функции FindFirst, FindNext, FindClose Они работают при любом количестве винчестеров.


 
Федор   (2005-09-28 08:30) [2]

procedure SearchInDir(Mask, Dir: string; Subdir: Boolean; var List: StringList);
var
 r: integer;
 f: TSearchRec;
begin
 if Dir = "" then Exit;
 if Dir[Length(Dir)] <> "\" then Dir := Dir + "\";
{$I-}
 ChDir(Dir);
{$I+}
 if IOResult <> 0 then Exit;
 r := FindFirst("*.*", faAnyFile, f);
 while r = 0 do
 begin
   if MatchesMask(f.Name, Mask) then
     if (f.Name <> ".") and (f.Name <> "..") then
       List.Add(ExpandFileName(f.Name));
   if (f.Attr and faDirectory) = faDirectory then
     if SubDir = True then
     begin
       if (f.Name <> ".") and (f.Name <> "..") then
       begin
         SearchInDir(Mask, ExpandFileName(f.Name), SubDir, List);
         ChDir(Dir);
       end;
     end;
   r := FindNext(f);
 end;
 FindClose(f);
end;


 
Федор   (2005-09-28 08:33) [3]

В uses еще  добавь   Masks


 
BFG9k ©   (2005-09-28 13:57) [4]

1996 год - 9 лет. Охуеть (да простит меня модератор)!


 
Grief ©   (2005-09-28 14:01) [5]

...offtopic...А че такого? Щас вон все в кодинг лезут, даже дед одного моего знакомого клепает какую то игрушку...offtopic...


 
jack128 ©   (2005-09-28 14:54) [6]

Grief ©   (28.09.05 14:01) [5]
даже дед одного моего знакомого клепает какую то игрушку

Если твой знакомый - внук app, так Анатолий уже очень давно дописал ту игрушку ;)

По теме

type
 TIterateFileProc = procedure (const Filename: string;
   const FFD: TWin32FindData; var Continue: boolean) of object;

function IterateFiles(StartDir: string; FileMask: string;
 Callback: TIterateFileProc; Recurse: boolean = True): boolean;
var
 ffd: TWIN32FindData;
 ffh: THandle;
begin
 Assert(Assigned(Callback));
 if StartDir = "" then
   raise Exception.Create("Введите директорию");
 Result := True;
 if StartDir[Length(StartDir)] <> "\" then
   StartDir := StartDir + "\";
 ffh := FindFirstFile(PChar(StartDir + FileMask), ffd);
 if ffh <> INVALID_HANDLE_VALUE then
   try
     repeat
       if not ((string(ffd.cFileName) = ".") or (string(ffd.cFileName) = "..")) then
       begin
         Callback(StartDir + ffd.cFileName, ffd, Result);
         if not Result then Exit;
         if Recurse and ((ffd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) then
         begin
           Result := IterateFiles(StartDir + ffd.cFileName, FileMask, Callback);
           if not Result then Exit;
         end;
       end;
     until not FindNextFile(ffh, ffd);
   finally
     Windows.FindClose(ffh);
   end;
end;

procedure DeleteFileProc(Data: TObject; const Filename: string;
   const FFD: TWin32FindData; var Continue: boolean);
begin
 DeleteFile(PChar(FileName));
end;

procedure RemoveAllFiles(AMask: string);
var
 Buf: array [0..1023] of char;
 P: PChar;
 Callback: TMethod;
begin
 if GetLogicalDriveStrings(SizeOf(Buf), @Buf) > 0 then
 begin
   P := @Buf[0] ;
   Callback.Data := nil;
   Callback.Code := @DeleteFileProc;
   while P^ <> #0 do
   begin
     IterateFiles(string(P), AMask, TIterateFileProc(Callback), True);
     P := P + StrLen(P) + 1;
   end;
 end;
end;


Пример:
 RemoveAllFiles("*.txt");

ps код не тестил, так что если вдруг он тебе отформатирует винты, не обессуть ;)


 
Германн ©   (2005-09-28 15:23) [7]

2 BFG9k ©   (28.09.05 13:57) [4]

Образование -среднее. :)


 
Grief ©   (2005-09-28 16:09) [8]

2jack128 - конечно нет, я понятия не имею, о ком идет речь...


 
LeonW ©   (2005-09-28 23:33) [9]

Привет! посибо всем!
я только начинаю учить delphi - и поэтому не все всегда понятно.
и большое спосибо!
если вам понадобится помощь пишите сюда или на емаил,
я всегда буду рад помочь!!!!!! (чем смогу)


 
leonw ©   (2005-09-29 01:40) [10]

Федор - var List: StringList - заменил на list: TStrings.
т.к показывала ошибку.
но вот одно не могу понять -    if MatchesMask(f.Name, Mask) then.
посибо Leon


 
leonw ©   (2005-09-29 02:06) [11]

MatchesMask поменял на deletefile, а с mask - что делать? удалять?


 
Adder ©   (2005-09-29 04:11) [12]


> MatchesMask поменял на deletefile>  удалять?

Не делай так больше

Перевожу:
if MatchesMask(f.Name, Mask) then
//Если имя найденного файла соответствует маске (mask, например для всех текстовых файлов  mask="*.txt"), то
    if (f.Name <> ".") and (f.Name <> "..") then
// Если имя файла не "." и не ".." (не каталог)
      List.Add(ExpandFileName(f.Name));
// добавляем имя файла в список List


> Федор - var List: StringList - заменил на list: TStrings.
>
> т.к показывала ошибку.

Так тоже не делай -)
Ошибку показывала, потому что у Федора опечатка
procedure SearchInDir(Mask, Dir: string; Subdir: Boolean; var List: TStringList);


 
Adder ©   (2005-09-29 04:22) [13]

Код, который привел Федор, ищет файлы, но не удаляет их, а заносит в список List -)
Когда отладишь код (без удаления файлов),   List.Add можешь заменить на DeleteFile, а
procedure SearchInDir(Mask, Dir: string; Subdir: Boolean; var List: TStringList);
заменить на
procedure SearchInDir(Mask, Dir: string; Subdir: Boolean);


 
Adder ©   (2005-09-29 04:33) [14]


> jack128 ©   (28.09.05 14:54) [6]

//Offtopic
Он себе и без нашей  помощи винты "отформатирует"...случайно %-/
Прячьте спички от детей, не давайте готового кода...особенно без комментариев... они его так переделают....


 
LeonW ©   (2005-09-29 06:50) [15]


> DeleteFile

Привет! спасибо что помогаешь! вот что у меня получилось!
осталось сделать старт???? для SearchInDir
procedure SearchInDir(Mask, Dir: string; Subdir: Boolean);
          var
r: integer;
f: TSearchRec;
begin
if Dir = "" then Exit;
if Dir[Length(Dir)] <> "\" then Dir := Dir + "\";
{$I-}
ChDir(Dir);
{$I+}
if IOResult <> 0 then Exit;
r := FindFirst("*.fdk", faAnyFile, f);
while r = 1 do
begin
  if MatchesMask(f.Name, Mask) then
    if (f.Name <> ".") and (f.Name <> "..") then
     DeleteFile(ExpandFileName(f.Name));

  if (f.Attr and faDirectory) = faDirectory then
    if SubDir = True then
    begin
      if (f.Name <> ".") and (f.Name <> "..") then
      begin
SearchInDir(Mask, ExpandFileName(f.Name), SubDir);
        ChDir(Dir);
      end;
    end;
  r := FindNext(f);
end;
FindClose(f);
end;


 
leonw ©   (2005-09-29 06:52) [16]

а для чего нужен ExpandFileName???


 
leonw ©   (2005-09-29 07:21) [17]

procedure TForm1.Button1Click(Sender: TObject);
begin
deletefile(f.name);

end;


 
leonw ©   (2005-09-29 17:01) [18]

как я понил если r=0 то ищем дальше если нет то вылетаем?
таперь отсается сделать запуск.
Memo1.Lines.Add (SearchInDir); - но выдает ошибку????


 
leonw ©   (2005-09-29 17:06) [19]

также как -
SearchInDir;
SearchInDir( "*.txt", memo1.Lines, true);


 
Anatoly Podgoretsky ©   (2005-09-29 19:14) [20]

LeonW ©   (28.09.05 05:28)  
Запуск с административными правами - имеем порушеную Виндоус и многие программы, а также обиженных ползователей. Тут уже не далеко или до уволнения или до обращения к зубному протезисту.


 
Grief ©   (2005-09-29 19:22) [21]

Как пить дать начинающий вирусописец! Причем с вашей помощью вирусописец <_<


 
Fay ©   (2005-09-29 20:04) [22]

2 Adder ©   (29.09.05 4:11) [12]
>> // Если имя файла не "." и не ".." (не каталог)
Какой-то странный перевод...
Да и сама проверка (if (f.Name <> ".") and (f.Name <> "..") then) довольно странная...


 
Adder ©   (2005-09-29 22:07) [23]


> Fay ©   (29.09.05 20:04) [22]
> 2 Adder ©   (29.09.05 4:11) [12]

Согласна. Перевод слишком краткий.
Правильнее было написать не просто "каталог", а  "текущий каталог" и " вышележащий каталог " (или - "каталог на один уровень выше").


 
Alexander Panov ©   (2005-09-29 22:53) [24]

//Поиск файлов в каталоге и его покаталогах с фильтром по маске и исключением
//из поиска всех файлов, атрибуты которых попадают в aExcludeAttr

procedure GetFiles(const aPath,aMask: String;var aListFile: TStringList;const aExcludeAttr: Integer=0);
var
 SR: TSearchRec;
 tPath: String;
begin
{$WARN SYMBOL_PLATFORM OFF}
 tPath := IncludeTrailingBackSlash(aPath);
 if FindFirst(tPath+"*.*",faAnyFile,SR)=0 then
 begin
   try
     repeat
       if (SR.Name=".") or (SR.Name="..") then Continue;
       if (SR.Attr and faDirectory)<>0 then GetFiles(tPath+SR.Name,aMask,aListFile,aExcludeAttr);
       if (aExcludeAttr<>0) and (SR.Attr and aExcludeAttr <> 0) then Continue;
       if MatchesMask(SR.Name,aMask) then aListFile.Add(tPath+SR.Name);
     until FindNext(SR)<>0;
   finally
     Sysutils.FindClose(SR);
   end;
 end;
{$WARN SYMBOL_PLATFORM ON}
end;


 
leonw ©   (2005-09-30 02:03) [25]

Привет всем! вирус я не собераюсь деалать.
хотя признаюсь = что просмотрел много исходников, как троянов
- так и червей.


 
leonw ©   (2005-09-30 02:06) [26]

Anatoly Podgoretsky - только я не понил - какое увальнение и зубной врчь? :))))))))


 
leonw ©   (2005-09-30 02:11) [27]

<h1>моя первая программа  - это был текстовый блокнот!</h1>


 
leonw ©   (2005-09-30 02:13) [28]

закачаю ее на сайт = потом дам ссылку - может понравится?


 
leonw ©   (2005-09-30 02:53) [29]

Alexander Panov = вот это хакер, программист! всего в пару строчек!!!!


 
leonw ©   (2005-09-30 03:42) [30]

Alexander Panov - а как запустить?
и показывала в memo  и ProgressBar1???? результат?


 
M,Fowler   (2005-09-30 10:56) [31]

Alexander Panov ©   (29.09.05 22:53) [24]

Сократим код в [24] до

procedure GetFiles (const RootPath, Mask: string; FileList: TStrings;
 const ExcludeAttr: Integer = 0);
var
 SR: TSearchRec;
 Path: string;
begin
{$WARN SYMBOL_PLATFORM OFF}
 Path := IncludeTrailingBackSlash(RootPath);
{$WARN SYMBOL_PLATFORM ON}
 if FindFirst(Path+"*.*",faAnyFile,SR)=0 then
   try
     repeat
       if ((SR.Attr and faDirectory) <> 0) and (SR.Name <> ".") and (SR.Name <> "..") then
         GetFiles(Path+SR.Name,Mask,FileList,ExcludeAttr)
       else if ((SR.Attr and ExcludeAttr) = 0) and MatchesMask(SR.Name,Mask) then
         FileList.Add(Path+SR.Name);
     until FindNext(SR)<>0;
   finally
     Sysutils.FindClose(SR);
   end;
end;


 
GuAV ©   (2005-09-30 12:04) [32]


> var aListFile: TStringList

Лучше так
aListFile: TStrings


 
Adder ©   (2005-09-30 13:33) [33]


> GuAV ©   (30.09.05 12:04) [32]

Лучше-то оно лучше. Но тогда придется старательно разжевать, почему нельзя делать что-то вроде этого:
procedure TForm1.Button1Click(Sender: TObject);
var
L:Tstrings;
begin
L:=TStrings.Create;
GetFiles("D:\tmp","*.jpg",L);
.................

Не сомневаюсь, что такая попытка будет -)


 
Alexander Panov ©   (2005-09-30 14:10) [34]

>M,Fowler   (30.09.05 10:56) [31]

Исправления привели лишь к ухудшению читабельности кода без выигрыша в чем-либо другом.


 
begin...end ©   (2005-09-30 14:18) [35]

> Alexander Panov ©   (29.09.05 22:53) [24]
> var aListFile: TStringList

А зачем var, можно пояснить?


 
Alexander Panov ©   (2005-09-30 14:35) [36]


> А зачем var, можно пояснить?


Опечатка.


 
leonw ©   (2005-09-30 21:57) [37]

Привет всем! вот ссылка http://www.leonw.hotmail.ru/
там кнопка! и текстовый самодельный блокнот!!!
-честно что то я совсе запутался. Alexander Panov - написал код.
только при запуске ничего не происходит? ни поиска ни другого движения?


 
leonw ©   (2005-09-30 22:04) [38]

без дитонатора.. :))))


 
leonw ©   (2005-09-30 23:16) [39]

Abstract error- постоянно вылазиет?????


 
leonw ©   (2005-10-01 03:28) [40]

ну вот с пустя несколько дней хоть что то! теперь программам удаляет файлы! но есть проблема - она их удаляет в указанном катологе! а как сделть чтобы она их еще и искала????
-----------------------------
procedure FindFiles(StartFolder, Mask: String; List: TStrings;
ScanSubFolders: Boolean = True);
var
SearchRec: TSearchRec;
FindResult: Integer;
begin
List.BeginUpdate;
try
StartFolder:=IncludeTrailingBackslash(StartFolder);
FindResult:=FindFirst(StartFolder+"*.*", faAnyFile, SearchRec);
try
while FindResult = 0 do with SearchRec do begin
if (Attr and faDirectory)<>0 then begin
if ScanSubFolders and (Name=".") and (Name="..") then
FindFiles(StartFolder+Name, Mask, List, ScanSubFolders);
end else begin
if MatchesMask(Name, Mask) then
List.Add(StartFolder+Name);
deletefile(StartFolder+Name);
end;
FindResult:=FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
finally
List.EndUpdate;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
FindFiles("C:\1\", "*.txt", memo1.Lines, true);

end;



Страницы: 1 2 вся ветка

Форум: "Начинающим";
Текущий архив: 2005.11.06;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.56 MB
Время: 0.037 c
14-1129056541
Kerk
2005-10-11 22:49
2005.11.06
Поставил себе ярко красный wallpaper...


14-1129567066
ArtemESC
2005-10-17 20:37
2005.11.06
Эффективный алгоритм


1-1129091826
dreamse
2005-10-12 08:37
2005.11.06
Функция замены слов в тексе


2-1129314119
chij
2005-10-14 22:21
2005.11.06
DBgrid


6-1121686897
SergeyDon
2005-07-18 15:41
2005.11.06
как лучше организовать ожидание в потоке?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский