Освобождение памятиDelphi , Синтаксис , Память и УказателиОсвобождение памятиunit MemMan; interface var GetMemCount, FreeMemCount, ReallocMemCount: Integer; implementation uses Windows, SysUtils; var OldMemMgr: TMemoryManager; function NewGetMem(Size: Integer): Pointer; begin Inc(GetMemCount); Result := OldMemMgr.GetMem(Size); end; function NewFreeMem(P: Pointer): Integer; begin Inc(FreeMemCount); Result := OldMemMgr.FreeMem(P); end; function NewReallocMem(P: Pointer; Size: Integer): Pointer; begin Inc(ReallocMemCount); Result := OldMemMgr.ReallocMem(P, Size); end; const NewMemMgr: TMemoryManager = ( GetMem: NewGetMem; FreeMem: NewFreeMem; ReallocMem: NewReallocMem); initialization GetMemoryManager(OldMemMgr); SetMemoryManager(NewMemMgr); finalization SetMemoryManager(OldMemMgr); if (GetMemCount - FreeMemCount) <> 0 then MessageBox(0, pChar( 'Objects left: ' + IntToStr(GetMemCount - FreeMemCount)), 'MemManager', mb_ok); end. unit MemForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) BtnRefresh1: TButton; BtnCreateNil: TButton; BtnCreateOwner: TButton; BtnGetMem: TButton; LblResult: TLabel; Btn100Strings: TButton; Bevel1: TBevel; BtnRefresh2: TButton; procedure BtnRefresh1Click(Sender: TObject); procedure BtnCreateNilClick(Sender: TObject); procedure BtnCreateOwnerClick(Sender: TObject); procedure BtnGetMemClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Btn100StringsClick(Sender: TObject); procedure BtnRefresh2Click(Sender: TObject); public procedure Refresh; procedure Refresh2; end; var Form1: TForm1; implementation uses MemMan; {$R *.DFM} procedure TForm1.Refresh; begin LblResult.Caption := 'Allocated: ' + IntToStr(GetMemCount) + #13 + 'Free: ' + IntToStr(FreeMemCount) + #13 + 'Existing: ' + IntToStr(GetMemCount - FreeMemCount) + #13 + 'Re-allocated: ' + IntToStr(ReallocMemCount); end; procedure TForm1.Refresh2; begin LblResult.Caption := Format( 'Allocated: %d'#13'Free: %d'#13'Existing: %d'#13'Re-allocated %d' , [GetMemCount, FreeMemCount, GetMemCount - FreeMemCount, ReallocMemCount]); end; procedure TForm1.BtnRefresh1Click(Sender: TObject); begin Refresh; end; procedure TForm1.BtnCreateNilClick(Sender: TObject); begin TButton.Create(nil); Refresh; end; procedure TForm1.BtnCreateOwnerClick(Sender: TObject); begin TButton.Create(self); Refresh; end; procedure TForm1.BtnGetMemClick(Sender: TObject); var P: Pointer; begin GetMem(P, 100); Integer(P^) := 0; Refresh; end; procedure TForm1.FormCreate(Sender: TObject); begin Refresh; end; procedure TForm1.Btn100StringsClick(Sender: TObject); var s1, s2: string; I: Integer; begin s1 := 'hi'; s2 := Btn100Strings.Caption; for I := 1 to 100 do s1 := s1 + ': hello world'; Btn100Strings.Caption := s1; s1 := s2; Btn100Strings.Caption := s1; Refresh; end; procedure TForm1.BtnRefresh2Click(Sender: TObject); begin Refresh2; end; end.Скачать весь проект Это проект на языке Delphi, демонстрирующий управление памятью с помощью кастомного менеджера памяти, который отслеживает количество выделенных, освобожденных и реаллокированных памяти. Unit MemMan
В этом модуле определены три функции: В секции инициализации модуль получает текущий менеджер памяти и сохраняет его в переменной В секции финализации модуль восстанавливает оригинальный менеджер памяти ( Unit MemForm
В этом модуле определена форма с несколькими кнопками, демонстрирующими различные сценарии управления памятью. Форма имеет три процедуры:
Освобождение памяти в приложении Delphi с использованием класса TMemoryManager и его переопределением для отслеживания аллокированных, освобожденных и реаллокированных ресурсов. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: Память и Указатели ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |