删除程序自身

(*//
标题:自己删除自己
说明:警告执行此程序将删除所在目录的所有文件及目录
设计: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


这个绝对没有问题
我用得好好的，98／2000／XP都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 "%s" 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 CreateProcess(nil,PChar
(BatchFileName),nil,nil,False,IDLE_PRIORITY_CLASS,nil,nil,StartUpInfo,ProcessInfo) then
     begin
       CloseHandle(ProcessInfo.hThread);
       CloseHandle(ProcessInfo.hProcess);
     end;
end;