Не могу получить имя файла по хэндлу...

← →
BlackSun (2003-01-07 11:28) [0]

Прога регирует на создание нового окна...
Основная прога
---------------------------------------------------------------
unit shell_p;

interface

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

type
TMainF = class(TForm)
Button1: TButton;
Button2: TButton;
WndList: TListBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{перезаписываем процедуру окна - подробнее см. ниже}
procedure WMUser(var Msg: TMessage); message WM_USER;
{ Private declarations }
public
{ Public declarations }
end;

var
MainF: TMainF;
hDLL: THandle; // дескриптор загружаемой библиотеки

implementation

{$R *.dfm}
function GetWndText(Wnd: HWND): string;
var
L: Integer;
begin
L := GetWindowTextLength(Wnd) + 1;
if L > 1 then
begin
SetLength(Result, L);
GetWindowText(Wnd, @Result[1], L);
end
else Result := "???";
end;

procedure TMainF.WMUser(var Msg: TMessage);
var
M{odule}: array [0..255] of char;
begin
inherited ; // выполняем всё то, что должно происходить при поступлении сообщеня окну
{Но если пришло моё сообщение - выполняем следующий код}
case Msg.LParam of
HSHELL_WINDOWCREATED:
begin
**********вот тут.... должен возвращаться путь к файлу и его имя, а возвращается путь к моей программе... или вообще мусор, в чем дело?*****************
{$IFOPT R+} {$DEFINE RangeChecked} {$R-} {$ENDIF}
GetModuleFileName(GetWindowLong(Msg.WParam, GWL_HINSTANCE), @M, sizeof(M));
WndList.Items.Add(string(M));
{$IFDEF RangeChecked} {$UNDEF RangeChecked} {$R+} {$ENDIF}
WndList.Items.AddObject(GetWndText(Msg.WParam), TObject(msg.WParam));
// WndList.Items.AddObject(msg.LParam);
end;
end;
end;
procedure TMainF.Button1Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
@hook:= nil; // инициализируем переменную hook
hDLL:= LoadLibrary(PChar("shell_h.dll")); { загрузка DLL }
if hDLL > HINSTANCE_ERROR then
begin { если всё без ошибок, то }
@hook:=GetProcAddress(Hdll, "hook"); { получаем указатель на необходимую процедуру}
Button2.Enabled:=True;
Button1.Enabled:=False;
hook(true, MainF.Handle);
end
else
begin
ShowMessage("Ошибка при загрузке DLL !");
Exit;
end;

end;

procedure TMainF.Button2Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
@hook:= nil; // инициализируем переменную hook
if hDLL > HINSTANCE_ERROR then
begin { если всё без ошибок, то }
@hook:=GetProcAddress(Hdll, "hook"); { получаем указатель на необходимую процедуру}
Button1.Enabled:=True;
Button2.Enabled:=False;
hook(false, MainF.Handle);
end;

end;
end.

← →
Юрий Зотов (2003-01-07 11:59) [1]

> а возвращается путь к моей программе... или вообще мусор, в
> чем дело?

Видимо, в неверном написании DLL с глобальным хуком. Но Вы не привели ее код.

← →
BlackSun (2003-01-07 15:44) [2]

Вот код... просто я не понимаю, ведь заголовок создаваемого окна правильно выводит, а вот имя файла нет... подскажите, пожалуйста!
library keyhook;

uses
SysUtils,
Windows,
Messages,
Forms;

const
MMFName: PChar = "KeyMMF"; // имя объекта файлового отображения

{структура, поля которой будут отображены в файл подкачки}
type
PGlobalDLLData = ^TGlobalDLLData;
TGlobalDLLData = packed record
SysHook: HWND; // дескриптор установленной ловушки
MyAppWnd: HWND; // дескриптор нашего приложения
end;

var
GlobalData: PGlobalDLLData;
MMFHandle: THandle;
WM_MYSHELLHOOK: Cardinal;

function ShellHook(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var
AppWnd: HWND; // дескриптор приложения, в котором произошло нажатие клавишы
begin
// AppWnd:= GetForegroundWindow();
// SendMessage(GlobalData^.MyAppWnd, WM_USER, wParam, Code);
if Code in [HSHELL_WINDOWCREATED, HSHELL_WINDOWDESTROYED, HSHELL_REDRAW] then
SendMessage(GlobalData^.MyAppWnd, WM_USER, wParam, Code);
Result:= CallNextHookEx(GlobalData^.SysHook, Code, wParam, lParam);
end;

{Процедура установки HOOK-а}
procedure hook(switch : Boolean; hMainProg: HWND) export; stdcall;
begin
if switch=true then
begin
{Устанавливаю HOOK, если он не установлен (switch=true). }
GlobalData^.SysHook := SetWindowsHookEx(WH_SHELL, @ShellHook, HInstance, 0);
GlobalData^.MyAppWnd:= hMainProg;
if GlobalData^.SysHook <> 0 then
MessageBox(0, "Shell HOOK установлен !", "Message from shell.dll", 0)
else
MessageBox(0, "HOOK установить не удалось !", "Message from shell.dll", 0);

end
else
begin

{Удаляю функцию-фильтр, если она установлена (т.е. switch=false). }
if UnhookWindowsHookEx(GlobalData^.SysHook) then
MessageBox(0, "HOOK снят !", "Message from shell.dll", 0)
else
MessageBox(0, "HOOK снять не удалось !", "Message from shell.dll", 0);

end;
end;

procedure OpenGlobalData();
begin
{регестрируем свой тип сообщения в системе}
WM_MYSHELLHOOK:= RegisterWindowMessage("WM_SHELLHOOK");

{получаем объект файлового отображения}
// MMFHandle:= CreateFileMapping(DWord(-1), nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName); // можно так, но лучше: см. след. строку
MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);

if MMFHandle = 0 then
begin
MessageBox(0, "Can""t create FileMapping", "Message from keyhook.dll", 0);
Exit;
end;

{отображаем глобальные данные на АП вызывающего процесса и получаем указатель
на начало выделенного пространства}
GlobalData:= MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalDLLData));
if GlobalData = nil then
begin
CloseHandle(MMFHandle);
MessageBox(0, "Can""t make MapViewOfFile", "Message from keyhook.dll", 0);
Exit;
end;

end;

procedure CloseGlobalData();
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MMFHandle);
end;

procedure DLLEntryPoint(dwReason: DWord); stdcall;
begin
case dwReason of
DLL_PROCESS_ATTACH: OpenGlobalData;
DLL_PROCESS_DETACH: CloseGlobalData;
end;
end;

exports hook;

begin
//MessageBox(0, PChar(Application.ExeName), "Message from keyhook.dll", 0);
{назначим поцедуру переменной DLLProc}
DLLProc:= @DLLEntryPoint;
{вызываем назначенную процедуру для отражения факта присоединения данной
библиотеки к процессу}
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

← →
BlackSun (2003-01-08 18:22) [3]

Юрий, вы не знаете? Почему-то не отвечаете...

← →
Набережных С. (2003-01-08 21:35) [4]

Для начала разберись, что такое hInstance, и может ли оно имееть какой-то смысл в адресном пространстве другого приложения. А кроме того, GetModuleFileName работает только с модулями вызывающего приложения, если я правильно помню.

← →
Набережных С. (2003-01-08 21:43) [5]

Ну разумеется, только вызывающего. что-то тормознул

← →
BlackSun (2003-01-09 14:02) [6]

Как же мне тогда решить поставленную задачу?

← →
Набережных С. (2003-01-09 14:04) [7]

Для начала ее сформулируй поконкретнее.

← →
Игорь Шевченко (2003-01-09 14:05) [8]

Если для XP, то в кладовке в разделе "Готовые программы" лежит программа EnumFunctions, получающая имя файла, создавшего окно.
Без всяких хуков :-)

С уважением,

← →
slpro (2003-01-09 14:55) [9]

Присылайте Пиво на @mail ,а я вам процедуру.
Если долго не найдете , пишите на мыло , долго искать!

← →
slpro (2003-01-09 15:03) [10]

function GetFileNameWinNT(ProcessId: THandle): string;
type
TPath = array [0..MAX_PATH - 1] of char;
var
i: Integer;
hProcess, cRequest, cModules : THandle;
hModules : array of THandle;
Buffer: TPath;
begin
try
FillChar(Buffer, sizeof(Buffer), #0);
hProcess:=OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId);
if hProcess > 0 then
try
cRequest := 96; cModules := 0;
repeat
SetLength(hModules, cRequest div 4);
if not EnumProcessModules(hProcess, PDWord(Pointer(@hModules)^), cRequest, cModules) then Break;
if cModules < cRequest then Break else cRequest := cRequest shl 1;
until False;
cModules := cModules div 4;
for i := 0 to cModules - 1 do
begin
if GetModuleFileNameEx(hProcess, hModules[i], Buffer, sizeof(Buffer)) > 0 then
begin
SetString(Result, Buffer, StrLen(Buffer));
if (CompareText(ExtractFileExt(Result), ".EXE") = 0) or (CompareText(ExtractFileExt(Result), ".COM") = 0) then
begin
Result:=Result;
Exit;
end;
end
end;
finally
CloseHandle(hProcess);
end;
Result:=ExtractFileName(Result);
except
Result:="";
end;
end;

Вот это вам!:)

← →
BlackSun (2003-01-09 15:17) [11]

Спасибо! Попробую, только похоже это только для NT?

← →
slpro (2003-01-10 12:32) [12]

Для 9х.

function GetFileNameWin9x(ProcessId: THandle): string;
var
hSnapshot : THandle;
ModuleEntry : TModuleEntry32;
begin
try
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPALL, ProcessID);
if hSnapshot > 0 then
try
ModuleEntry.dwSize := SizeOf(ModuleEntry);
if Module32First(hSnapshot, ModuleEntry) then
repeat
SetString(Result, ModuleEntry.szExePath, StrLen(ModuleEntry.szExePath));
if (CompareText(ExtractFileExt(Result), ".EXE") = 0) or (CompareText(ExtractFileExt(Result), ".COM") = 0) then
begin
Result:=Result;
Exit;
end;
until not Module32Next(hSnapshot, ModuleEntry);
Result:=Result;
finally
CloseHandle(hSnapshot);
end;
except
Result:="";
end;
end;

Не могу получить имя файла по хэндлу... Найти похожие ветки