Горячие клавиши и dll

[AdoL]

Задача есть прога (её редактировать не могу) к ней подключена dll (постоянно) .
задача как организовать глобальные горячие клавиши в этой dll.
т.е. используя только эту dll

как я себе это вижу
при запуске программы вызывается procedure HK() из нашей HT.dll
которая регистрирует горячие клавиши (допустим win+F4)
и при нажатии горячих клавиш выполняет нужные действия (для примера ShowMessage('Вы нажали хоткей'); )

Как это сделать не представляю...


среда программирования - дельфи7

[ImmortalAlexSan]

И никак вы это не сделаете! dll нужны для того, что бы от туда получать информацию или выполнять какие-нибудь функции или процедуры, а для этого, эти процедуры и функции выполнять, их нужно сперва вызвать в коде программы. dll не имеет точки входа, как она может САМА внедрится? Если поставить вопрос немного по-другому: "Написать программу, которая будет вызывать функции из dll, регистрирующие горячие клавиши" - совсем другое дело, тут я вам помогу, но только уже завтра. Очень спать хочу.

[AdoL]

ясно
спасибо.

[ImmortalAlexSan]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
HookMsg = WM_USER+$125;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
  procedure MYProc(var Msg: TMessage); message HookMSG;
  end;

var
  Form1: TForm1;
  hDLL: THandle;                                              
  SetHook: procedure (HandleProg:HWND) stdcall;
  UnSetHook: procedure (HandleProg:HWND) stdcall;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
@Sethook:= nil;
hDLL:= LoadLibrary(PChar('HotKey.dll'));
@Sethook:=GetProcAddress(Hdll, 'Sethook');
SetHook(Form1.Handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
@UnSethook:= nil;
@UnSethook:=GetProcAddress(Hdll, 'UnSethook');
UnSetHook(Form1.Handle);
end;


procedure TForm1.MYProc(var Msg:TMessage);
begin
If msg.WParam=65 then
begin
memo1.Lines.Add('Key(wParam)='+inttostr(msg.wParam)+
                ' LParam ='+inttostr(msg.lParam));
memo1.Lines.Add('Была нажата горячая клавиша клавиша "a"');
end;
end;

end.

library HotKey;

uses
SysUtils,Windows,Messages;

const
HookMsg=WM_USER+$125;
HOTKEY_R=ord('a');


var
CurHook:HWND;
AppWnd:HWND;

function KeyboardProc(code:integer; wParam,Lparam:DWORD):DWORD; stdcall;
Begin
if (Byte(LParam shr 24)<$80) then
begin
AppWnd:=FindWindow(nil,PChar('Form1'));
SendMessage(AppWnd,HookMsg,wParam,lParam);
Result:=CallNextHookEx(CurHook, Code, wParam, lParam);
end;
end;

procedure Sethook(HandleProg: HWND) export; stdcall;
begin
CurHook:=SetWindowsHookEx(WH_KEYBOARD,@KeyboardProc,HInstance,MainThreadID);
end;

procedure UnSethook(HandleProg: HWND) export; stdcall;
begin
UnhookWindowsHookEx(CurHook)
end;

exports Sethook,UnSethook;

begin

end.

[AdoL]

спасибо большое

[Stilet]

dll не имеет точки входа

Опа! Это что-то новенькое.
Если ДЛЛ пишется на Делфи то точка входа в нее находится между главным begin end.
И автор вполне может поставить клавиатурный хук на WH_KEYBOARD. И это вполне можно сделать в точке входа ДЛЛ, которая сработает при загрузке.

[AdoL]

т.е.

library Project1;
uses
  SysUtils,  Windows,  Messages,shellapi;
const
HookMsg=WM_USER+$125;
HOTKEY_R=ord('a');

var
CurHook:HWND;
AppWnd:HWND;

function KeyboardProc(code:integer; wParam,Lparam:DWORD):DWORD; stdcall;
Begin
if (Byte(LParam shr 24)<$80) then
begin
{AppWnd:=FindWindow(nil,PChar('Form1'));
SendMessage(AppWnd,HookMsg,wParam,lParam);
Result:=CallNextHookEx(CurHook, Code, wParam, lParam);
end;}
ShellExecute(AppWnd,  nil ,'notepad.exe' ,nil,nil,1);
end; end;


procedure UnSethook(HandleProg: HWND) export; stdcall;
begin
UnhookWindowsHookEx(CurHook)
end;

exports UnSethook;

begin
SetWindowsHookEx(WH_KEYBOARD,@KeyboardProc,HInstance,MainThreadID);
end.

работает только на момент обращения к библиотеке ...хотя просматривая AnVir Task Manager библиотека подключена
что не так?

[AdoL]

и другой вариант сделал сервис на хоткей (api)

program apiForm;
uses
windows, messages, shellapi, SysUtils, Dialogs, WinSvc;

const c_ServiceName = 'Shk';

var
window:twndclassex;
Handle: hwnd;
mmsg: msg;

var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
var sst : SERVICE_STATUS;
var sstHandle : SERVICE_STATUS_HANDLE;

// Процедура обработки сообщений
function windowproc (wnd: hwnd; msg: integer; wparam: wparam; lparam: lparam):lresult;stdcall;

begin
case msg of
wm_destroy:
begin
postquitmessage (0);
result := 0;
exit;
end;
else
if Msg=WM_KEYDOWN
then case wparam of
VK_ESCAPE,WM_Destroy: Halt(255);
end;

if Msg=WM_HOTKEY then ShellExecute(Handle, nil ,'notepad.exe' ,nil,nil,1);
result := defwindowproc(wnd,msg,wparam,lparam );
end;
end;

procedure SetServiceStatus1;
begin
if not SetServiceStatus(sstHandle,sst) then
RaiseLastOSError;
end;
///////////////////////////////////////////////////////////////////////
procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
begin
case Opcode of

SERVICE_CONTROL_STOP:
begin
sst.dwWin32ExitCode:=0;
sst.dwCurrentState := SERVICE_STOPPED;
sst.dwCheckPoint :=0;
sst.dwWaitHint :=0;
SetServiceStatus1;
exit;
end;

SERVICE_CONTROL_INTERROGATE : ;
end;

SetServiceStatus1;
end;


procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;
begin
sst.dwServiceType := SERVICE_WIN32;
sst.dwCurrentState := SERVICE_START_PENDING;
sst.dwControlsAccepted := SERVICE_ACCEPT_STOP;
sst.dwWin32ExitCode := 0;
sst.dwServiceSpecificExitCode := 0;
sst.dwCheckPoint := 0;
sst.dwWaitHint := 0;

sstHandle :=
RegisterServiceCtrlHandler(c_Servic eName,@ServiceCtrlHandler);

if sstHandle = 0 then RaiseLastOSError;

sst.dwCurrentState :=SERVICE_RUNNING;
sst.dwCheckPoint :=0;
sst.dwWaitHint :=0;

SetServiceStatus1;

repeat // это выполняется
sleep(3000);
beep();
MessageBox(0, 'Проверка', 'Shk', 0);
until sst.dwCurrentState = SERVICE_STOPPED;
end;


var schService, schSCManager: SC_HANDLE;
var binExe: pchar;


begin

if ParamStr(1)='/Install' then begin
binExe:=pchar(ParamStr(0));

// Установка службы
schSCManager := OpenSCManager(
nil, // local machine
nil, // ServicesActive database
SC_MANAGER_ALL_ACCESS); // full access rights

if schSCManager=0 then RaiseLastOSError;

schService := CreateService(
schSCManager, // SCManager database
c_ServiceName, // name of service
c_ServiceName, // service name to display
SERVICE_ALL_ACCESS, // desired access
SERVICE_WIN32_OWN_PROCESS, // service type
SERVICE_DEMAND_START, // start type
SERVICE_ERROR_NORMAL, // error control type
binExe, // service's binary
nil, // no load ordering group
nil, // no tag identifier
nil, // no dependencies
nil, // LocalSystem account
nil); // no password

if schService=0 then
RaiseLastOSError;

if not CloseServiceHandle(schService) then
RaiseLastOSError;

exit;

// Удаление службы

end else if ParamStr(1)='/Delete' then begin

schSCManager := OpenSCManager( nil,nil, SC_MANAGER_ALL_ACCESS);

if schSCManager=0 then RaiseLastOSError;
schService := OpenService(
schSCManager, // SCManager database
c_ServiceName, // name of service
SERVICE_ALL_ACCESS); // only need DELETE access
if schService = 0 then
RaiseLastOSError;
if not DeleteService(schService) then
RaiseLastOSError;
if not CloseServiceHandle(schService) then
RaiseLastOSError;
exit;
end;

//окно-иначе хоткей не работает
window.cbsize := sizeof (window);
window.style := cs_hredraw or cs_vredraw;
window.lpfnwndproc := @windowproc;
window.cbclsextra := 0;
window.cbwndextra := 0;
window.hinstance := hinstance;
window.lpszclassname := 'main_window';
registerclassex (window);
Handle := createwindowex(0,'main_window','fir st_winapi_programm', ws_overlappedwindow,100,100,300,300 ,0,0,hinstance,nil);

//регистрирую хоткей
RegisterHotKey(Handle,0,MOD_CONTROL ,ord('1'));

//запуск
DispatchTable[0].lpServiceName:=c_ServiceName;
DispatchTable[0].lpServiceProc:=@ServiceProc;

DispatchTable[1].lpServiceName:=nil;
DispatchTable[1].lpServiceProc:=nil;

StartServiceCtrlDispatcher(Dispatch Table[0]);

//где это обработать?
while getmessage (mmsg,0,0,0) do
begin
translatemessage (mmsg);
dispatchmessage (mmsg);
end;
end.

[AdoL]

как обработать getmessage ... что только не делал ... в таком виде работает но ShellExecute выполняется естественно только после остановки ...

[AdoL]

сделал ч/з поток

тему можно закрыть