Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Закрытая темаСоздание новой темы Создание опроса
> Самоубийство программы, возможно в исходнике ошибка! 
:(
    Опции темы
ADAM83
Дата 5.9.2006, 15:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 107
Регистрация: 13.1.2006

Репутация: нет
Всего: нет
Здравствуйте, хотелось бы создать проект-самоубийцу, который утичтожил бы себя через 1 день после первого запуска.
Ниже приведен код, но что то ругается на все типы, говорит что не определил.
Может эту функцию надо было описать в модуле, а не в самом проекте, что то не разобрался.

Код

program Project2;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}
function Check: boolean; // проверяем, можно ли жить зальше
const killer = 'k.bat';
var
  sfile: string; // Скрытый файл, который скажет нам, когда программу запускали в первый раз
  days:  TDateTime; // Сколько дней работает программа
  sl:    TStringList;
  h:     THandle;
begin
  result := false;
  sfile := GetEnvironmentVariable('APPDATA');
  if sfile = '' then
    sfile := GetEnvironmentVariable('WINDIR');
  sfile := sfile + '\sdata.sys';
  h := CreateFile(PChar(sfile), GENERIC_WRITE, 0, nil, CREATE_NEW,
       FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_READONLY,0);
  CloseHandle(h);
  days := now - FileDateToDateTime(FileAge(sfile));
  if days <= 1 then Exit; // если еще не больше 1 дня, то еще рано
  sl := TStringList.Create; // иначе создаем батник самоубийства
  sl.Add('s:');
  sl.Add('del '+ParamStr(0));
  sl.Add('if exist ' + ParamStr(0) + ' goto s');
  sl.Add('echo y | del ' + ExtractFilePath(ParamStr(0)) + '*.*'); // убить всех
  sl.Add('del %0'); // батник застрелится, когда отработает
  sl.SaveToFile(killer); // сохраняем его на диск
  sl.Free;
  result := true;
  WinExec(killer, SW_HIDE); // запускаем батник скрыто
end;
begin
  if Check then Exit; // если проверка показала, что жить нельзя
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
  

Спасибо заранее.

Это сообщение отредактировал(а) ADAM83 - 5.9.2006, 15:27
PM MAIL   Вверх
Yanis
Дата 5.9.2006, 15:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
Ну конечно... Болшинство то типов определено в модуле Windows, а как раз его то в твоей Uses его нет.

Добавлено @ 15:29 
А ещё нехватает модуля Classes.


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
RideX
Дата 5.9.2006, 16:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 94
Регистрация: 8.9.2004

Репутация: 4
Всего: 7
ADAM83, если не обязательно таким способом, то можно так:
Код

MoveFileEx(PChar(ExtractFileName(Application.Exename)), nil, MOVEFILE_DELAY_UNTIL_REBOOT);
 Файл удалится при следующей загрузке Windows.
PM   Вверх
ADAM83
Дата 6.9.2006, 08:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 107
Регистрация: 13.1.2006

Репутация: нет
Всего: нет
Yanis, я попробовал подключить модуль Виндовс, но все равно ругается

Добавлено @ 08:36 
RideX, а куда эту процедуру писать то, можно по подробнее?
PM MAIL   Вверх
Snowy
Дата 6.9.2006, 09:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484
Цитата(ADAM83 @  6.9.2006,  08:35 Найти цитируемый пост)
Yanis, я попробовал подключить модуль Виндовс, но все равно ругается
Сходит в тот топик, где я давал этот код и подключи всё, что подключено и там:
http://forum.vingrad.ru/index.php?showtopi...st&p=646887
PM MAIL   Вверх
Yanis
Дата 6.9.2006, 09:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
Цитата(ADAM83 @  6.9.2006,  09:35 Найти цитируемый пост)
Yanis, я попробовал подключить модуль Виндовс, но все равно ругается

Конечно. Одним модулем windows не ограничешься. И я это написал. Не судьба самому посмотреть какие модули ещё требуются?


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
RideX
Дата 6.9.2006, 10:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 94
Регистрация: 8.9.2004

Репутация: 4
Всего: 7
Цитата(ADAM83 @  6.9.2006,  11:35 Найти цитируемый пост)
RideX, а куда эту процедуру писать то, можно по подробнее?

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  strTrialDate: String = '07.09.2006';

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Caption := 'Демо-версия';
end;


/////////////////////////////
// Проверка даты
initialization
  if Date >= StrToDate(strTrialDate) then begin
    //Здесь код если дата просрочена
    MoveFileEx(PChar(Application.Exename), nil, MOVEFILE_DELAY_UNTIL_REBOOT);
    //...
    ExitProcess(0);
  end;
end.


Значение прописывается в реестр в эту ветку:
Код

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager] 
"PendingFileRenameOperations"
PM   Вверх
ADAM83
Дата 6.9.2006, 10:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 107
Регистрация: 13.1.2006

Репутация: нет
Всего: нет
Snowy, да моя ошибка. До конца не досмотрел. Все заработало. Теперь результат посмотрим завтра, потому что поставил жизненный цикл проекта 1 день.


RideX, твой метод тоже использовал, результат тоже будет завтра.


Это сообщение отредактировал(а) ADAM83 - 6.9.2006, 10:42
PM MAIL   Вверх
dumb
Дата 6.9.2006, 11:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: 13
Всего: 158
ADAM83, а часы не судьба перевести? smile

ps.
Код

void get_tomorrow_date( struct timeval *date )
{
sleep( 86400 );
gettimeofday( date, 0 );
}
PM MAIL   Вверх
Snowy
Дата 6.9.2006, 11:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484
Я грю - системное время можно вручную перевести.
Не обязательно ждать до завтра.
PM MAIL   Вверх
Alexeis
Дата 6.9.2006, 11:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459
dumb, не против если этот супер алгоритм в раздел юмора перенесу smile 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Snowy
Дата 6.9.2006, 12:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484
Код

function GetTomorrowDate: TDateTime;
begin
  Sleep(86400);
  result := date;
end;
PM MAIL   Вверх
RideX
Дата 6.9.2006, 15:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 94
Регистрация: 8.9.2004

Репутация: 4
Всего: 7
Если честно, вполне оригинально!  smile
Только, IMHO, здесь баг, правильно будет так:
Код

function GetTomorrowDate: TDateTime;
begin
  Sleep(86400 * 1000);
  result := date;
end;
PM   Вверх
  
 Закрытая темаСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0605 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.