Author: Jonas Bilinkevicius
How to delete a complete folder
Answer:
Solve 1:
I use this code to delete all files in a folder and/ or the folder itself:
1
2 function DeleteFolder(FolderName: string; LeaveFolder: Boolean): Boolean;
3 var
4 r: TshFileOpStruct;
5 begin
6 Result := False;
7 if not DirectoryExists(FolderName) then
8 Exit;
9 if LeaveFolder then
10 FolderName := FolderName + ' *.* '
11 else if FolderName[Length(FolderName)] = ' \ ' then
12 Delete(FolderName, Length(FolderName), 1);
13 FillChar(r, SizeOf(r), 0);
14 r.wFunc := FO_DELETE;
15 r.pFrom := PChar(FolderName);
16 r.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
17 Result := ((ShFileOperation(r) = 0) and (not r.fAnyOperationsAborted));
18 end;
Solve 2:
19 uses
20 ShellAPI;
21
22 function DeleteDir(const Directory: string);
23 var
24 FileOp: TSHFileOpStruct;
25 begin
26 FileOp.Wnd := Application.Handle;
27 FileOp.wFunc := FO_DELETE;
28 FileOp.pFrom := PChar(Directory + #0);
29 FileOp.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
30 Result := SHFileOperation(FileOp) = 0;
31 end;
Add FOF_SILENT to fFlags if you don't want a dialog.
Solve 3:
The following will send a directory to the recycle bin:
32
33 procedure ToRecycle(AHandle: THandle; const ADirName: string);
34 var
35 SHFileOpStruct: TSHFileOpStruct;
36 DirName: PChar;
37 BufferSize: Cardinal;
38 begin
39 BufferSize := Length(ADirName) + 1 + 1;
40 GetMem(DirName, BufferSize);
41 try
42 FillChar(DirName^, BufferSize, 0);
43 StrCopy(DirName, PChar(ADirName));
44 with SHFileOpStruct do
45 begin
46 Wnd := AHandle;
47 wFunc := FO_DELETE;
48 pFrom := DirName;
49 pTo := nil;
50 fFlags := FOF_ALLOWUNDO;
51 fAnyOperationsAborted := False;
52 hNameMappings := nil;
53 lpszProgressTitle := nil;
54 end;
55 if SHFileOperation(SHFileOpStruct) <> 0 then
56 RaiseLastWin32Error;
57 finally
58 FreeMem(DirName, BufferSize);
59 end;
60 end;
Solve 4:
61 procedure DeleteDir(aDir: string);
62 {delete directory & everything in it}
63 var
64 T: TSHFileOpStruct;
65 begin
66 Fillchar(T, SizeOf(T), #0);
67 with T do
68 begin
69 Wnd := 0; {no handle -> no animation}
70 wFunc := FO_DELETE;
71 pFrom := pchar(aDir + #0#0);
72 fFlags := FOF_SILENT or FOF_NOCONFIRMATION; {just do it}
73 end;
74 Application.ProcessMessages;
75 if (SHFileOperation(T) <> 0) then
76 RemoveDir(aDir);
77 end;
Solve 5:
The command-line program DELTREE.EXE that comes with Windows removes a directory
with all its files and subdirectories. To mimic this behaviour in Delphi we can use
the following procedure that uses the FindFirst, FindNext and FindClose functions
to perform the file and directory search:
78 uses FileCtrl;
79
80 procedure DelTree(const Directory: TFileName);
81 var
82 DrivesPathsBuff: array[0..1024] of char;
83 DrivesPaths: string;
84 len: longword;
85 ShortPath: array[0..MAX_PATH] of char;
86 dir: TFileName;
87 procedure rDelTree(const Directory: TFileName);
88 // Recursively deletes all files and directories
89 // inside the directory passed as parameter.
90 var
91 SearchRec: TSearchRec;
92 Attributes: LongWord;
93 ShortName, FullName: TFileName;
94 pname: pchar;
95 begin
96 if FindFirst(Directory + '*', faAnyFile and not faVolumeID,
97 SearchRec) = 0 then
98 begin
99 try
100 repeat // Processes all files and directories
101 if SearchRec.FindData.cAlternateFileName[0] = #0 then
102 ShortName := SearchRec.Name
103 else
104 ShortName := SearchRec.FindData.cAlternateFileName;
105 FullName := Directory + ShortName;
106 if (SearchRec.Attr and faDirectory) <> 0 then
107 begin
108 // It's a directory
109 if (ShortName <> '.') and (ShortName <> '..') then
110 rDelTree(FullName + '\');
111 end
112 else
113 begin
114 // It's a file
115 pname := PChar(FullName);
116 Attributes := GetFileAttributes(pname);
117 if Attributes = $FFFFFFFF then
118 raise EInOutError.Create(SysErrorMessage(GetLastError));
119 if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
120 SetFileAttributes(pname, Attributes and not
121 FILE_ATTRIBUTE_READONLY);
122 if Windows.DeleteFile(pname) = False then
123 raise EInOutError.Create(SysErrorMessage(GetLastError));
124 end;
125 until FindNext(SearchRec) <> 0;
126 except
127 FindClose(SearchRec);
128 raise;
129 end;
130 FindClose(SearchRec);
131 end;
132 if Pos(#0 + Directory + #0, DrivesPaths) = 0 then
133 begin
134 // if not a root directory, remove it
135 pname := PChar(Directory);
136 Attributes := GetFileAttributes(pname);
137 if Attributes = $FFFFFFFF then
138 raise EInOutError.Create(SysErrorMessage(GetLastError));
139 if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
140 SetFileAttributes(pname, Attributes and not
141 FILE_ATTRIBUTE_READONLY);
142 if Windows.RemoveDirectory(pname) = False then
143 begin
144 raise EInOutError.Create(SysErrorMessage(GetLastError));
145 end;
146 end;
147 end;
148 // ----------------
149 begin
150 DrivesPathsBuff[0] := #0;
151 len := GetLogicalDriveStrings(1022, @DrivesPathsBuff[1]);
152 if len = 0 then
153 raise EInOutError.Create(SysErrorMessage(GetLastError));
154 SetString(DrivesPaths, DrivesPathsBuff, len + 1);
155 DrivesPaths := Uppercase(DrivesPaths);
156 len := GetShortPathName(PChar(Directory), ShortPath, MAX_PATH);
157 if len = 0 then
158 raise EInOutError.Create(SysErrorMessage(GetLastError));
159 SetString(dir, ShortPath, len);
160 dir := Uppercase(dir);
161 rDelTree(IncludeTrailingBackslash(dir));
162 end;
163
164 //Sample calls
165
166 //This code will remove the directory C:\TEMP\A123:
167
168 DelTree('C:\TEMP\A123');
169
170 //And this code will wipe out the diskette in drive A:
171
172 DelTree('A:'); // or DelTree('A:\');
WARNING: The procedure DelTree presented here erases files and directories, and
they might not be recoverable later. It is provided in the belief that it is
useful, but you use it at our own risk.
|
