SmartPtr pointeur sans FreeMem

Version imprimable

si vous utiliser dans vos codes beaucoup de GetMem/FreeMem cette unité permets d'alouer de mémoire sans etre obliger d'appeler Freemem a la fin
SmartMem.pas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
unit SmartMem;
 
interface
 
type
  TMem = packed array of  byte;
  SmartPtr = record
    Ptr      :Pointer;
    Reserved :TMem;
  end;
 
function MEMAlloc(Size:integer;var Anchor:SmartPtr):Pointer;
function MEMGet(Size:integer;var Anchor:SmartPtr):Pointer;
procedure MEMRealloc(var P:Pointer;Size:integer;var Anchor:SmartPtr); overload;
procedure MEMRealloc(Size:integer;var Anchor:SmartPtr);               overload;
procedure MEMFree(var Anchor:SmartPtr);
 
implementation
 
type
   PDynRec= ^TDynRec;
   TDynRec= record
     RC    : Integer;
     Length: integer;
   end;
   PDynAr = ^TDynAr;
   TDynAr = packed record
     Mem   : TDynRec;
     Bytes : array[0..0]of byte;
   end;
const
   DYNOFFSET = SizeOf(TDynRec);
 
function MEMGet(Size:integer;var Anchor:SmartPtr):Pointer;
begin
    MEMFree(Anchor);
    GetMem(PByte(Result),Size + DYNOFFSET);
    with Anchor,PDynAr(Result)^ do
    begin
       Mem.RC     := 1;
       Mem.Length := Size;
       Result     := @Bytes;
       Ptr        := Result;
       Pointer(Reserved):= Result;
    end;
end;
 
function MEMAlloc(Size:integer;var Anchor:SmartPtr):Pointer;
begin
    Result := MEMGet(Size,Anchor);
    FillChar(Pointer(Anchor.Reserved)^,Size,0);
end;
 
procedure MEMRealloc(var P:Pointer;Size:integer;var Anchor:SmartPtr);
begin
    P := Pointer(Anchor.Reserved);
    if Size = 0 then
        MEMFree(Anchor)
    else if P = nil then
        P := MEMGet(Size,Anchor)
    else begin
        Dec(Integer(P),DYNOFFSET);
        ReallocMem(PByte(P),Size + DYNOFFSET);
        with Anchor,PDynAr(P)^ do
        begin
           Mem.Length := Size;
           P          := @Bytes;
           Ptr        := P;
           Pointer(Reserved):= P;
        end;
   end;
end;
 
procedure MEMRealloc(Size:integer;var Anchor:SmartPtr);
begin
    Anchor.Ptr := Pointer(Anchor.Reserved);
    MEMRealloc(Anchor.Ptr,Size,Anchor);
end;
 
procedure MEMFree(var Anchor:SmartPtr);
begin
    if Pointer(Anchor.Reserved) <> nil then
    begin
        Dec(Integer(Anchor.Reserved),DYNOFFSET);
        FreeMem(PByte(Anchor.Reserved));
        Pointer(Anchor.Reserved) := nil;
    end;
end;
 
end.

Exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
var
  M:SmartPtr;
begin
  MEMGet(SizeOf(TBitmapInfoHeader),M);
  with PBitmapInfoHeader(M.Ptr)^ do
  ...
 
var
  M:SmartPtr;
  P:PBitmapInfoHeader;
begin
  P:= MEMGet(SizeOf(TBitmapInfoHeader),M);
  with P^ do
  ...

02/01/2011, 11h19
Paul TOTH

je ne comprend rien à ce code...en quoi permet-il de se passer de la libération ?!
02/01/2011, 20h08
Montor

La libération de mémoire se fait a la finalisation de record SmartPtr.Reserved ...mais on peut la faire manuellement avec MEMFree

ahhhh !!!! tu réinventes les tableaux dynamiques !

et pourquoi pas simplement

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
type
  SmartPtr = record
    Ptr: Pointer;
    Reserved: array of Byte;
  end;
 
function MEMAlloc(Size: Integer; var Anchor:SmartPtr): Pointer;
begin
  SetLength(Anchor.Reserved, Size);
  Anchor.Ptr := Pointer(Anchor.Reserved);
  Result := Anchor.Ptr;
end;

13/01/2011, 20h21
Montor

Pas possible imagine un SmartPtr passer comme const sur une autre fonction !
14/01/2011, 06h13
Paul TOTH

Citation:

Envoyé par Montor

Pas possible imagine un SmartPtr passer comme const sur une autre fonction !

hum...je ne vois pas bien où tu veux en venir...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
procedure DoSomeThing(APtr:SmartPtr);
begin
 
end;
 
var
  M:SmartPtr;
  P:PBitmapInfoHeader;
begin
  P:= MEMGet(SizeOf(TBitmapInfoHeader),M);
  DoSomeThing(M);//ici

Que pense-tu si je passe Smartptr dans une autre contexte

Citation:
Envoyé par Montor
Code:

1 2 3 4 5 6 7 8 9 10 11 12 procedure DoSomeThing(APtr:SmartPtr); begin end; var M:SmartPtr; P:PBitmapInfoHeader; begin P:= MEMGet(SizeOf(TBitmapInfoHeader),M); DoSomeThing(M);//ici
Que pense-tu si je passe Smartptr dans une autre contexte
j'avais compris la question, mais pas les conséquences que tu images...ni la différence avec ton code...d'autant qu'ici DoSomeThing ne fait rien
Code:

1 2 3 4 5 6 7 8 9 10 procedure DoSomeThing1(APtr:SmartPtr); begin MEMAlloc(10,APtr); // M n'est pas affecté end; procedure DoSomeThing2(APtr:SmartPtr); begin Byte(APtr.Ptr^) := 255; // le contenu de M l'est end;