(*//

标题:自己删除自己

说明:警告执行此程序将删除所在目录的所有文件及目录

设计:Zswang

日期:2002-01-29

支持:wjhu111@21cn.com

//*)

///////Begin Source

uses

 Windows, Dialogs, SysUtils, Controls;

procedure DeleteMe(mDeleteDir: Boolean = False); { 自己删除自己 }

var

 vExeDir: string;

 procedure pDelDir(mDirName: string); { 删除指定路径 }

 var

   vSearchRec: TSearchRec;

   PathName: string;

   K: Integer;

 begin

   PathName := mDirName + '\*.*';

   K := FindFirst(PathName, faAnyFile, vSearchRec);

   while K = 0 do begin

     if (vSearchRec.Attr and faDirectory > 0) and

       (Pos(vSearchRec.Name, '..') = 0) then begin

       {$WARNINGS OFF}

       FileSetAttr(vSearchRec.Name, faDirectory);

       {$WARNINGS ON}

       pDelDir(mDirName + '\' + vSearchRec.Name);

     end 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('警告执行此程序将删除所在目录的所有文件及目录',

   mtWarning, [mbYes, mbNo], 0) = mrYes then

   DeleteMe(True);

end.

///////End Demo