(* //
Title: Delete yourself
Description: WARNING Doing this program will delete all files and directories of the directory
Design: zswang
Date: 2002-01-29
Support: wjhu111@21cn.com
// *)
/// begin Source
Uses
Windows, Dialogs, SysuTils, Controls;
Procedure deleteme (MDELETEDIR: BOOLEAN = false); {自己 自己 自己 自己 自己}}
VAR
Vexedir: String;
Procedure PDELDIR (MDIRNAME: STRING); {Delete Specified Path}
VAR
vSearchrec: tsearchrec: tsearchrec;
Pathname: String;
K: integer;
Begin
Pathname: = mDirName '/*.*';
K: = Findfirst (Pathname, Faanyfile, vsearchrec);
While k = 0 do begin
IF (vSearchRec.attr and fadirectory> 0)
(POS (vSearchrec.name, '..') = 0) THEN Begin
{$ WARNINGS OFF}
FileSetAttr (vsearchrec.name, fadirectory);
{Warnings on}
PDELDIR (MDIRNAME '/' VSEARCHREC.NAME);
ELSE IF (POS (vSearchRec.name, '..') = 0) AND
(CompareText (mDirname '/' vsearchrec.name, paramstr (0)) <> 0) THEN Begin
{$ WARNINGS OFF}
FileSetAttr (vSearchRec.name, 0);
{Warnings on}
Deletefile (Pchar (MDirName '/' vsearchRec.name);
END;
K: = FINDNEXT (VSearchRec);
END;
If CompareText (vexedir, mDirname) <> 0 THEN RMDIR (MDIRNAME);
End; {pdeldir}
VAR
BATCHFILE: TEXTFILE;
BatchFileName: TFileName;
PROCESSINFO: TPROCESSINFORMATION;
Startupinfo: TStartupinfo;
Begin
Vexedir: = ExtractFileDir (paramstr (0));
If MDELETEDIR THEN PDELDIR (VEXEDIR);
Batchfilename: = '../deleteme.bat';
Assignfile (Batchfile, BatchFileName);
Rewrite (Batchfile);
Writeln (Batchfile, ': DEL');
Writeln (Batchfile, 'DEL "' paramstr (0) '");
Writeln (Batchfile, 'IF EXIST "' paramstr (0) '"' 'goto try');
If MDeletedir Then Writeln (Batchfile, 'RD' ExtractFileDir (paramstr (0))); Writeln (Batchfile, 'DEL% 0');
Closefile (BatchFile);
Fillchar (StartupInfo, Sizeof (Startupinfo), # 0);
Startupinfo.dwflags: = startf_useshowwindow;
Startupinfo.wshowwindow: = sw_hide;
IF CreateProcess (Nil, Pchar (Batchfilename), NIL, NIL,
False, Idle_Priority_Class, NIL, NIL, Startupinfo,
ProcessInfo) THEN Begin
CloseHandle (ProcessInfo.hthread);
CloseHandle (ProcessInfo.hprocess);
END;
End; {deleteme}
/// end source
/// Begin Demo
Begin
If messageDLG ('warnings this program will delete all the files and directories of the directory ",
MTWARNING, [MBYES, MBNO], 0) = mryes then
Deleteme (TRUE);
End.
/// end demo
This definitely no problem
I have used well, 98/2000 / XP is OK
PROCEDURE DELETESELF;
VAR
BATCHFILE: TEXTFILE;
Batchfilename: String;
PROCESSINFO: TPROCESSINFORMATION;
Startupinfo: TStartupinfo;
Begin
BatchFileName: = ChangefileExt (paramstr (0), '. Bat');
Assignfile (Batchfile, BatchFileName);
Rewrite (Batchfile);
// build CMD Batch file
Writeln (Batchfile, ': try');
Writeln (Batchfile, Format ('del "% s", [paramstr (0)])));
Writeln (BatchFile, Format ('if exist "goto try', [paramstr (0)]))
Writeln (Batchfile, 'DEL% 0');
Closefile (BatchFile);
Fillchar (StartupInfo, Sizeof (Startupinfo), $ 00);
Startupinfo.dwflags: = startf_useshowwindow;
Startupinfo.wshowwindow: = sw_hide;
// Create Hidden Process
IF creageprocess (nil, pchar
(BatchFileName), NIL, NIL, FALSE, IDLE_PRIORITY_CLASS, NIL, NIL, Startupinfo, ProcessInfo1EN
Begin
CloseHandle (ProcessInfo.hthread);
CloseHandle (ProcessInfo.hprocess);
END;
