[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 599
  • Last Modified:

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_,time_,task,DBname:String;
 i:integer;
  F6 : file of TPrograma;
begin
     GetWindowsDirectory(windir, 255);
     DBname:=windir+'\db_'+GetLocalUserName+'_buf.wm';
     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.action;
        buff_windtext:=Programa.windtext;
        buff_other:=Programa.other;
     end;
     closefile(F6);
  date_:=FormatDateTime('yyyy-mm-dd', Date+Time);
  time_:=FormatDateTime('hh:nn:ss', Date+Time);
  full_date:=FormatDateTime('dd/mm/yyyy 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(Wnd, windp, 255);
    task:=ExtractFileName(windp);
    if (titles(task)=true) then begin
     log_dll('TITLE -> '+time_+windtext);
        SaveData(buff_date,buff_start_time,time_,buff_task,buff_action,buff_windtext,buff_other);
        BufferData(date_,time_,task,'OPEN',windtext,IntToStr(Wnd));
    end;
  end;
  HSHELL_WINDOWACTIVATED:
   begin  // ======================== OPEN ==========================
    Wnd := wParam;
    GetWindowText(Wnd, windtext, 255);
    GetWindowModuleFileName(Wnd, windp, 255);
    task:=ExtractFileName(windp);
       log_dll('OPEN -> '+time_+windtext);
        SaveData(buff_date,buff_start_time,time_,buff_task,buff_action,buff_windtext,buff_other);
        BufferData(date_,time_,task,'OPEN',windtext,IntToStr(Wnd));
   end;
0
andrezzz
Asked:
andrezzz
  • 4
  • 3
1 Solution
 
Slick812Commented:
hello  andrezzz, , I will first say that I do not think your version of the hook callback function has the correct parameter Types, This is a system function and all of the parameters should be 32 bit. . . you have -

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)
0
 
andrezzzAuthor Commented:
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 ?
0
 
andrezzzAuthor Commented:
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_CALLWNDPROC}, @SysMsgProc, HInstance, 0);
      Result := (SysHook <> 0);
    end
  else
    begin
      if SysHook <> 0
      then
        begin
          UnhookWindowsHookEx(SysHook);
          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
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Slick812Commented:
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_WRITE, 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_Attach);
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_DoShellHookClick(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_WRITE, 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_StopShHookClick(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
0
 
Slick812Commented:
sorry I left some code out, the Form code shold be

  private
    { Private declarations }
    hLibShell, hMemFile: THandle;
    pMapRec1: PMapRec;
    procedure DllMsg(var Msg1: TMessage); message WM_USER+765;


and the post message recieving procedure -


procedure TForm1.DllMsg(var Msg1: TMessage);
var
arChar: Array[Byte] of Char;
LocalTime: _SystemTime;
FileName: String;
fStream: TFileStream;
fMode: Word;

  procedure WriteLnFS(Text: String; Tab: Boolean = False);
  begin
  if Tab then
    Text := #9+Text+#13#10
    else
    Text := Text+#13#10;
  fStream.WriteBuffer(Text[1], Length(Text));
  end;


begin
Msg1.Result := 0;
if not (Msg1.LParam in [0,1,2,3]) then Exit;
if FileExists('H:\User Shell Activity.txt') then
  fMode := fmOpenWrite
  else
  fMode := fmCreate;
fStream := TFileStream.Create('H:\User Shell Activity.txt', fMode);

try
  fStream.Seek(0, soFromEnd);
  case Msg1.LParam of
    0: WriteLnFS('Redraw');
    1: WriteLnFS('Activate');
    2: WriteLnFS('Open');
    3: WriteLnFS('Close');
    end;

  GetWindowText(Msg1.wParam, arChar, MaxByte);
  WriteLnFS(arChar, true);
  WriteLnFS(IntToStr(Msg1.wParam), true);
  if pMapRec1 <> nil then
    begin
    Filename := pMapRec1.Strc;
    //FileName := ExtractFileName(FileName);
    end else FileName := 'NIL';
  WriteLnFS(FileName, true);
  GetLocalTime(LocalTime);
  WriteLnFS(IntToStr(LocalTime.wYear)+'\'+IntToStr(LocalTime.wMonth)+
          '\'+IntToStr(LocalTime.wDay), true);
  WriteLnFS(IntToStr(LocalTime.wHour)+':'+IntToStr(LocalTime.wMinute)+
          ':'+IntToStr(LocalTime.wSecond), true);

  finally
  FreeAndNil(fStream);
  end;
end;
0
 
andrezzzAuthor Commented:
my programm is service without forms. dll dont send data to the TForm1.DllMsg(var Msg1: TMessage) :/
0
 
andrezzzAuthor Commented:
my programm is service without forms. dll dont send data to the TForm1.DllMsg(var Msg1: TMessage) :/
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now