Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 07.03.2009, 13:46   #1
lexastik
Пользователь
 
Регистрация: 25.02.2009
Сообщений: 16
По умолчанию Hook и консольное приложение

Добрый день. 3 дня парюсь, не могу понять как сделать: есть консольное приложение читающее из памяти процесса. Оно все работает хорошо (Большое спасибо JTG). Так вот, мне нужно чтоб запись в файл начиналась по нажатию кнопки F3, а не при запуске сразу. Есть хук, рабочий, проверено (но проверено на приложении с формой). Подскажите пожалуйста как получить код нажатой клавиши в консольное приложение??? То есть у меня в цикле постоянно будет проверяться код считанной клавиши и если он равен F3, то писать в файл, если еще раз F3 то буду делать CloseFile(F) и все.

Код:
uses
  SysUtils,
  Graphics,
  Tlhelp32,
  Windows,
  xKeyHook;

var
 cycle:boolean;
 i:integer;


procedure MyProc( ); stdcall; external 'MyFirstDLL.dll' name 'MyFirstFunc';
function KeybHook(Sender: HWND; var Key: LongInt):LRESULT; stdcall; external 'kHook.dll' name 'KeybHook';

function ReadTask(ExeFileName: string;Var Sp:single): Integer;
var
 F:TextFile;
 ContinueLoop: BOOLEAN;
 FSnapshotHandle: THandle;
 FProcessEntry32: TProcessEntry32;
 han,processHandle: THandle;
 DoSvet,Startx,Direct,SpeedPtr:Single; 
 adr:pointer;
 res:boolean;
 te,TimeHour,TimeMin,TimeSec,Signal,RB,Adress,nB: DWORD;
 st:string;
 speed:real;
 hex:string;
 Mbi:  MEMORY_BASIC_INFORMATION;

 adr1,adr2:pointer;
 psi,psi_:single;
 consistPointerAddr,ad,ad1,ad2:DWORD;
 add:string;
 ma, mb:single;
 psearchs,psearche:DWORD;
 h:integer;
//------------------------ для Dll ---------------------------
 DLLInstance : THandle;
 KeybHookk:TKeybHook;
 wnd:HWND;
//------------------------------------------------------------
 begin
 MyProc(); \\это простейщаяя dll из которой выводится мессадж (все работает)
// Динамическая загрузка dll
   { загружаем DLL }
 { DLLInstance := LoadLibrary('khook.dll');
   if DLLInstance = 0 then begin
                Writeln('Невозможно загрузить DLL');
                Exit;
               end;
        { получаем указатель }
   {     @KeybHookk := GetProcAddress(DLLInstance, 'KeybHook');
        if @KeybHookk <> nil then
          { вызываем процедуру на выполнение }
     //   KeybHook;

//------------------------------------------------------

xKeyHook.StartHook;  // запускаем Hook
wnd := GetForegroundWindow(); //HWND текущего окна
writeln(wnd);
а вот та dll (Hook)

Код:
{
 KeyHook
 author: M_A_R_T
 e-mail: m_a_r_t@mail.ru
 XProject
 http://xproject.fatal.ru/
}

library khook;

uses
  windows,
  messages;

type
    PHookRec = ^THookRec; 
    THookRec = record
        MainWindow: HWND;
        HookID: HHOOK;
        MsgToSend: Integer;
    end;

var
    rHookRec: PHookRec;

function KeybHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; Export;
var
  AppWnd: HWND;
begin
  if code=HC_ACTION then
      AppWnd:=GetForegroundWindow();
      if ((lParam shr 31) and 1)=1 then
        SendMessage(rHookRec^.MainWindow,rHookRec^.MsgToSend,wParam,AppWnd)
      else
        SendMessage(rHookRec^.MainWindow,rHookRec^.MsgToSend+1,wParam,AppWnd);
  Result := CallNextHookEx(rHookRec^.HookID,Code,wParam,lParam)
end;

procedure SetMainHandle(Handle: HWND);
begin
  rHookRec^.MainWindow:= Handle;
end;

procedure SetMsgToSend(Msg: Integer);
begin
  rHookRec^.MsgToSend:= Msg;
end;

procedure StartHook; stdcall;
begin
  if rHookRec^.HookID=0 then
    rHookRec^.HookID    :=SetWindowsHookEx(WH_KEYBOARD,@KeybHook,HInstance,0);
end;

procedure StopHook; stdcall;
begin
  if rHookRec^.HookID<>0 then
  begin
    UnhookWindowsHookEx(rHookRec^.HookID);
    rHookRec^.HookID:=0;
  end;
end;

procedure EntryPointProc(Reason: Integer); 
var
    hMapObject: THandle;
begin
    case reason of
        DLL_PROCESS_ATTACH:
            begin
                hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(THookRec), '_CBT');
                rHookRec := MapViewOfFile(hMapObject, FILE_MAP_WRITE, 0, 0, 0);
            end;

        DLL_PROCESS_DETACH:
            begin
                try
                    UnMapViewOfFile(rHookRec);
                    CloseHandle(hMapObject);
                except 
                end; 
            end; 
    end; 
end;



exports
  SetMainHandle,
  SetMsgToSend name 'Msg',
  StartHook,
  StopHook,
  KeybHook name 'KeybHook';

begin
    DllProc := @EntryPointProc; 
    EntryPointProc(DLL_PROCESS_ATTACH);
end.
и вот отрывочек той проги, в которой все работает

Код:
........
type
.....
 procedure xKeyHook1KeyDown(Sender: HWND; var Key: Integer);

и в конце

procedure TForm1.xKeyHook1KeyDown(Sender: HWND; var Key: Integer);
begin
   Edit4.Text:=IntToStr(key);
   If (Key = 76) and (b = 0) then b := 1; 
end;
И без проблем в Edit4 выводит код клавиши. Каааак сделать, чтоб моя консольная программа получала код клавиши, помогите пожалуйста.
lexastik вне форума
Старый 10.03.2009, 09:30   #2
lexastik
Пользователь
 
Регистрация: 25.02.2009
Сообщений: 16
По умолчанию

Тему можно удалять. Разобрался.
lexastik вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
консольное приложение user_jasser Общие вопросы Delphi 3 17.10.2008 12:17
Консольное приложение a_priori Общие вопросы Delphi 6 12.03.2008 08:33
Консольное приложение eks-s Общие вопросы Delphi 17 25.01.2008 03:12
Консольное приложение MAcK Общие вопросы Delphi 2 03.12.2006 18:28