andrezzz
asked on
dll not working...
I have dll file with hook on windows openings and title change.
the main program start this hook and after check data file for saved data from this dll file. the saving is in SaveData function.
THE PROBLEM. the program work correctly some time, but after some time it stops. the SaveData function don't save data. the effect like hook stoped. maybe in dll file is some error that stops it ???? please help me to find out this problem.
the log_dll is functions that log information to file.
there is part of dll file:
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var //export;
windtext,windtext3, windir,windp: array [0..255] of char;
str,stra,full_date,date_,t ime_,task, DBname:Str ing;
i:integer;
F6 : file of TPrograma;
begin
GetWindowsDirectory(windir , 255);
DBname:=windir+'\db_'+GetL ocalUserNa me+'_buf.w m';
AssignFile(F6, DBname);
if FileExists(DBname) then begin
{$I-}
Reset(F6);
Seek(F6, 0);
{$I+}
end else begin
{$I-}
ReWrite(F6);
Seek(F6, 0);
{$I+}
end;
//if IOResult <> 0 then log_dll('Errors ar failu '+DBname+'. IOResult '+inttostr(IOResult));
if IOResult <> 0 then ShowMessage('Errors ar failu '+DBname+'. IOResult '+inttostr(IOResult));
if filesize(F6)<>0 then begin
Read (F6, Programa);
buff_date:=Programa.date;
buff_start_time:=Programa. start_time ;
buff_task:=Programa.task;
buff_action:=Programa.acti on;
buff_windtext:=Programa.wi ndtext;
buff_other:=Programa.other ;
end;
closefile(F6);
date_:=FormatDateTime('yyy y-mm-dd', Date+Time);
time_:=FormatDateTime('hh: nn:ss', Date+Time);
full_date:=FormatDateTime( 'dd/mm/yyy y hh:nn:ss', Date+Time);
Result := CallNextHookEx(SysHook, Code, wParam, lParam);
case code of
HSHELL_REDRAW:
begin // ======================== TITLE ==========================
Wnd := wParam;
GetWindowText(Wnd, windtext, 255);
GetWindowModuleFileName(Wn d, windp, 255);
task:=ExtractFileName(wind p);
if (titles(task)=true) then begin
log_dll('TITLE -> '+time_+windtext);
SaveData(buff_date,buff_st art_time,t ime_,buff_ task,buff_ action,buf f_windtext ,buff_othe r);
BufferData(date_,time_,tas k,'OPEN',w indtext,In tToStr(Wnd ));
end;
end;
HSHELL_WINDOWACTIVATED:
begin // ======================== OPEN ==========================
Wnd := wParam;
GetWindowText(Wnd, windtext, 255);
GetWindowModuleFileName(Wn d, windp, 255);
task:=ExtractFileName(wind p);
log_dll('OPEN -> '+time_+windtext);
SaveData(buff_date,buff_st art_time,t ime_,buff_ task,buff_ action,buf f_windtext ,buff_othe r);
BufferData(date_,time_,tas k,'OPEN',w indtext,In tToStr(Wnd ));
end;
the main program start this hook and after check data file for saved data from this dll file. the saving is in SaveData function.
THE PROBLEM. the program work correctly some time, but after some time it stops. the SaveData function don't save data. the effect like hook stoped. maybe in dll file is some error that stops it ???? please help me to find out this problem.
the log_dll is functions that log information to file.
there is part of dll file:
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
var //export;
windtext,windtext3, windir,windp: array [0..255] of char;
str,stra,full_date,date_,t
i:integer;
F6 : file of TPrograma;
begin
GetWindowsDirectory(windir
DBname:=windir+'\db_'+GetL
AssignFile(F6, DBname);
if FileExists(DBname) then begin
{$I-}
Reset(F6);
Seek(F6, 0);
{$I+}
end else begin
{$I-}
ReWrite(F6);
Seek(F6, 0);
{$I+}
end;
//if IOResult <> 0 then log_dll('Errors ar failu '+DBname+'. IOResult '+inttostr(IOResult));
if IOResult <> 0 then ShowMessage('Errors ar failu '+DBname+'. IOResult '+inttostr(IOResult));
if filesize(F6)<>0 then begin
Read (F6, Programa);
buff_date:=Programa.date;
buff_start_time:=Programa.
buff_task:=Programa.task;
buff_action:=Programa.acti
buff_windtext:=Programa.wi
buff_other:=Programa.other
end;
closefile(F6);
date_:=FormatDateTime('yyy
time_:=FormatDateTime('hh:
full_date:=FormatDateTime(
Result := CallNextHookEx(SysHook, Code, wParam, lParam);
case code of
HSHELL_REDRAW:
begin // ======================== TITLE ==========================
Wnd := wParam;
GetWindowText(Wnd, windtext, 255);
GetWindowModuleFileName(Wn
task:=ExtractFileName(wind
if (titles(task)=true) then begin
log_dll('TITLE -> '+time_+windtext);
SaveData(buff_date,buff_st
BufferData(date_,time_,tas
end;
end;
HSHELL_WINDOWACTIVATED:
begin // ======================== OPEN ==========================
Wnd := wParam;
GetWindowText(Wnd, windtext, 255);
GetWindowModuleFileName(Wn
task:=ExtractFileName(wind
log_dll('OPEN -> '+time_+windtext);
SaveData(buff_date,buff_st
BufferData(date_,time_,tas
end;
ASKER
can you explane this :
I would post a message to the Calling program of the hook (your program), with the Lparam and wParam of the hook function and then do all the file access from a single thread (your program)
can you give one simple example ?
I would post a message to the Calling program of the hook (your program), with the Lparam and wParam of the hook function and then do all the file access from a single thread (your program)
can you give one simple example ?
ASKER
in main program i have
Procedure RunStopHook(State : boolean) stdcall;
external 'sdf.dll' index 1;
in form create i have RunStopHook(true); which start the hook
in sdf.dll is :
function SetHook(Hook : Boolean) : Boolean; export; stdcall;
begin
Result := false;
if Hook
then
begin
if SysHook = 0
then
SysHook := SetWindowsHookEx(WH_SHELL{ WH_CBT,WH_ CALLWNDPRO C}, @SysMsgProc, HInstance, 0);
Result := (SysHook <> 0);
end
else
begin
if SysHook <> 0
then
begin
UnhookWindowsHookEx(SysHoo k);
SysHook := 0;
Result := true;
end;
end;
end;
-------------------------- ---------- ----
when programs runs about 10 minits sudednly it stops hooking. when i press button start hook wich have StartStopHook(true); then nothing happens, but if I press STOP hook button and after START hook button (stop hook calls StartStopHook(false) and Start hook button calls StartStopHook(true)) then hook resume his work. why it stops suddenly ??? and after stoping and starting it, it starts again
Procedure RunStopHook(State : boolean) stdcall;
external 'sdf.dll' index 1;
in form create i have RunStopHook(true); which start the hook
in sdf.dll is :
function SetHook(Hook : Boolean) : Boolean; export; stdcall;
begin
Result := false;
if Hook
then
begin
if SysHook = 0
then
SysHook := SetWindowsHookEx(WH_SHELL{
Result := (SysHook <> 0);
end
else
begin
if SysHook <> 0
then
begin
UnhookWindowsHookEx(SysHoo
SysHook := 0;
Result := true;
end;
end;
end;
--------------------------
when programs runs about 10 minits sudednly it stops hooking. when i press button start hook wich have StartStopHook(true); then nothing happens, but if I press STOP hook button and after START hook button (stop hook calls StartStopHook(false) and Start hook button calls StartStopHook(true)) then hook resume his work. why it stops suddenly ??? and after stoping and starting it, it starts again
Here is my code for my version of a Shell Hook, I use a Memory Mapped file to to hold the Form's handle and a Text buffer for the program's file path, which can be way longer than 255 charaters. I do NOT do any file access in the DLL, I do all file writting in the Form that calles the DLL.
the first if the library code for the ShellHook.dll -
library ShellHook;
uses
Windows, Messages;
{$R *.RES}
type
PMapRec = ^TMapRec;
TMapRec = Record
hForm: THandle;
StrC: Array[0..2047] of Char;
end;
const
MapName: PChar = 'Yj(m5%8v3k';
// be sure you use an unusuall MapName so it can not already be used
var
hHook: THandle = 0;
hMemFile: THandle = 0;
hForm: THandle = 0;
pMapRec1: PMapRec = nil;
function SysMsgProc(code, hWnd, NotUsed: Integer): Integer; stdcall;
begin
Result := CallNextHookEx(0, Code, hWnd, NotUsed);
case code of
HSHELL_REDRAW: // Redraw
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 0); // I change the LParam for each different Operation
end;
HSHELL_WINDOWACTIVATED: // Activate
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 1);
end;
HSHELL_WINDOWCREATED: // Open
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 2);
end;
HSHELL_WINDOWDESTROYED: // Closed
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 3);
end;
end;
end;
function SetHook(FormHnd: THandle): Integer; export;
begin
// call SetHook(0); to Unhook the Shell hook
Result := -1;
if IsWindow(FormHnd) then
begin
if hHook = 0 then
hHook := SetWindowsHookEx(WH_SHELL, @SysMsgProc, HInstance, 0) else Exit;
if hHook = 0 then
begin
Result := -2;
Exit;
end;
hMemFile := CreateFileMapping(MAXDWORD , // $FFFFFFFF gets a page memory file
nil, // no security attributes
PAGE_READWRITE, // read/write access
0, // size: high 32-bits
SizeOf(TMapRec), // size: low 32-bits
MapName); // name of map object
pMapRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if pMapRec1 <> nil then
begin
hForm := FormHnd;
pMapRec1^.hForm := FormHnd;
Result := 0;
end else
begin
UnhookWindowsHookEx(hHook) ;
Result := -3;
end;
end else // IsWindow(FormHnd)
if hHook <> 0 then
begin
if UnhookWindowsHookEx(hHook) then
begin
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
pMapRec1 := nil;
CloseHandle(hMemFile);
end;
hHook := 0;
Result := 1;
end else
Result := -4;
end else Result := -5;
end;
procedure EntryProc(dwReason : DWORD);
begin
if (dwReason = Dll_Process_Attach) then
begin
hMemFile := OpenFileMapping(FILE_MAP_W RITE, False, MapName);
if hMemFile > 0 then
pMapRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if pMapRec1 <> nil then
begin
hForm := pMapRec1.hForm;
end;
end;
if (dwReason = Dll_Process_Detach) then
begin
if hHook <> 0 then
begin
UnhookWindowsHookEx(hHook) ;
hHook := 0;
end;
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
CloseHandle(hMemFile);
end;
end;
end;
exports
SetHook;
begin
DLLProc := @EntryProc;
EntryProc(Dll_Process_Atta ch);
end.
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
next is the code in my form Form1
type
PMapRec = ^TMapRec;
TMapRec = Record // same record as in DLL
hForm: THandle;
StrC: Array[0..2047] of Char;
end;
TForm1 = class(TForm)
sbut_DoShellHook: TSpeedButton;
sbut_StopShHook: TSpeedButton;
private
{ Private declarations }
hLibShell, hMemFile: THandle;
pMapRec1: PMapRec;
procedure TForm1.FormCreate(Sender: TObject);
begin
hLibShell := 0;
pMapRec1 := nil;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
CloseHandle(hMemFile);
pMapRec1 := nil;
end;
end;
procedure TForm1.sbut_DoShellHookCli ck(Sender: TObject);
var
SetHook: function(FormHnd: THandle): Integer;
begin
// button click to start the Shell Hook
hLibShell := LoadLibrary('ShellHook.dll ');
if hLibShell = 0 then
begin
Showmessage('ERROR - Could not Load Library ShellHook.dll');
Exit;
end;
@SetHook := GetProcAddress(hLibShell, 'SetHook');
if @SetHook = nil then
begin
FreeLibrary(hLibShell);
hLibShell := 0;
Showmessage('ERROR - Could not Get DLL function');
Exit;
end;
if SetHook(Handle) <> 0 then
begin
FreeLibrary(hLibShell);
hLibShell := 0;
Showmessage('ERROR - Could not Start the Shell Hook');
end;
hMemFile := OpenFileMapping(FILE_MAP_W RITE, False, 'Yj(m5%8v3k');
// you must use the same MapName as in your DLL
if hMemFile > 0 then
pMapRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if pMapRec1 = nil then
Showmessage('ERROR - pMapRec1 is NIL');
end;
procedure TForm1.sbut_StopShHookClic k(Sender: TObject);
var
SetHook: function(FormHnd: THandle): Integer;
begin
// button click to stop the Shell Hook
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
CloseHandle(hMemFile);
pMapRec1 := nil;
end;
if hLibShell = 0 then
begin
Showmessage('ERROR - Library ShellHook.dll is Not Loaded');
Exit;
end;
@SetHook := GetProcAddress(hLibShell, 'SetHook');
if @SetHook = nil then
begin
FreeLibrary(hLibShell);
hLibShell := 0;
Showmessage('ERROR - Could not Get DLL function');
Exit;
end;
if SetHook(0) <> 1 then
Showmessage('ERROR - Shell Hook not running');
FreeLibrary(hLibShell);
hLibShell := 0;
end;
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
I believe that is all of the code needed, although you may need some other units in your uses clause, but I do not think so. . . . .
I ran this shell hook for more than 30 minutes on a windows XP machine, and it worked for all shell activity the entire time, and did not stop untill I pressed the Stop Hook button. . . .
I noticed that you posted another question here at
dll not working II ....
and got only one comment, I do not beleive that robert_marquardt is correct about the SysHook variable, I have read about and used (in my code above) the
CallNextHookEx(0, Code, hWnd, NotUsed);
I think it should just have a Zero as the System Hook handle, the system Hook handle is old left over requirements from the windows 16-Bit (windows 3.1) days, It seems that the current 32-bit systems are not stupid enough to religh on a dummy coder to return the correct hook handle in order to function right, I would think the current systems are smart enough keep tract of their hooks internally. . .
anyway the Borland Code Central entry 15387 has a working program to "Hack" a Delphi executable and insert a "Shared" memory segment, but you can do it with a Memory mapped file, so you do not really need that
I hope this code will give you some help for your project
the first if the library code for the ShellHook.dll -
library ShellHook;
uses
Windows, Messages;
{$R *.RES}
type
PMapRec = ^TMapRec;
TMapRec = Record
hForm: THandle;
StrC: Array[0..2047] of Char;
end;
const
MapName: PChar = 'Yj(m5%8v3k';
// be sure you use an unusuall MapName so it can not already be used
var
hHook: THandle = 0;
hMemFile: THandle = 0;
hForm: THandle = 0;
pMapRec1: PMapRec = nil;
function SysMsgProc(code, hWnd, NotUsed: Integer): Integer; stdcall;
begin
Result := CallNextHookEx(0, Code, hWnd, NotUsed);
case code of
HSHELL_REDRAW: // Redraw
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 0); // I change the LParam for each different Operation
end;
HSHELL_WINDOWACTIVATED: // Activate
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 1);
end;
HSHELL_WINDOWCREATED: // Open
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 2);
end;
HSHELL_WINDOWDESTROYED: // Closed
begin
if pMapRec1 <> nil then
GetModuleFileName(0, pMapRec1.Strc, SizeOf(pMapRec1.Strc));
PostMessage(hForm, WM_USER+765, hWnd, 3);
end;
end;
end;
function SetHook(FormHnd: THandle): Integer; export;
begin
// call SetHook(0); to Unhook the Shell hook
Result := -1;
if IsWindow(FormHnd) then
begin
if hHook = 0 then
hHook := SetWindowsHookEx(WH_SHELL,
if hHook = 0 then
begin
Result := -2;
Exit;
end;
hMemFile := CreateFileMapping(MAXDWORD
nil, // no security attributes
PAGE_READWRITE, // read/write access
0, // size: high 32-bits
SizeOf(TMapRec), // size: low 32-bits
MapName); // name of map object
pMapRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if pMapRec1 <> nil then
begin
hForm := FormHnd;
pMapRec1^.hForm := FormHnd;
Result := 0;
end else
begin
UnhookWindowsHookEx(hHook)
Result := -3;
end;
end else // IsWindow(FormHnd)
if hHook <> 0 then
begin
if UnhookWindowsHookEx(hHook)
begin
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
pMapRec1 := nil;
CloseHandle(hMemFile);
end;
hHook := 0;
Result := 1;
end else
Result := -4;
end else Result := -5;
end;
procedure EntryProc(dwReason : DWORD);
begin
if (dwReason = Dll_Process_Attach) then
begin
hMemFile := OpenFileMapping(FILE_MAP_W
if hMemFile > 0 then
pMapRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if pMapRec1 <> nil then
begin
hForm := pMapRec1.hForm;
end;
end;
if (dwReason = Dll_Process_Detach) then
begin
if hHook <> 0 then
begin
UnhookWindowsHookEx(hHook)
hHook := 0;
end;
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
CloseHandle(hMemFile);
end;
end;
end;
exports
SetHook;
begin
DLLProc := @EntryProc;
EntryProc(Dll_Process_Atta
end.
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
next is the code in my form Form1
type
PMapRec = ^TMapRec;
TMapRec = Record // same record as in DLL
hForm: THandle;
StrC: Array[0..2047] of Char;
end;
TForm1 = class(TForm)
sbut_DoShellHook: TSpeedButton;
sbut_StopShHook: TSpeedButton;
private
{ Private declarations }
hLibShell, hMemFile: THandle;
pMapRec1: PMapRec;
procedure TForm1.FormCreate(Sender: TObject);
begin
hLibShell := 0;
pMapRec1 := nil;
end;
procedure TForm1.FormDestroy(Sender:
begin
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
CloseHandle(hMemFile);
pMapRec1 := nil;
end;
end;
procedure TForm1.sbut_DoShellHookCli
var
SetHook: function(FormHnd: THandle): Integer;
begin
// button click to start the Shell Hook
hLibShell := LoadLibrary('ShellHook.dll
if hLibShell = 0 then
begin
Showmessage('ERROR - Could not Load Library ShellHook.dll');
Exit;
end;
@SetHook := GetProcAddress(hLibShell, 'SetHook');
if @SetHook = nil then
begin
FreeLibrary(hLibShell);
hLibShell := 0;
Showmessage('ERROR - Could not Get DLL function');
Exit;
end;
if SetHook(Handle) <> 0 then
begin
FreeLibrary(hLibShell);
hLibShell := 0;
Showmessage('ERROR - Could not Start the Shell Hook');
end;
hMemFile := OpenFileMapping(FILE_MAP_W
// you must use the same MapName as in your DLL
if hMemFile > 0 then
pMapRec1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if pMapRec1 = nil then
Showmessage('ERROR - pMapRec1 is NIL');
end;
procedure TForm1.sbut_StopShHookClic
var
SetHook: function(FormHnd: THandle): Integer;
begin
// button click to stop the Shell Hook
if pMapRec1 <> nil then
begin
UnmapViewOfFile(pMapRec1);
CloseHandle(hMemFile);
pMapRec1 := nil;
end;
if hLibShell = 0 then
begin
Showmessage('ERROR - Library ShellHook.dll is Not Loaded');
Exit;
end;
@SetHook := GetProcAddress(hLibShell, 'SetHook');
if @SetHook = nil then
begin
FreeLibrary(hLibShell);
hLibShell := 0;
Showmessage('ERROR - Could not Get DLL function');
Exit;
end;
if SetHook(0) <> 1 then
Showmessage('ERROR - Shell Hook not running');
FreeLibrary(hLibShell);
hLibShell := 0;
end;
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
I believe that is all of the code needed, although you may need some other units in your uses clause, but I do not think so. . . . .
I ran this shell hook for more than 30 minutes on a windows XP machine, and it worked for all shell activity the entire time, and did not stop untill I pressed the Stop Hook button. . . .
I noticed that you posted another question here at
dll not working II ....
and got only one comment, I do not beleive that robert_marquardt is correct about the SysHook variable, I have read about and used (in my code above) the
CallNextHookEx(0, Code, hWnd, NotUsed);
I think it should just have a Zero as the System Hook handle, the system Hook handle is old left over requirements from the windows 16-Bit (windows 3.1) days, It seems that the current 32-bit systems are not stupid enough to religh on a dummy coder to return the correct hook handle in order to function right, I would think the current systems are smart enough keep tract of their hooks internally. . .
anyway the Borland Code Central entry 15387 has a working program to "Hack" a Delphi executable and insert a "Shared" memory segment, but you can do it with a Memory mapped file, so you do not really need that
I hope this code will give you some help for your project
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
my programm is service without forms. dll dont send data to the TForm1.DllMsg(var Msg1: TMessage) :/
ASKER
my programm is service without forms. dll dont send data to the TForm1.DllMsg(var Msg1: TMessage) :/
function SysMsgProc(code : integer; wParam : word; lParam : longint) : longint; stdcall;
this seem a strange mix of types? where did you get this from? You have "Integer" and "longint" and "word" types
I believe it should be -
function SysMsgProc(code, wParam, lParam : longint) : longint; stdcall;
or
function SysMsgProc(code, wParam, lParam : Integer) : Integer; stdcall;
in Delphi4 or newer
- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
and I beleive it would be better coding methods to NOT do file access in your Hook DLL, all of the DLLs are runing in separate processes, if there is simulanious access to a file from two different processes, then there is conflick
I would post a message to the Calling program of the hook (your program), with the Lparam and wParam of the hook function and then do all the file access from a single thread (your program)