home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / heapchk2 / heaptst.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  2.3 KB  |  103 lines
  1. unit Heaptst;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls,
  8.   HeapChk,  {--- Variable HeapCheckActive   ---}
  9.   HeapTest; {--- Function HeapTestCheckPtrs ---}
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     ButtonMakeError: TButton;
  14.     ButtonShowError: TButton;
  15.     Label1: TLabel;
  16.     Edit1: TEdit;
  17.     Label2: TLabel;
  18.     Edit2: TEdit;
  19.     ButtonMakeInv: TButton;
  20.     procedure ButtonMakeErrorClick(Sender: TObject);
  21.     procedure ButtonShowErrorClick(Sender: TObject);
  22.     procedure Edit2Change(Sender: TObject);
  23.     procedure FormShow(Sender: TObject);
  24.     procedure Edit1Change(Sender: TObject);
  25.     procedure ButtonMakeInvClick(Sender: TObject);
  26.   private
  27.     { Private-Deklarationen }
  28.   public
  29.     { Public-Deklarationen }
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.  
  35. implementation
  36.  
  37. {$R *.DFM}
  38.  
  39.  
  40. {--- Make an Overflow --}
  41. procedure TForm1.ButtonMakeErrorClick(Sender: TObject);
  42. var
  43.   p : PChar;
  44. begin
  45.   GetMem(p,16);
  46.   strcopy(p,'1234567890123456'); { one Byte Overflow }
  47. end;
  48.  
  49.  
  50. {--- Make an Overflow, that ButtonShowErrorClick can't show ---}
  51. procedure TForm1.ButtonMakeInvClick(Sender: TObject);
  52. var
  53.   p : PChar;
  54. begin
  55.   {-- this is a Overflow like ButtonMakeErrorClick.
  56.       The block is dealloceted before ButtonShowErrorClick can occur.
  57.       Click on ShowError can't show this error, because the block
  58.       is deallocated.
  59.       This Error will be listed in the DUMP.TXT
  60.       (!!! only in the registered version !!!)
  61.    -- }
  62.   GetMem(p,16);
  63.   strcopy(p,'1234567890123456'); { one Byte Overflow }
  64.   FreeMem(p,16);
  65. end;
  66.  
  67. {--- Show Errors ---}
  68. procedure TForm1.ButtonShowErrorClick(Sender: TObject);
  69. begin
  70.   {-- lock for Overflows --}
  71.   HeapTestCheckPtrs;
  72. end;
  73.  
  74.  
  75. {--- Set Name of Dumpfile ---}
  76. procedure TForm1.Edit1Change(Sender: TObject);
  77. begin
  78.   HeapTestDumpFile := Edit1.Text;
  79. end;
  80.  
  81.  
  82. {--- Set Searchpath for Sourcefiles ---}
  83. procedure TForm1.Edit2Change(Sender: TObject);
  84. begin
  85.   HeapTestSearchPath := Edit2.Text;
  86. end;
  87.  
  88.  
  89.  
  90. procedure TForm1.FormShow(Sender: TObject);
  91. begin
  92.   {-- test if HeapChk is installed --}
  93.   if not HeapCheckActive then
  94.     {-- maybe a new version of delphi-librarys --}
  95.     ShowMessage('Can''t install HeapChk');
  96.  
  97.   {-- make a none-deallocated block. Lock in DUMP.TXT --}
  98.   TStringList.Create;
  99. end;
  100.  
  101.  
  102. end.
  103.