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]

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

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

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;

> var aListFile: TStringList

Лучше так
aListFile: TStrings

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

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

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

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

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

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

Опечатка.

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

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

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

ну вот с пустя несколько дней хоть что то! теперь программам удаляет файлы! но есть проблема - она их удаляет в указанном катологе! а как сделть чтобы она их еще и искала????
-----------------------------
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;

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

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