Recuperer la pile de son programme

Je voudrais recuperer la pile de mon programme.

En fait, es-tu sûr que Delphi génère des .pdb corrects ? Sur ce point,
je ne connais pas du tout delphi, alors je ne connais pas la réponse.

Salut,
J'ai un nouveau probleme :)
Je voudrais recuperer la pile de mon programme.
Pour ca, je suis alle recuperer l'exemple poste par Arnaud Debaene mais
ca ne marche pas...

Donc, je vous poste ici mon code en esperant que vous puissiez m'aider :)

3 fonctions :
MyGetProcAddress : Retourne les adresses des fonctions
SymFunctionTableAccess64 et SymGetModuleBase64 (je pense que mon pb
vient de la, enfin des parametres dans StackWalk)
ManewFonction : fonction appelle lors de CreateThread et qui est cense
recuper la pile
Button4Click : procedure executee lors du Click sur un bouton (il faut
partir de la pour lire le code)

function MyGetProcAddress(NbrFunc: integer): Pointer;
var
Instance: Hwnd;
begin
//Normalement, rien d'anormal dans cette fonction (niveau code)
//Peut etre du point de vue logique (il ne faut pas etre pas les
// chargees ?)
Instance := LoadLibrary('DbgHelp.dll');
if Instance = 0 then
begin
MessageBox(0, 'Impossible de chager la DLL : DbgHelp.dll', 'Erreur
de chargement',
MB_OK or MB_ICONERROR);
Result := nil;
Exit;
end;

if NbrFunc = 1 then
Result := GetProcAddress(Instance, 'SymFunctionTableAccess64')
else Result := GetProcAddress(Instance, 'SymGetModuleBase64');
end;

function ManewFonction(param: Pointer): Boolean;
var
Contexte : CONTEXT;
StackFrame : TSTACKFRAME64;
Liste : TStringList;
Dbg : TDbgDebugger; //Implementation perso de DbgHelp car Borland ne
l'a pas mis !
Cpt: Integer;
MonThr : Cardinal;
begin
Dbg := TDbgDebugger.Create;
Liste := TStringList.Create;
MonThr := Form1.HandleThread; //J'ai essaye avec GetCurrentThread, ca
passe pas non plus.
//Petit PS: j'avais essaye de passer le pointeur de HandleThread par
le Param, mais ca passe pas,
//Savez vous pourquoi ??

//Suspend le thread pour lire
SuspendThread(MonThr);

//Recupere le context
Contexte.ContextFlags := CONTEXT_FULL;
if GetThreadContext(MonThr, Contexte) = False then
begin
//Si je ne fais pas un GetThreadContext sur le GetCurrentThread, je
n'arrive jamais a l'avoir !
MessageBox(0, 'GetThreadContext echoue', 'Erreur', Mb_OK or
Mb_ICONERROR);
MessageBox(0, PChar(SysErrorMessage(GetLastError())), 'Erreur',
Mb_OK or Mb_ICONERROR); //Donne le message d'erreur en clair
end;

//Remplit de 0 la structure
FillChar(StackFrame, SizeOf(TSTACKFRAME64), #0);

// Initilaise le context pour la 1ere fois (special x86)
StackFrame.AddrPC.Offset := Contexte.Eip;
StackFrame.AddrPC.Mode := AddrModeFlat;
StackFrame.AddrStack.Offset := Contexte.Esp;
StackFrame.AddrStack.Mode := AddrModeFlat;
StackFrame.AddrFrame.Offset := Contexte.Ebp;
StackFrame.AddrFrame.Mode := AddrModeFlat;

//Creer un Compteur pour voir le nombre de lignes sur la pile
Cpt :=0;

//Boucle pour recupere la pile
//Je pense donc que le pb vient des
// - PFunctionTableAccessProc64(MyGetProcAddress(1)) - Pointe vers la
// fonction de DbgHelp
// - PGetModuleBaseProc64(MyGetProcAddress(2)) ->Pointe vers la
// fonction de DbgHelp
While Dbg.StackWalk64(IMAGE_FILE_MACHINE_I386, GetCurrentProcess, MonThr,
@StackFrame, @Contexte, nil,
PFunctionTableAccessProc64(MyGetProcAddress(1)),
PGetModuleBaseProc64(MyGetProcAddress(2)), nil) = True do
begin
Liste.Add('Offset : ' + IntToHex(StackFrame.AddrPC.Offset, 8));
Inc(Cpt);
//if Cpt >= 10000 then Break; //Si je ne met pas ca, je suis dans
une boucle infinie !
if StackFrame.AddrPC.Offset = 0 then Break;
end;

//Sauvegarde le fichier
Liste.Add(IntToStr(Cpt));
Liste.Add('Fini stackWalk');
Liste.SaveToFile('C:Stack.txt');

Result := True; //J'en vois pas l'interet mais ils renvoient tous
True pour cette fonction
//sur les exmples vus

//Voir le resultat sur ma fiche de delphi
Form1.ListBox1.Items := Liste;

//Destruction des objets utilises
Dbg.Free;
Liste.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
HandleEvent, Newthread : Hwnd;
begin
//J'ai essaye de traduire le code de Arnaud Debaene et il avait
utilise un Event avec le WaitForSingleObject
HandleEvent := CreateEvent(nil, False, False, nil);
if Handleevent = 0 then
begin
MessageBox(0, 'Handle 0 pour Event', 'Erreur', Mb_OK or Mb_ICONERROR);
Exit;
end;

if DuplicateHandle(GetCurrentProcess, GetCurrentThread,
GetCurrentProcess, @HandleThread,
0, False, DUPLICATE_SAME_ACCESS) = False then
begin
MessageBox(0, 'DuplicateHandle non reussi', 'Erreur', Mb_OK or
Mb_ICONERROR);
Exit;
end;

NewThread := CreateThread(nil, 0, @MaNewFonction, nil, 0, thread_id);
if NewThread = 0 then
begin
MessageBox(0, 'Handle 0 pour NewThread', 'Erreur', Mb_OK or
Mb_ICONERROR);
Exit;
end;

//WaitForSingleObject(HandleEvent, INFINITE); //Mis en commentaire
car me fais faire une boucle infinie
//A moins que sauver la pile ne prenne plus d'une minute ?!
CloseHandle(NewThread);
CloseHandle(HandleThread);
end;

Il faut partir du Button4Click :)
Je sais que le nom des fonctions n'est pas tres explicites mais je suis
en train de tester, alors bon...j'ai pas encore de mise en forme
J'ai essaye de detailler les differents problemes au fur et a mesure
dans les commentaires, si vous ne comprenez pas quelque chose, n'hesitez
pas a me demander.

PS : si vous voulez voir mon implementation de DbgHelp (au cas ou vous
ne detectez pas de grosse erreur) : glayag.free.fr/H_DbgHelp.pas

Salut,
J'ai un nouveau probleme :)
Je voudrais recuperer la pile de mon programme.
Pour ca, je suis alle recuperer l'exemple poste par Arnaud Debaene

ca ne marche pas...

Donc, je vous poste ici mon code en esperant que vous puissiez

3 fonctions :
MyGetProcAddress : Retourne les adresses des fonctions
SymFunctionTableAccess64 et SymGetModuleBase64 (je pense que mon pb
vient de la, enfin des parametres dans StackWalk)
ManewFonction : fonction appelle lors de CreateThread et qui est

recuper la pile
Button4Click : procedure executee lors du Click sur un bouton (il

partir de la pour lire le code)

function MyGetProcAddress(NbrFunc: integer): Pointer;
var
Instance: Hwnd;
begin
//Normalement, rien d'anormal dans cette fonction (niveau code)
//Peut etre du point de vue logique (il ne faut pas etre pas les
// chargees ?)
Instance := LoadLibrary('DbgHelp.dll');
if Instance = 0 then
begin
MessageBox(0, 'Impossible de chager la DLL : DbgHelp.dll',

de chargement',
MB_OK or MB_ICONERROR);
Result := nil;
Exit;
end;

if NbrFunc = 1 then
Result := GetProcAddress(Instance, 'SymFunctionTableAccess64')
else Result := GetProcAddress(Instance, 'SymGetModuleBase64');
end;

function ManewFonction(param: Pointer): Boolean;
var
Contexte : CONTEXT;
StackFrame : TSTACKFRAME64;
Liste : TStringList;
Dbg : TDbgDebugger; //Implementation perso de DbgHelp car Borland

l'a pas mis !
Cpt: Integer;
MonThr : Cardinal;
begin
Dbg := TDbgDebugger.Create;
Liste := TStringList.Create;
MonThr := Form1.HandleThread; //J'ai essaye avec

ca passe pas non plus.

//Petit PS: j'avais essaye de passer le pointeur de HandleThread

le Param, mais ca passe pas,
//Savez vous pourquoi ??

//Suspend le thread pour lire
SuspendThread(MonThr);

//Recupere le context
Contexte.ContextFlags := CONTEXT_FULL;
if GetThreadContext(MonThr, Contexte) = False then
begin
//Si je ne fais pas un GetThreadContext sur le GetCurrentThread,

n'arrive jamais a l'avoir !

MessageBox(0, 'GetThreadContext echoue', 'Erreur', Mb_OK or
Mb_ICONERROR);
MessageBox(0, PChar(SysErrorMessage(GetLastError())), 'Erreur',
Mb_OK or Mb_ICONERROR); //Donne le message d'erreur en clair
end;

//Remplit de 0 la structure
FillChar(StackFrame, SizeOf(TSTACKFRAME64), #0);

// Initilaise le context pour la 1ere fois (special x86)
StackFrame.AddrPC.Offset := Contexte.Eip;
StackFrame.AddrPC.Mode := AddrModeFlat;
StackFrame.AddrStack.Offset := Contexte.Esp;
StackFrame.AddrStack.Mode := AddrModeFlat;
StackFrame.AddrFrame.Offset := Contexte.Ebp;
StackFrame.AddrFrame.Mode := AddrModeFlat;

//Creer un Compteur pour voir le nombre de lignes sur la pile
Cpt :=0;

//Boucle pour recupere la pile
//Je pense donc que le pb vient des
// - PFunctionTableAccessProc64(MyGetProcAddress(1)) - Pointe vers

// fonction de DbgHelp
// - PGetModuleBaseProc64(MyGetProcAddress(2)) ->Pointe vers la
// fonction de DbgHelp
While Dbg.StackWalk64(IMAGE_FILE_MACHINE_I386, GetCurrentProcess,

@StackFrame, @Contexte, nil,
PFunctionTableAccessProc64(MyGetProcAddress(1)),
PGetModuleBaseProc64(MyGetProcAddress(2)), nil) = True do
begin
Liste.Add('Offset : ' + IntToHex(StackFrame.AddrPC.Offset, 8));
Inc(Cpt);
//if Cpt >= 10000 then Break; //Si je ne met pas ca, je suis

une boucle infinie !
if StackFrame.AddrPC.Offset = 0 then Break;
end;

//Sauvegarde le fichier
Liste.Add(IntToStr(Cpt));
Liste.Add('Fini stackWalk');
Liste.SaveToFile('C:Stack.txt');

Result := True; //J'en vois pas l'interet mais ils renvoient

True pour cette fonction
//sur les exmples vus

//Voir le resultat sur ma fiche de delphi
Form1.ListBox1.Items := Liste;

//Destruction des objets utilises
Dbg.Free;
Liste.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
HandleEvent, Newthread : Hwnd;
begin
//J'ai essaye de traduire le code de Arnaud Debaene et il avait
utilise un Event avec le WaitForSingleObject
HandleEvent := CreateEvent(nil, False, False, nil);
if Handleevent = 0 then
begin
MessageBox(0, 'Handle 0 pour Event', 'Erreur', Mb_OK or

Exit;
end;

if DuplicateHandle(GetCurrentProcess, GetCurrentThread,
GetCurrentProcess, @HandleThread,
0, False, DUPLICATE_SAME_ACCESS) = False then
begin
MessageBox(0, 'DuplicateHandle non reussi', 'Erreur', Mb_OK or
Mb_ICONERROR);
Exit;
end;

NewThread := CreateThread(nil, 0, @MaNewFonction, nil, 0,

if NewThread = 0 then
begin
MessageBox(0, 'Handle 0 pour NewThread', 'Erreur', Mb_OK or
Mb_ICONERROR);
Exit;
end;

//WaitForSingleObject(HandleEvent, INFINITE); //Mis en

car me fais faire une boucle infinie

//A moins que sauver la pile ne prenne plus d'une minute ?!

CloseHandle(NewThread);
CloseHandle(HandleThread);
end;

//WaitForSingleObject(HandleEvent, INFINITE); //Mis en

commentaire

car me fais faire une boucle infinie

Si tu ne fais pas leWaitForSingleObject, tu ne sait pas dans quel état
est le thread principal au moment où tu fait la SuspendThread dessus
(depuis le thread auxiliaire), donc ta call stack ne sert à rien!

//A moins que sauver la pile ne prenne plus d'une minute ?!

Comment ca une boucle infinie? La WaitForSingleObject n'est même pas
dans une boucle!

Oui, c'est bien CallStackDumper

>> //WaitForSingleObject(HandleEvent, INFINITE); //Mis en
>
> commentaire
>
>>car me fais faire une boucle infinie
>
> Si tu ne fais pas leWaitForSingleObject, tu ne sait pas dans quel

> est le thread principal au moment où tu fait la SuspendThread

> (depuis le thread auxiliaire), donc ta call stack ne sert à rien!
>
>
>> //A moins que sauver la pile ne prenne plus d'une minute ?!
>
> Comment ca une boucle infinie? La WaitForSingleObject n'est même

> dans une boucle!
>

Je veux dire qu'il attend indefiniment :)

> Et le thread auxiliaire, il fait quoi? Il n'y a pas un seul appel
bloquant dedans!

Sinon, je ne connais pas Delphi, mais commenc ca se fait que tu puisses
accéder à TForm1.HandleThread dans le code du thread :
MonThr := Form1.HandleThread;

C'est quoi Form1 la dedans? MonThread est bien une variable d'instance
de TForm1 non? A mon avis commence par vérifier la valeur de ce handle
à cet endroit du code, ca me semble louche.

Au passage, je ne comprends pas comment tu peux passer ManewFonction
comme paramètre à CreateThread vu que sa signature n'est pas la
bonne, mais ne connaissant pas Delphi quelque chose m'échappe
peut-être.


Arnaud