Удаление файлов

Для удаления файлов в Delphi так же предусмотрена специальная процедура DeleteFile. В качестве параметра, передаваемого в функцию, выступает строка типа PChar, указывающая имя файла, который нужно удалить. Сразу предлагаю Вам простой пример на использование этой функции:

{codecitation class="brush: pascal; gutter: false;" width="600px"} 

procedure TForm1.Button1Click(Sender: TObject);
begin
if DeleteFile(‘c:\2.txt’) then
ShowMessage(‘Файл успешно удален!’)
else
ShowMessage(‘Ошибка! Вот ее код: ‘+IntToStr(GetLastError));
end;{/codecitation}
 

Итератор для поиска файлов в директории

Очень часто задают вопрос «как перебрать все файлы папки».
Так же часто предлагают использовать FindFirst/FindNext.
Я написал класс TEnumFolder который предоставляет более
удобный интерфейс поиска за счет использованием методов
First/Next/Eof.

Используйте свойства AbsPath и RelPath для получения абсолютного
и относетильного пути текущего файла/папки. Свойство SR типа PSearchRec,
содержит информацию о текущем файле/папке.

Так же можно указать режим перебора (IsFolderFirst = False) при котором,
можно удалить всю папку(!), т.е. в начале находятся все файлы папки,
а потом сама папка (т.к. можно удалять только пустую папку).

Зависимости: Classes, SysUtils

unit EnmFolder;

interface

uses
Classes, SysUtils;

type
PSearchRec = ^TSearchRec;
TEnumFolder = class
private
FBasePath: string;
FList: TStrings;
FSR: PSearchRec;
FIsFolderFirst: Boolean;
FBasePos: Integer;
FNextProc: procedure of object;
function GetAbsPath: string;
function GetRelPath: string;
procedure ClearList;
function GetPathType(Path: string): Integer;
procedure PushSR(Dir: string);
procedure PopSR;
procedure Next1;
procedure Next2;
public
constructor Create(BasePath: string; IsFolderFirst: Boolean = True);
destructor Destroy; override;
procedure First;
procedure Next;
function Eof: Boolean;
property AbsPath: string read GetAbsPath;
property RelPath: string read GetRelPath;
property SR: PSearchRec read FSR;
end;

implementation

{ TEnumFolder }

constructor TEnumFolder.Create(BasePath: string; IsFolderFirst: Boolean);
begin
inherited Create;
FList := TStringList.Create;
FBasePath := ExcludeTrailingBackslash(BasePath);
FIsFolderFirst := IsFolderFirst;
if IsFolderFirst then
FNextProc := Next1
else
FNextProc := Next2;
end;

destructor TEnumFolder.Destroy;
begin
ClearList;
FList.Free;
inherited;
end;

procedure TEnumFolder.ClearList;
begin
while (FList.Count > 0) do
PopSR;
end;

function TEnumFolder.GetAbsPath: string;
begin
Result := FList[0] + SR.Name;
end;

function TEnumFolder.GetRelPath: string;
begin
Result := Copy(AbsPath, FBasePos, MaxInt);
end;

function TEnumFolder.GetPathType(Path: string): Integer;
begin
New(FSR);
if (FindFirst(Path, faAnyFile, SR^) <> 0) then
Result := -1 { Not found }
else
begin
if (SR.Attr and faDirectory <> 0) then
begin
FBasePos := Length(Path) + 2;
Path := ExtractFilePath(Path);
FList.InsertObject(0, Path, TObject(SR));
Result := 1; { Folder }
end
else
begin
Path := ExtractFilePath(Path);
FBasePos := Length(Path) + 1;
FList.InsertObject(0, Path, TObject(SR));
Result := 0; { File }
end;
end;
end;

function TEnumFolder.Eof: Boolean;
begin
Result := (FList.Count = 0);
end;

procedure TEnumFolder.First;
begin
FSR := nil;
ClearList;
case GetPathType(FBasePath) of
{ Folder }
1:
if not FIsFolderFirst then
begin
PushSR(FBasePath);
Next;
end;
{ File }
0: ;
end;
end;

procedure TEnumFolder.Next;
begin
FNextProc;
end;

procedure TEnumFolder.Next1;
begin
{ Push folder }
if (SR.Attr and faDirectory <> 0) then
PushSR(FList[0] + FSR.Name);

while (FList.Count > 0) and (FindNext(SR^) <> 0) do
PopSR;
end;

procedure TEnumFolder.Next2;
begin
while (FList.Count > 0) do
if (FindNext(SR^) <> 0) then
begin
PopSR;
Break;
end
else if (SR.Attr and faDirectory <> 0) then
PushSR(FList[0] + FSR.Name)
else
Break;
end;

procedure TEnumFolder.PushSR(Dir: string);
begin
New(FSR);
FindFirst(Dir + '\*.*', faAnyFile, FSR^);
FindNext(FSR^); { Skip "." and ".." }
FList.InsertObject(0, Dir + '\', TObject(FSR));
end;

procedure TEnumFolder.PopSR;
begin
FList.Delete(0);
FindClose(SR^);
Dispose(SR);
if FList.Count > 0 then
FSR := PSearchRec(FList.Objects[0])
else
FSR := nil;
end;

end.

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
fe: TEnumFolder;
begin
{ Показываем содержимое папки }
Memo1.Lines.BeginUpdate;
Memo1.Clear;
fe := TEnumFolder.Create('c:\temp', True);
fe.First;
while not fe.Eof do
begin
Memo1.Lines.Add(fe.AbsPath);
fe.Next;
end;
fe.Free;
Memo1.Lines.EndUpdate;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
fe: TEnumFolder;
begin
{ Удаляем папку }
fe := TEnumFolder.Create('c:\temp', False);
fe.First;
while not fe.Eof do
begin
if (fe.SR.Attr and faDirectory) = 0 then
DeleteFile(fe.AbsPath)
else
RemoveDir(fe.AbsPath);
fe.Next;
end;
fe.Free;
end;

Перетаскивать окно не за заголовок

 

Как сделать окно, которое перетаскивается не за заголовок
(caption), а за все поле.

Нужно обрабатывать сообщение WM_NCHITTEST:

TForm1 = class(TForm)
...
private
...
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
...
end;

...

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { вызов унаследованного обработчика }
if M.Result = htClient then{ Мышь сидит на окне? }
M.Result := htCaption; { Если да - то пусть Windows думает,
что мышь на caption bar }

end;
...

Окно можно сделать вообще без caption.

Ввод в Edit только чисел

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9', ',']) then Key := #0;
end;

В данном примере не обрабатывается нажатие «Backspace».
В следующем коде это исправлено.

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9', ',' , #8]) then Key := #0;
end;