Devart Forums

Code: Select all

program Project1;
uses
  MemMgr in 'MemMgr.pas',
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Code: Select all

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, MemDS, DBAccess, MSAccess;

type
  TForm1 = class(TForm)
    Connection: TMSConnection;
    Query: TMSQuery;
    Button2: TButton;
    Label3: TLabel;
    lPocet2: TLabel;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  MemData;

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);

  function __GetQueryStr(PocetZaznamu: integer): string;

    function __RandomChar: string;
    begin
      Result := Chr(65 + Random(26));
    end;

    function __RandomWord(PocetPismen: integer): string;
    var
      i: integer;
    begin
      Result := '';
      for i := 0 to PocetPismen - 1 do
        Result := Result + __RandomChar;
    end;

  var
    i: integer;
  begin
    Randomize;
    Result := 'SELECT * FROM (';
    for i := 0 to PocetZaznamu - 1 do
    begin
      if i = 0 then
        Result := Result +
          Format(
            '(SELECT %d AS Field1, ''%s'' AS Field2, ''%s'' AS Field3, ''%s'' AS Field4)',
            [Random(1000),
             __RandomWord(3),
             __RandomWord(2),
             __RandomWord(1)])
      else
        Result := Result +
          Format(
            '(SELECT %d, ''%s'', ''%s'', ''%s'')',
            [Random(1000),
             __RandomWord(3),
             __RandomWord(2),
             __RandomWord(1)]);
      if i < (PocetZaznamu - 1) then
        Result := Result + ' UNION ALL'#13
    end;
    Result := Result + ') t';
  end;

var
  i: integer;
  S: string;
  B: TBookmark;
begin
  for i := 1 to 100 do
  begin
    Connection.Connect;

    Query.SQL.Text := __GetQueryStr(200);
    Query.Open;

    Query.Last;
    B := Query.Bookmark;

    Query.Close;
    Query.SQL.Text := __GetQueryStr(50);
    Query.Open;

    if not Query.BookmarkValid(B) then ; // AV here. Bookmark.Item is the dangling pointer

    lPocet2.Caption := IntToStr(StrToIntDef(lPocet2.Caption, 0) + 1);
    lPocet2.Refresh;
  end;
end;
end.

Code: Select all

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 335
  ClientWidth = 396
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label3: TLabel
    Left = 80
    Top = 150
    Width = 107
    Height = 13
    Caption = 'AV with BookmarkValid'
  end
  object lPocet2: TLabel
    Left = 85
    Top = 75
    Width = 6
    Height = 13
    Caption = '0'
  end
  object Button2: TButton
    Left = 80
    Top = 170
    Width = 211
    Height = 71
    Caption = 'Button2'
    TabOrder = 0
    OnClick = Button2Click
  end
  object Connection: TMSConnection
    Authentication = auWindows
    Left = 25
    Top = 20
  end
  object Query: TMSQuery
    Connection = Connection
    Left = 60
    Top = 20
  end
end

Code: Select all

unit MemMgr;

interface

implementation

uses
  Windows;

{ Memory Management }

const
  HEAP_MAX_SIZE = $100000;
  HEAP_GENERATE_EXCEPTIONS = $00000004;
  HEAP_NO_SERIALIZE = $00000001;
  HEAP_ZERO_MEMORY = $00000008;

var
  PrivateHeap: THandle;
  SavedMemoryManager: TMemoryManager;

function InternalGetMem(Size: Integer): Pointer;
begin
  Result := HeapAlloc(PrivateHeap, HEAP_GENERATE_EXCEPTIONS or HEAP_NO_SERIALIZE or HEAP_ZERO_MEMORY, Size);
end;

function InternalFreeMem(P: Pointer): Integer;
begin
  Result := Integer(not HeapFree(PrivateHeap, HEAP_NO_SERIALIZE, P))
end;

function InternalReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  Result := HeapReAlloc(PrivateHeap, HEAP_GENERATE_EXCEPTIONS or HEAP_NO_SERIALIZE or HEAP_ZERO_MEMORY, P, Size)
end;

const
  MemoryManager: TMemoryManager = (
    GetMem: InternalGetMem;
    FreeMem: InternalFreeMem;
    ReallocMem: InternalReallocMem
  );

initialization
  PrivateHeap := HeapCreate(HEAP_GENERATE_EXCEPTIONS or HEAP_NO_SERIALIZE, 0, HEAP_MAX_SIZE);
  GetMemoryManager(SavedMemoryManager);
  SetMemoryManager(MemoryManager);

finalization
  HeapDestroy(PrivateHeap);
  SetMemoryManager(SavedMemoryManager);
end.