Oggi non ho proprio niente da fare, ho acceso la televisione e non c' è niente, poi ho acceso la radio (e c' è sempre la stessa roba), poi ho fatto un giro in bici e si è messo a piovere e poi ... e poi mi sono rotto i cogl... Bene questo preambolo per introdurre le motivazioni fondamentali che mi hanno portato alla stesura delle ca...te che andrò ad elencare di seguito. Dunque l' obiettivo è prendere un programma qualsiasi e modificarne il comportamento ad esempio in corrispondenza della pressione di alcuni tasti, impedirne la chiusura, etc..  In alcuni articoli precedenti ho parlato di dll injection, di system hooks ... in linea di massima il concetto chiave è mappare del codice nello spazio di memoria del processo che ci interessa ed eseguire tale codice per giungere ad un certo livello di personalizzazione del processo in questione. Naturalmente non si può pretendere di usare questa tecnica in tutte le situazioni e per tutti gli obiettivi possibili ed immaginabili; vi sono contesti in cui senza il sorgente del programma si fa veramente fatica a cavarci gli zampetti, tuttavia qualcosa di interessante può essere raggiunto. Bene, anzitutto per mappare il codice nello spazio di memoria del processo in esame, utilizzeremo la tecnica di dll injection: il codice verrà scritto in una dll e poi eseguito nel contesto del processo destinazione; con un procedimento analogo andremo a eliminare la dll dallo spazio di memoria del processo remoto. Vediamo come procedere con il mapping e l' unmapping di una dll nello spazio di memoria di un processo: dato il PID (Process identifier) di un processo ed il nome di una dll (comprensivo di percorso completo) possiamo utilizzare la seguente funzione per mappare la dll nello spazio di memoria del processo

function InjectDll(PID: dword;  DLL: pChar): LongWord;
var
  BytesWritten, Process, Thread, ThreadId: dword;
  Paramaters: pointer;
begin

  Result := 0;

  //conferisco, al processo che chiama la funzione, il privilegio
  //di debug
  ModificaPrivilegio('SeDebugPrivilege', TRUE);

  //ottengo un handle al processo destinazione (identificato da PID);
  //specifico come valore del primo parametro della OpenProcess un elenco
  //di privilegi di accesso al processo in questione tali da consentirmi
  //le operazioni che andrò ad eseguire di seguito. Basta consultare il Platform
  //SDK e cercare le funzioni successive per vedere con quali diritti di accesso
  //un processo debba essere aperto per consentire appunto l' esecuzione di
  //ciascuna di esse
  Process := OpenProcess(PROCESS_CREATE_THREAD +
                         PROCESS_QUERY_INFORMATION +
                         PROCESS_VM_OPERATION +
                         PROCESS_VM_WRITE +
                         PROCESS_VM_READ,
                         False,
                         PID
                         );

  //vado ad allocare della memoria nello spazio di memoria del processo destinazione
  //(identificato dall' handle Process). Tale fetta di memoria deve contenere una
  //stringa che definisce il nome della dll che si vuole mappare (comprensivo di
  //percorso completo). Quindi la sua dimensione sarà data da Length(DLL). Mi
  //viene restituito (Paramaters) l' indirizzo (nel contesto del processo destinazione)
  //a partire dal quale è presente tale area di memoria
  Paramaters := VirtualAllocEx(
                               Process,
                               nil,
                               Length(DLL),
                               MEM_COMMIT,
                               PAGE_READWRITE);

  //vado a scrivere nella fetta di memoria (appena allocata nel processo
  //destinazione tramite VirtualAllocEx) la stringa che definisce il nome della
  //dll da mappare (comprensivo di percorso completo). Gli passerò l' handle
  //del processo destinazione (Process, ottenuto tramite OpenProcess), l' indirizzo
  //di partenza dell' area di memoria allocata per inserirvi il nome della dll da
  //mappare (Paramaters, ottenuto tramite VirtualAllocEx), l' indirizzo a partire
  //da quale è memorizzato il nome della dll nel contesto del processo corrente
  //(Pointer(DLL)), la dimensione dei dati da copiare (Lenght(DLL))
  WriteProcessMemory(Process,
                     Paramaters,
                     Pointer(DLL),
                     Length(DLL),
                     BytesWritten);

  //Bene, ora che ho copiato il nome della dll nello spazio di memoria del processo
  //remoto, posso creare un thread nel processo remoto: tale thread consiste
  //nell' esecuzione di LoadLibraryA passando come parametro il nome della dll:
  //in parole povere il caricamento della dll nello spazio di memeoria del processo
  //remoto. Il parametri fondamentali sono: l' handle del processor remoto (Process,
  //ottenuto tramite OpenProcess), l' indirizzo a partire dal quale è implementata
  //l' api LoadLibraryA (il 4° parametro), l' indirizzo a partire dal quale è
  //memrizzato il nome della dll comprensivo di percorso completo (Paramaters).
  //Da notare che quando si parla di indirizzo di una funzione da invocare nel
  //contesto di un processo remoto (nel caso specifico l' api LoadLibraryA) si parla
  //di indirizzo nello spazio di memoria del processo remoto; il 4° parametro della
  //CreateRemoteThread è l' indirizzo dell' api LoadLibraryA nel contesto del processo
  //corrente e di conseguenza nasce il dubbio sulla validità; il linea di massima una dll
  //non viene sempre caricata allo stesso indirizzo nel' ambito di un processo e di
  //conseguenza anche l' indirizzo delle funzioni esportate dalla dll medesima può
  //variare di volta in volta (in quanto è soggetto a variazione l' indirizzo di base
  //di caricamento di una dll nello spazio di memoria di un processo). Tuttavia la dll
  //kernel32.dll fa eccezione in quanto viene caricata sempre allo stesso indirizzo. Più
  //precisamente tutte le dll hanno un indirizzo di preferenza a partire dal quale possono
  //essere caricate ma sono soggette alla cosidetta rilocazione (variazione sull' indirizzo
  //base di caricamento rispetto al valore desiderato) in relazione al contesto. La dll
  //kernel32.dll non è soggetta ad alcuna rilocazione. Se si provasse a forzare il suo
  //caricamento in altri indirizzi si otterrebbe immediatamente un errore irreversibile
  Thread := CreateRemoteThread(Process,
                               nil,
                               0,
                               GetProcAddress(GetModuleHandle('KERNEL32.DLL'), 'LoadLibraryA'),
                               Paramaters,
                               0,
                               ThreadId);


  //mi metto in attesa della terminazione del Thread innescato nel processo remoto
  //tramite CreateRemoteThread. L' handle del Thread è stato restituito dalla
  //CreateRemoteThread. Non ci sono interruzioni all' attesa diverse dalla terminazione
  //del thread medesimo (time out infinito: secondo parametro è INFINITE)
  WaitForSingleObject(Thread, INFINITE);

  //una volta terminato il thread remoto copio come output della funzione DllInject
  //il codice di uscita del thread in questione: si tratta del codice di uscita della
  //funzione che mi ha definito il thread ossia LoadLibraryA e quindi altro non è il
  //valore restituito da LoadLibraryA ossia l' handle della dll caricata.
  GetExitCodeThread(Thread, Result);

  //libero la memoria allocata nel processo remoto (che contiene il nome della DLL)
  //come parametri avrò naturalmente l' handle del processo remoto (Process, ottenuto
  //tramite OpenProcess) e Paramaters che è appunto l' indirizzo (nel contesto del
  //processo remoto) a partire dal quale è memorizzato il nome della Dll   
  VirtualFreeEx(Process,
                Paramaters,
                0,
                MEM_RELEASE);

  //chiudo gli handle al processo remoto (Process) ed al thread creato nel processo
  //remoto (Thread)
  CloseHandle(Thread);

  CloseHandle(Process);

end;

procedure ModificaPrivilegio(szPrivilege: pChar; fEnable: Boolean);
var
  NewState: TTokenPrivileges;
  luid: TLargeInteger;
  hToken: THandle;
  ReturnLength: DWord;

begin
  //apro il token di accesso asociato al processo corrente (il cui handle
  //è ottenuto tramite GetCurrentProcess. Specifico TOKEN_ADJUST_PRIVILEGES
  //come tipo di accesso al Token: in questa maniera sono in grado di abilitare
  //e/o disabilitare Privilegi. hToken è l' handle del token di accesso appena
  //aperto.
  OpenProcessToken(
                  GetCurrentProcess(),
                  TOKEN_ADJUST_PRIVILEGES,
                  hToken);
  //ricavo il LUID (Locally Unique Identifier) corrispondente al privilegio
  //specificato: si tratta in sostanza di un identificativo univoco del privilegio;
  //varia da sessione a sessione ed anche tra un riavvio e l' altro del sistema
  LookupPrivilegeValue(nil, szPrivilege, luid);

  //lavoro su NewState (di tipo TTokenPrivileges). Rappresenta un elenco di privilegi;
  //nel caso specifico conterrà un solo privilegio (ProvilegeCount = 1). L' arrary
  //Privileges contiene oggetti con 2 campi: il luid del privilegio (Luid) ed
  //il livello di abilitazione del medesimo (Attributes)
  NewState.PrivilegeCount := 1;
  NewState.Privileges[0].Luid := luid;
  if fEnable then    //abilitiamo il privilegio
    NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
  else //disabilitiamo il privilegio
    NewState.Privileges[0].Attributes := 0;

  //eseguiamo la modifica sullo stato di abilitazione del privilegio
  //nel contesto del token di accesso aperto
  AdjustTokenPrivileges(
                        hToken,
                        FALSE,
                        NewState,
                        sizeof(NewState),
                        nil,
                        ReturnLength);
                        
  //chiudo l' handle al token di accesso aperto
  CloseHandle(hToken);

end;

function BaseAddrDllProcesso(PID: LongWord; NomeDll: string): PByte;
var
  me: TModuleEntry32;
  hSnap: THandle;
begin
  Result := 0;

  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pid);

  me.dwSize := sizeof(TModuleEntry32);

  //Prelevo informazioni sul primo modulo del processo in questione
  Module32First(hSnap, me);
  repeat  //loop sui moduli
    if LowerCase(me.szModule) = LowerCase(NomeDll) then
      begin
        result := me.modBaseAddr;
        break;
      end;
  until (not (Module32Next(hSnap, me)));

  CloseHandle(hSnap);

end;

A questo punto possiamo definire la procedura per eseguire il free di una dll in un processo remoto 

procedure UninjectDll(PID: dword;  BaseAddrDLL: PByte);
var
  BytesWritten, Process, Thread, ThreadId: dword;
  Paramaters: pointer;
begin

  //ablito il privilegio di debug
  ModificaPrivilegio('SeDebugPrivilege', TRUE);

  //apro il processo remoto
  Process := OpenProcess(PROCESS_CREATE_THREAD +
                         PROCESS_QUERY_INFORMATION +
                         PROCESS_VM_OPERATION +
                         PROCESS_VM_WRITE +
                         PROCESS_VM_READ,
                         False,
                         PID
                         );

  //creo ed eseguo un thread nel processo remoto. A differenza della InjectDll,
  //in questo caso non abbiamo bisogno di copiare l' argomento di input della
  //funzione che mi definisce l' esecuzione del thread (in questo caso FreeLibrary,
  //nel caso precedente LoadLibraryA) in quanto il valore restituito da BaseAddrDll
  //è già un indirizzo valido nel contesto del processo remoto; non c' è quindi più
  //bisogno di allocare memoria (VirtualAllocEx), scrivere nella memoria allocata
  //(WriteProcessMemory) e deallocare la memoria (VirtualFreeEx) nel contesto del processo remoto
  Thread := CreateRemoteThread(Process,
                               nil,
                               0,
                               GetProcAddress(GetModuleHandle('KERNEL32.DLL'), 'FreeLibrary'),
                               BaseAddrDLL,
                               0,
                               ThreadId);

  //mi metto in attesa della terminazione del thread remoto (che consiste appunto in
  //una FreeLibrary sulla dll precedentemente mappata con DllInject
  WaitForSingleObject(Thread, INFINITE);

  //chiudo gli handle al processo remoto (Process) ed al thread creato nell' ambito
  //del processo remoto (Thread)
  CloseHandle(Thread);

  CloseHandle(Process);

end;

function PidProcesso(NomeProcesso: string): LongWord;
var
  pe: TProcessEntry32;
  hSnap: THandle;
begin
  Result := 0;

  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  pe.dwSize := sizeof(TProcessEntry32);

  //Prelevo informazioni sul primo processo nello snapshot di sistema
  Process32First(hSnap, pe);
  repeat  //loop sui processi
    Result := pe.th32ProcessID;
    if (LowerCase(pe.szExeFile) = LowerCase(NomeProcesso)) then
      begin
        break;
      end;
  until (not (Process32Next(hSnap, pe)) ) ;

  CloseHandle(hSnap);

end;

Ohhh, finalmente abbiamo tutti gli strumenti per mappare una dll nello spazio di memoria di un processo e per eseguire il free della stessa. Bene, a questo punto la storiella potrebbe finire qui, argomentazione trattata con esaustività e completezza (stica...) ... Però fuori piove ancora e in sequenza mi sono venute in mente un pò di cose con le quali pasteggiavo nel lontano 2001: la più importante è la possibilità di personalizzare il comportamento di un controllo visuale sostituendo la sua Window Procedure con una versione personalizzata. Un attimo, calma e sangue freddo ... cos' è la Window Procedure di una finestra??? Mmhhh, in sostanza si tratta della procedura che viene chiamata ogni volta che la finestra medesima riceve un messaggio (sia con un SendMessage sia con un PostMessage). Il parametro fondamentale di una Window Procedure è appunto il messaggio: nell' implemetazione della Window Procedure c'è  il classico "case" che raccoglie i vari tipi di messaggi che può ricevere quella finestra ed il conseguente comportamento da adottare in corrispondenza di ogni singolo messaggio. Una Window Procedure è una funzione che ha 4 parametri e restituisce un valore: i 4 parametri rappresentano le caratteristiche del messaggio inviato alla finestra; più precisamente rappresentano rispettivamente l' handle della finestra destinazione, il tipo di messaggio (WM_LBUTTONDOWN, WM_CLOSE, etc...), i 2 parametri LParam e WParam tipici di ogni messaggio (guardare il tipo TMsg nell' help di Delphi per trovare i medesimi elementi). Ora entra in gioco l' api SetWindowLong: questa funzione consente di modificare un attributo di una finestra specifica; la finestra viene identificata dal suo handle e tra gli attributi della medesima c' è appunto anche la Window Procedure; ciò significa che se conosco l' handle di una finestra posso assegnargli una Window Procedure creata da me intercettando quindi tutti i messaggi destinati alla finestra e personalizzandone quindi il comportamento???? La risposta è si ma non sempre; mi spiego meglio: ciò è possibile ma solo nell' ambito delle finestre create dallo stesso processo che esegue l' api SetWindowLong. Se non sbaglio però all' inizio di stà pappardella abbiamo parlato di mapping e unmapping di dll (e quindi di codice da eseguire) nello spazio di memoria di un altro processo. Se l' implementazione della dll consistesse in una chiamata a SetWindowLong passandogli come parametro l' handle di una finestra del processo remoto, riusciremmo a modificare la Window Procedure di una finestra del processo remoto (in quanto la dll è appunto mappata nello spazio di memoria del processo remoto): infatti  proprio perchè la dll è stata mappata, una chiamata a SetWindowLong nella dll equivale ad una chiamata a SetWindowLong eseguita dal processo remoto. E' importantissimo osservare che Il valore restituito dall' api SetWindowLong è il vecchio valore del' attributo che si è andati a modificare. Vediamo ora come avviene la sostituzione della Window Procedure di una finestra

var
  //handle della finestra di cui si vuole personalizzare la Window Procedure
  FHandle: THandle;
  //puntatore alla Window Procedure originale: utilizzato sia per ripristinare
  //la Window Procedure originale, sia per chiamare la medesima nel contesto della
  //nuova Window Procedure (in genere infatti l' implementazione della nuova
  //Window Procedure consiste in una serie di operazioni, quali ad esempio notifiche,
  //etc.. e nella chiamata alla Window Procedure originale)
  OldWindowProc: Pointer;

//nuova Window Procedure
function NewWindowProc(WindowHandle: hWnd;
                       TheMessage: Longint;
                       ParamW: Longint;
                       ParamL: Longint): LongInt; stdcall;
begin
  //elaborazioni varie (notifiche, etc...)
  //se si vuole interrompere qui l' eleaborazione del messaggio
  //allora:

  (* ///////
   result := 0;
   exit;
  *) ///////

  //altrimenti vado a chiamare la Window Procedure originale
  (*NewWindowProc := CallWindowProc(OldWindowProc,
                                  WindowHandle,
                                  TheMessage,
                                  ParamW,
                                  ParamL);
  *)
end;

procedure Modify();
begin
  //imposto la nuova Window Procedure (NewWindowProcedure) e contemporaneamente
  //salvo la vecchia nel puntatore OldWindowProc
  OldWindowProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC, LongInt(@NewWindowProc)));

end;

procedure Restore();
begin
  //ripristino la vecchia Window Procedure (OldWindowProc)
  SetWindowLong(FHandle,
                GWL_WNDPROC,
                LongInt(OldWindowProc));

end;

Ok, a questo punto devo trovare il modo di determinare l' handle della finestra di cui voglio cambiare la Window Procedure. Il discorso non è semplice, o meglio è semplice se si vogliono fare le cose semplici, un pò più complicato altrimenti (il ragionamento non fa una piega). Una funzione che viene spesso usata per trovare l' handle di una finestra è FindWindow. FindWindow consente di determinare l' handle di qualsiasi finestra Top-Level ossia di una finestra che non ha alcuna finestra "parent" (o equivalentemente ha il desktop come finestra parent) dati il nome della finestra ed il nome della classe di implementazione. Per trovare l' handle di una finestra figlia (sempre sfruttando "nome finestra" e "nome classe") occorre l' api FindWindowEx che utilizza i medesimi paramateri utilizzati dall FindWindow con in più l' handle della finestra padre. In linea di massima poi l' enumerazione delle finestre top-level avviene tramite l' api EnumWindows e l' enumerazione delle finestre figlie di una finestra avviene tramite l' api EnumChildWindows. Ok per l' esempio che voglio fare è sufficiente FindWindow. Si ma di quale esempio si tratta??? Bene il mio obiettivo è impedire che venga chiuso "Outlook Express": mi insinuerò nel processo di "Outlook Express" ed andrò a cambiare la Window Procedure della finestra principale; la nuova Window Procedure annullerà l' elaborazione del messaggio WM_CLOSE (che viene inviato alla finestra pincipale dell' applicativo quando si decide di chiudere il medesimo). Ok, ma come ottenere il nome della finestra e la classe di implementazione (parametri da passare a FindWindow) relativamente ad Outlook Express???? Si può utilizzare un ottimo programmino che restituisce le caratteristiche della finestra su cui è posizionato il cursore del mouse: si chiama Window Detective. Utilizzandolo si vede che la finestra principale di "Outlook Express" ha le seguenti caratteristiche:

1)Nome finestra: Outlook Express

2)Nome classe: Outlook Express Browser Class

l' handle della finestra pincipale di Outlook Express si può ottenere quindi tramite la seguente semplice chiamata

FindWindow('Outlook Express Browser Class', 'Outlook Express');

Per impedire la chiusura di Outlook Express dovrò annulare il messaggio WM_CLOSE: la nuova Window Procedure (che andrò a definire nella dll che vado a mappare nel processo remoto (che in questo caso è appunto Outlook Express)) dovrà quindi avere la seguente implementazione

function NewWindowProc(WindowHandle: hWnd;
                       TheMessage: Longint;
                       ParamW: Longint;
                       ParamL: Longint): LongInt; stdcall;
begin
  if Themessage = WM_CLOSE then
    begin
      result := 0;
      exit;
    end;

  NewWindowProc := CallWindowProc(OldWindowProc,
                                  WindowHandle,
                                  TheMessage,
                                  ParamW,
                                  ParamL);
end;

L' unica cosa che manca (e che serve alle procedure DllInject e DllUninject) è il nome del processo di "Outlook Express": detto fatto:

msimn.exe

Bene è tutto. Però prima voglio rimpilzare il programma con qualcos' altro (tanto non ciò un ca**o da fare): quel qualcos' altro è la comunicazione all' applicativo che esegue il mapping e l' unmapping del tentativo di chiusura di "Outlook Express". Come gestire la comunicazione tra i 2 processi??? Behh una buona scelta è quella di usare lo scambio di messaggi usufruendo delle potenzialità del messaggio WM_COPYDATA. Il parametro lParam di questo tipo di messaggio contiene un puntatore ad un record di nome TCopyDataStruct (definito nella unit Windows) dotato di 3 campi. Nel caso specifico vorrò passare una stringa (si possono passare dati di ogni tipo come ad esempio record, ...); si ottiene la seguente procedura che consente l' invio di una stringa ad un altro processo

//funzione per inviare i dati ad un altro processo
procedure InvioDati(str: pChar);
var
  copydata: TCopyDataStruct;
begin
  //campo dwdata: tipologia di dato WM_COPYDATA
  //(serve al receiver per distinguere tra tutti i possibili messaggi WM_COPYDATA
  //che gli possono arrivare: il receiver si comporterà nel seguente modo: se il codice è 199
  //allora faccio questo altrimenti se il codice è (ad esempio) 287 faccio quest' altro e così via.)
  copydata.dwData := 199;
  //dimensione della stringa
  copydata.cbData := Length(str) + 1;
  //indirizzo a partire dal quale è memorizzata la stringa
  copydata.lpData := pChar(str);

  //il programma che esegue il mapping e l' unmapping ha la finestra principale con nome e classe
  //così come sono assegnati di default da Delphi
  SendMessage(FindWindow('TForm1', 'Form1'), WM_COPYDATA, 0, integer(@copydata));
end;

la nuova Window Procedure (che andrò a definire nella dll che vado a mappare nel rpocesso remoto (che in questo caso è appunto Outlook Express) assumerà a questo punto la seguente forma:

//nuova Window Procedure
function NewWindowProc(WindowHandle: hWnd;
                       TheMessage: Longint;
                       ParamW: Longint;
                       ParamL: Longint): LongInt; stdcall;
begin
  if Themessage = WM_CLOSE then
    begin
    //messaggio che invio al mio applicativo
      InvioDati(pChar('tentativo di chiusura dell'' applicazione'));
      result := 0;
      exit;
    end;

  NewWindowProc := CallWindowProc(OldWindowProc,
                                  WindowHandle,
                                  TheMessage,
                                  ParamW,
                                  ParamL);
end;

Analogamente nel programma principale (quello, tanto per intenderci, a cui saranno inviate le notifiche sotto forma di messaggio WM_COPYDATA) ci deve essere una procedura di gestione del messaggio WM_COPYDATA. Nella dichiarazione della TForm1 (nella sezione "private") inseriremo la procedura di gestione del messaggio

type
  TForm1 = class(TForm)
.....
  private
    { Private declarations }
    procedure WMCopyData(Var msg: TWMCopyData); message WM_COPYDATA;
  public
    { Public declarations }
  end;

procedure TForm1.WMCopyData(Var msg: TWMCopyData);
begin
  Case msg.Copydatastruct^.dwData of
    199:
      begin
        //la form dispone di un controllo TMemo in cui andiamo
        //ad inserire il contenuto del messaggio
        Memo1.Lines.Add(pChar(msg.CopyDataStruct^.lpData));
      end;
  end;

end;

Ok adesso è proprio tutto. Di seguito il sorgente del programma e della dll

unit Main;

interface

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

  ProcessUtilities;

type
  TForm1 = class(TForm)
    btInject: TButton;
    btUninject: TButton;
    Memo1: TMemo;
    procedure btInjectClick(Sender: TObject);
    procedure btUninjectClick(Sender: TObject);
  private
    { Private declarations }
    procedure WMCopyData(Var msg: TWMCopyData); message WM_COPYDATA;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  PID: LongWord;
  DllBaseAddr: PByte;

implementation

{$R *.dfm}

procedure TForm1.WMCopyData(Var msg: TWMCopyData);
begin
  Case msg.Copydatastruct^.dwData of
    199:
      begin
        Memo1.Lines.Add(pChar(msg.CopyDataStruct^.lpData));
      end;
  end;

end;

procedure TForm1.btInjectClick(Sender: TObject);
begin
  PID := PidProcesso('msimn.exe');
  InjectDll(PID, pAnsiChar(GetCurrentDir + '\HookDll.dll'));

  MessageDlg('La dll HookDll.dll è stata mappata e ' +
             'non è più possibile chiudere Outlook Express',
             mtInformation,
             [mbOK],
             0);
end;

procedure TForm1.btUninjectClick(Sender: TObject);
begin
  //
  DllBaseAddr := BaseAddrDllProcesso(PID, 'HookDll.dll');
  UninjectDll(PID, DllBaseAddr);

  MessageDlg('La dll HookDll.dll è stata deallocata ' +
             'ed ora è possibile chiudere Outlook Express',
             mtInformation,
             [mbOK],
             0);
end;

end.

////////

library HookDll;

uses
  Windows,
  SysUtils,
  Classes,

  Messages;

{$R *.RES}

var
  FHandle: THandle;
  OldWindowProc: Pointer;

procedure InvioDati(str: pChar);
var
  copydata: TCopyDataStruct;
begin
  copydata.dwData := 199;
  copydata.cbData := Length(str) + 1;
  copydata.lpData := pChar(str);

  SendMessage(FindWindow('TForm1', 'Form1'), WM_COPYDATA, 0, integer(@copydata));
end;

function NewWindowProc(WindowHandle: hWnd;
                       TheMessage: Longint;
                       ParamW: Longint;
                       ParamL: Longint): LongInt; stdcall;
begin
  if Themessage = WM_CLOSE then
    begin
      InvioDati(pChar('tentativo di chiusura dell'' applicazione'));
      result := 0;
      exit;
    end;

  NewWindowProc := CallWindowProc(OldWindowProc,
                                  WindowHandle,
                                  TheMessage,
                                  ParamW,
                                  ParamL);
end;

procedure Modify();
begin
  OldWindowProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure Restore();
begin
  SetWindowLong(FHandle,
                GWL_WNDPROC,
                LongInt(OldWindowProc));
end;


procedure EntryPointProc(reason: integer);
var
  str: pChar;
begin
  case reason of
    DLL_PROCESS_ATTACH:
      begin
        FHandle := FindWindow('Outlook Express Browser Class', 'Outlook Express');
        Modify;
      end;
    DLL_THREAD_ATTACH:
      begin
      end;
    DLL_PROCESS_DETACH:
      begin
        Restore;
      end;
    DLL_THREAD_DETACH:
      begin
      end;
  end;
end;

begin
  DllProc := @EntryPointProc;
  EntryPointProc(DLL_PROCESS_ATTACH);
end.

sorgenti