hangi fonksiyondayım nasıl öğrenebilirim

[adelphiforumz]

Öncelikle herkese kolay gelsin

Aşağıdaki şekilde bir işlem yaptığımızı var sayalım

procedure TForm1.BtndenemeClick(Sender: TObject);
begin
test;
end;

procedure TForm1.test;
begin
showmessage(??????????);
end;

Benim amacım butona basıldığında test diye bir procedure yada fonksiyon çalışacak
ve o fonksiyonun içindeyken ben hangi fonksiyonda olduğumu bilmem gerekiyor.
böyle birşey mümkünmüdür.
Burda amacım kişinin karşısına bazı fonksiyonların içindeyken hangi fonksiyonda olduğunu göstermem gerekiyor.
yada bunu başarabilirsem program kırıldığında hangi rutin içinde kırıldığını ekranan mesaj olarak vermek istiyorum.

şimdiden teşekkürler

[CiTiZEN]

yanlış anlamadıysam basit olarak string tipi global bir değişken tanımlayın ve fonksiyonların altına string tipi bu değişkeni atayın 1. fonksiyonda string değeri 1 olsun 2. fonksiyonda 2 olsun ... gibi bunuda kontrol ederek işlem yapabilirsiniz

[abdulkadir]

yukardaki arkadasın dedigi sey işini görmeyecekse
.Map dosyası ile bu istedigini yapabilecegiini sanıyorum
öncelikle delphi project options sekmesinde linker i tıkla sagdaki menude

Map File bölümünde

of
segments
public
detailes

göreceksin detailes i sec
böylece sen projeni compile ettiginde proje_adi.map dosyası da olusacak.

bundan sonrası daha zor ama yardımcı olmaya calısacagım...
kolay gelsin

[adelphiforumz]

abdulkadir hocam senin dediklerini yaptım map dosyasının içine baktığımda hiç bir şey anlamadım
bunu nasıl kullanacağım.
Benim amacım aslında şöyle birşey belki daha basit bir yolla çözebilirmiyiz.
ekranda bir button var ve bu butonnun altında yaklaşık 130'a yakın procedure ve fonksiyon var
ve program bunların içine dallanıyor.
benim programda bir hata olursa try except ile hatayı yakalıyorum ve kişinin karşısına bir mesaj çıkarıyorum
Fakat mesajın içeriği dinamik oluşuyor örneğin.
Showmessage(DurumKodu);
gibi buradaki DurumKodu global bir değişken ve faklı yerlerde farklı bilgilerle dolduruluyor.
istediğim bu mesajı gösterdiğim yerde hangi procedure yada fonksiyonun içinde isem onun adınıda göstermek istiyorum
Örnek
Showmessage(DurumKodu + Fonksiyon adı yada Procedure adı);
bu noktada bana Fonksiyon adı yada Procedure adı gerekeyor

şimdiden teşekkürler

[abdulkadir]

bu konuda bir calısmam vardı ama cok karısık idi
ben hatayı olusturan procedure yi unit adını ve satır numarası bir form içinde
gösterip kayıt secenekleri sunuyordum

simdi biraz arsimi kurcalayayım yardımcı olmaya calısacagım...

[abdulkadir]

function ve procedure adını map dosyası olmadan alabilirmisin bilmiyorum
map dosyasını projeni compile ettigin son hali ile vermelisin sen her compile ettiginde map dosyan yenilenir
map dosyasını son sekli ile vermesen dogru sonuca ulasamayacaksın
ayrıca map dosyası boyutu sorun olmayacaksa kullan yoksa tavsiye etmem.

Ben daha önce kullandıgım şekli senin için biraz duzenledim.

bu işlemde projende olusan bütün hatalar için artık sistem mesajları degil senin hata mesajın verilir.

bi bak işe yararsa özelliklerini artırabiliriz...

Yeni bir proje olustur.....

Unit1 kodları (unit1.pas)

Kod: Tümünü seç

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure GlobalHataYakala(Sender: TObject; E: Exception);
    Function Test_et(A,B:integer):integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
    Uses AKL_HATA_MAP;
{$R *.dfm}



procedure TForm1.GlobalHataYakala(Sender: TObject; E: Exception);
var
  MapFileAddress: DWORD;
  UnitName, ProcedureName, LineNumber: string;
const
  SatirBasi = AnsiString(#13#10);
begin
  MapFileAddress := GetMapAddressFromAddress(DWORD(ExceptAddr));
  UnitName := GetModuleNameFromAddress(MapFileAddress);
  ProcedureName := GetProcNameFromAddress(MapFileAddress);
  LineNumber := GetLineNumberFromAddress(MapFileAddress);

  ShowMessage('Hatayı sayfası: '+UnitName +SatirBasi+
              'Hata yolu(Procedure veya Function adı): ' +ProcedureName +SatirBasi+
              'Hata satırı: '+LineNumber);
end;

Function TForm1.Test_et(A,B:integer):integer;
var
  a2, b2, c2: Integer;
begin
  a2 := A;
  b2 := B;
  c2 := a2 div b2;
  Result:=c2;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  a, b, c: Integer;
begin
  a := 10;
  b := 0;
  c := a div b;
  ShowMessage(IntToStr(c));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Test_et(10,0);
end;

initialization
   try
    LoadAndParseMapFile;
    Application.OnException := Form1.GlobalHataYakala;
    except
    ShowMessage('map dosyası okuma hatası' + #13#10 + EmptyStr);
   end;
finalization
    try
    CleanUpMapFile;
   except
    ShowMessage('map dosyası silme hatası' + #13#10 + EmptyStr);
 end;
end.

Unit1 dfm dosyası(unit1.dfm)

Kod: Tümünü seç

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 190
  ClientWidth = 266
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 56
    Top = 24
    Width = 147
    Height = 25
    Caption = 'Procedure'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 56
    Top = 64
    Width = 147
    Height = 25
    Caption = 'Function'
    TabOrder = 1
    OnClick = Button2Click
  end
end

ve bu dosyayıda uses e ekle (AKL_HATA_MAP.pas)

Kod: Tümünü seç

unit AKL_HATA_MAP;
interface
uses
  Windows,Controls,StdCtrls,Messages,SysUtils,Variants,Classes,Graphics,
  ComCtrls,Registry,Forms,MMSystem,Contnrs,WinTypes,WinProcs,Winsock,Dialogs,Mask,
  Menus,ExtCtrls,Gauges,ImgList,Math,shellapi,CheckLst,Buttons,ClipBrd;
//----------------MAP---İÇİN--GEREKLİ---------------------
function   LoadAndParseMapFile: Boolean;
procedure CleanUpMapFile;
function GetMapAddressFromAddress(const Address: DWORD): DWORD;
function GetMapFileName: string;
function GetModuleNameFromAddress(const Address: DWORD): string;
function GetProcNameFromAddress(const Address: DWORD): string;
function GetLineNumberFromAddress(const Address: DWORD): string;
var
  Units, Procedures, LineNumbers: TList;
//--------------MAP---İÇİN------------------------------
implementation
const
  { Sections in .map file }
  NAME_CLASS        = 'StartLengthNameClass';
  SEGMENT_MAP       = 'Detailedmapofsegments';
  PUBLICS_BY_NAME   = 'AddressPublicsbyName';
  PUBLICS_BY_VAL    = 'AddressPublicsbyValue';
  LINE_NUMBERS      = 'Linenumbersfor';
  RESOURCE_FILES    = 'Boundresourcefiles';
  AnsiCrLf          = AnsiString(#13#10);
type
  { Sections as enum }
  THeaderType = (htNameClass, htSegmentMap, htPublicsByName, htPublicsByValue,
    htLineNumbers, htResourceFiles);

  { unitname / pointeraddress pair -> olUnits }
  PUnitItem = ^TUnitItem;
  TUnitItem = record
    UnitName: string;
    UnitStart,
    UnitEnd: DWORD;
  end;

  { procedurename / pointeraddress pair -> olProcedures }
  PProcedureItem = ^TProcedureItem;
  TProcedureItem = record
    ProcName: string;
    ProcStart: DWORD;
  end;

  { linenumber / pointeraddress pair -> olLineNumbers }
  PLineNumberItem = ^TLineNumberItem;
  TLineNumberItem = record
    UnitName,
      LineNo: string;
    LineStart: DWORD;
  end;

function StripFromString(const Strip: char; var AString: string): string;
var
  Pos               : Cardinal;
begin
  Pos := Length(AString);
  while Pos > 0 do
  begin
    if AString[Pos] = Strip then
      Delete(AString, Pos, Length(Strip))
    else
      Dec(Pos);
  end;
  Result := AString;
end;

function LoadAndParseMapFile: Boolean;
var
  F                 : TextFile;
  CurrentLine,
    CurrentUnit     : string;
  CurrentHeader     : THeaderType;

  { helper func of SyncHeaders }

  function CompareHeaders(AHeader, ALine: string): Boolean;
  begin
    Result := Copy(ALine, 1, Length(AHeader)) = AHeader;
  end;

  { Keeps track of section in .map file }

  procedure SyncHeaders(var Header: THeaderType; Line: string);
  const
    Pfx             = Length('Line numbers for ');
  begin
    Line := StripFromString(' ', Line);

    if CompareHeaders(NAME_CLASS, Line) then Header := htNameClass;
    if CompareHeaders(SEGMENT_MAP, Line) then Header := htSegmentMap;
    if CompareHeaders(PUBLICS_BY_NAME, Line) then Header := htPublicsByName;
    if CompareHeaders(PUBLICS_BY_VAL, Line) then Header := htPublicsByValue;
    if CompareHeaders(LINE_NUMBERS, Line) then
    begin
      Header := htLineNumbers;
      CurrentUnit := Copy(Line, Pfx - 2, Pos('(', Line) - Pfx + 2);
    end;
    if CompareHeaders(RESOURCE_FILES, Line) then Header := htResourceFiles;
  end;

  { Adds a segment from .map to segment-list }

  procedure AddUnit(ALine: string);
  var
    SStart          : string;
    SLength         : string;
    AUnitItem       : PUnitItem;
  begin
    if StrToInt(Trim(Copy(ALine, 1, Pos(':', ALine) - 1))) = 1 then
    begin
      SStart := Copy(ALine, Pos(':', ALine) + 1, 8);
      SLength := Copy(ALine, Pos(':', ALine) + 10, 8);
      New(AUnitItem);
      with AUnitItem^ do
      begin
        UnitStart := StrToInt('$' + SStart);
        UnitEnd := UnitStart + DWORD(StrToInt('$' + SLength));
        Delete(ALine, 1, Pos('M', ALine) + 1);
        UnitName := Copy(ALine, 1, Pos(' ', ALine) - 1);
      end;
      Units.Add(AUnitItem);
    end;
  end;

  { Adds a public procedure from .map to procedure-list }

  procedure AddProcedure(ALine: string);
  var
    SStart          : string;
    AProcedureItem  : PProcedureItem;
  begin
    if StrToInt(Trim(Copy(ALine, 1, Pos(':', ALine) - 1))) = 1 then
    begin
      SStart := Copy(ALine, Pos(':', ALine) + 1, 8);
      New(AProcedureItem);
      with AProcedureItem^ do
      begin
        ProcStart := StrToInt('$' + SStart);
        Delete(ALine, 1, Pos(':', ALine) + 1);
        ProcName := Trim(Copy(ALine, Pos(' ', ALine), Length(ALine) - Pos(' ',
          ALine) + 1));
      end;
      Procedures.Add(AProcedureItem);
    end;
  end;

  { Adds a lineno from .map to lineno-list }

  procedure AddLineNo(ALine: string);
  var
    ALineNumberItem : PLineNumberItem;
  begin
    while Length(Trim(ALine)) > 0 do
    begin
      New(ALineNumberItem);
      with ALineNumberItem^ do
      begin
        Aline := Trim(ALine);
        UnitName := CurrentUnit;
        LineNo := Copy(ALine, 1, Pos(' ', ALine) - 1);
        Delete(ALine, 1, Pos(' ', ALine) + 5);
        LineStart := StrToInt('$' + Copy(ALine, 1, 8));
        Delete(ALine, 1, 8);
      end;
      LineNumbers.Add(ALineNumberItem);
    end;
  end;

  { procedure TExtExceptionInfo.LoadAndParseMapFile }
begin
  Units := TList.Create;
  Procedures := TList.Create;
  LineNumbers := TList.Create;

  if FileExists(GetMapFileName) then
  begin
    AssignFile(F, GetMapFileName);
    Reset(F);
    while not EOF(F) do
    begin
      ReadLn(F, CurrentLine);
      SyncHeaders(CurrentHeader, CurrentLine);
      if Length(CurrentLine) > 0 then
        if (Pos(':', CurrentLine) > 0) and (CurrentLine[1] = ' ') then
          case CurrentHeader of
            htSegmentMap: AddUnit(CurrentLine);
            htPublicsByValue: AddProcedure(CurrentLine);
            htLineNumbers: AddLineNo(CurrentLine);
          end;
    end;
    CloseFile(F);
    Result :=
      (Units.Count > 0) and
      (Procedures.Count > 0) and
      (LineNumbers.Count > 0);
  end
  else
    Result := False;
end;

procedure CleanUpMapFile;
begin
  if Units.Count > 0 then
    while Units.Count > 0 do
    begin
      Dispose(PUnitItem(Units.Items[0]));
      Units.Delete(0);
    end;
  if Procedures.Count > 0 then
    while Procedures.Count > 0 do
    begin
      Dispose(PProcedureItem(Procedures.Items[0]));
      Procedures.Delete(0)
    end;
  if LineNumbers.Count > 0 then
    while LineNumbers.Count > 0 do
    begin
      Dispose(PLineNumberItem(LineNumbers.Items[0]));
      LineNumbers.Delete(0);
    end;

  FreeAndNil(Units);
  FreeAndNil(Procedures);
  FreeAndNil(LineNumbers);
end;

function GetModuleNameFromAddress(const Address: DWORD): string;
var
  i                 : Integer;
begin
  for i := Units.Count - 1 downto 0 do
    if ((PUnitItem(Units.Items[i])^.UnitStart <= Address) and
      (PUnitItem(Units.Items[i])^.UnitEnd >= Address)) then
    begin
      Result := PUnitItem(Units.Items[i])^.UnitName;
      Break;
    end;
end;

function GetProcNameFromAddress(const Address: DWORD): string;
var
  i                 : Integer;
begin
  for i := Procedures.Count - 1 downto 0 do
    if (PProcedureItem(Procedures.Items[i])^.ProcStart <= Address) then
    begin
      Result := PProcedureItem(Procedures.Items[i])^.ProcName;
      Break;
    end;
end;

function GetLineNumberFromAddress(const Address: DWORD): string;
var
  i                 : Cardinal;
  LastLineNo        : string;
  UnitName          : string;
begin
  Result := '';
  LastLineNo := '';
  UnitName := GetModuleNameFromAddress(Address);

  for i := 0 to LineNumbers.Count - 1 do
    if PLineNumberItem(LineNumbers.Items[i])^.UnitName = UnitName then
      if (PLineNumberItem(LineNumbers.Items[i])^.LineStart >= Address) then
      begin
        Result := LastLineNo;
        Break;
      end
      else
        LastLineNo := PLineNumberItem(LineNumbers.Items[i])^.LineNo;
end;

function GetMapFileName: string;
begin
  Result := ChangeFileExt(ParamStr(0), '.map');
end;

function GetMapAddressFromAddress(const Address: DWORD): DWORD;
const
  CodeBase          = $1000;
var
  OffSet            : DWORD;
  ImageBase         : DWORD; //$400000: hInstance or GetModuleHandle(0)
begin
  ImageBase := hInstance;
  OffSet := ImageBase + CodeBase;
  // Map file address = Access violation address - Offset
  Result := Address - OffSet;
end;
//--------------MAP---İÇİN------SON------------------------
end.

projeni compile et map dosyasının olustuguna emin ol ve test butonlarına tıkla

[adelphiforumz]

abdulkadir hocam eline emeğine sağlık
iyi çalışmalar

[abdulkadir]

Rica ederim
sizede iyi çalışmalar.

[pasa_yasar]

çok tşk. ederim. dediğiniz gibi yaptım oldu.