| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Удалить себя [D7, XP]

Viktop ©   (2006-01-09 20:34:00) 

Подскажите, как программе удалить себя (когда она запущена).
Смотрел на delphiworld, но те примеры не работаю (работают, но несовсем правильно)
program delete2;

uses
 SysUtils, windows;

var
 BatchFile: TextFile;
 BatchFileName: string;
 TM: Cardinal;
 TempMem: PChar;

begin
 BatchFileName:=ExtractFilePath(ParamStr(0))+ '$$336699.bat';

 AssignFile(BatchFile, BatchFileName);
 Rewrite(BatchFile);

 Writeln(BatchFile,':try');
 Writeln(BatchFile,'del "' + ParamStr(0) + '"');
 Writeln(BatchFile,'if exist "' + ParamStr(0) + '" goto try');
 Writeln(BatchFile,'del "' + BatchFileName + '"');
 CloseFile(BatchFile);

 TM:=70;
 GetMem (TempMem,TM);
 GetShortPathName (pchar(BatchFileName), TempMem, TM);
 BatchFileName:=TempMem;
 FreeMem(TempMem);

 winexec(Pchar(BatchFileName),sw_hide);

 halt;
end.

Этот пример самый рабочий, но удаляет только если в пути нет кирилицы

---

AbrosimovA   (2006-01-10 15:16:00) [1]

program delete2;

uses
SysUtils, windows;

var
BatchFile: TextFile;
BatchFileName: string;
TM: Cardinal;
TempMem: PChar;

function WinToDos(const s : string) : string;
var dest : string;
begin
 setLength(dest, length(s)+1);
 AnsiToOem(@s[1], @dest[1]);
 Result:=StrPas(PChar(dest));
end;

begin
BatchFileName:=ExtractFilePath(ParamStr(0))+ '$$336699.bat';

AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);

Writeln(BatchFile,':try');
Writeln(BatchFile,'del "' + WinToDos(ParamStr(0)) + '"');
Writeln(BatchFile,'if exist "' + WinToDos(ParamStr(0)) + '" goto try');
Writeln(BatchFile,'del "' + WinToDos(BatchFileName) + '"');
CloseFile(BatchFile);

TM:=70;
GetMem (TempMem,TM);
GetShortPathName (pchar(BatchFileName), TempMem, TM);
BatchFileName:=TempMem;
FreeMem(TempMem);

winexec(Pchar(BatchFileName),sw_hide);

halt;
end.

---

Viktop   (2006-01-10 14:46:00) [2]

Нашёл!
http://slava.fateback.com/work/articles/selfdel.htm
Метод COMSPEC

---

Viktop   (2006-01-10 14:02:00) [3]

Не помогает
 Writeln(BatchFile, AnsiString(':try'));
 Writeln(BatchFile, AnsiString('del "' + ParamStr(0) + '"'));
 Writeln(BatchFile, AnsiString('if exist "') + AnsiString(ParamStr(0)) + AnsiString('" goto try'));
 Writeln(BatchFile, AnsiString('del "') + AnsiString(BatchFileName) + AnsiString('"'));
 CloseFile(BatchFile);

---

AbrosimovA   (2006-01-10 12:57:00) [4]

Используй тип AnsiString

---

Viktop   (2006-01-10 07:58:00) [5]

В указанном выше примере получается так:
:try
S‹ШЂ»2\x2
if exist "C:\Documents and Settings\Администратор\Мои документы\Виктор\3 курс\Работа\Manfred\prog\avto.exe" goto try
del "C:\Documents and Settings\Администратор\Мои документы\Виктор\3 курс\Работа\Manfred\prog\$$336699.bat"

---

Viktop   (2006-01-10 07:56:00) [6]

Сделал так:
procedure DeleteSelf;
 function ConvertToDos(S: string): PChar;
 begin
   CharToOEM(PChar(S), PChar(S));
 end;
var
 BatchFile: TextFile;
 BatchFileName: string;
 TM: Cardinal;
 TempMem: PChar;
begin
 BatchFileName := ExtractFilePath(ParamStr(0)) + '$$336699.bat';

 AssignFile(BatchFile, BatchFileName);
 Rewrite(BatchFile);

 Writeln(BatchFile, ':try');
 Writeln(BatchFile, ConvertToDos('del "' + ParamStr(0) + '"'));
 Writeln(BatchFile, 'if exist "' + ParamStr(0) + '" goto try');
 Writeln(BatchFile, 'del "' + BatchFileName + '"');
 CloseFile(BatchFile);

 TM := 70;
 GetMem(TempMem, TM);
 GetShortPathName(pchar(BatchFileName), TempMem, TM);
 BatchFileName := TempMem;
 FreeMem(TempMem);

 winexec(Pchar(BatchFileName), sw_hide);

 halt;

end;
Теперь всё, что попадает в функцию ConvertToDos становится нечетаемым

---

Viktop   (2006-01-10 07:40:00) [7]

Delphi 7
Поиск молчит

---

Gero   (2006-01-09 21:20:00) [8]

F1

---

Viktop   (2006-01-09 21:01:00) [9]

Можно подробнее

---

Gero   (2006-01-09 20:53:00) [10]

CharToOem

---

Наверх