Il est possible pour utiliser les fonctions asm pour creer des fonctions Delphi
si on veut _DynArrayLength doit être appeler explicitementFreemem
Code : Sélectionner tout - Visualiser dans une fenêtre à part System.@DynArrayLength
Petite collection:
Code : Sélectionner tout - Visualiser dans une fenêtre à part System.@Freemempetite démonstration pour copier les tableaux dynamiques
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 function DynAddRef_V1(const AInp:string):Pointer; asm JMP System.@LStrAddRef end; procedure DynRelease_V1(var P: Pointer); asm JMP System.@LStrClr end; function DynLength(source:pointer):Longint; asm jmp System.@DynArrayLength end; function DynCopy(a: Pointer; typeInfo: Pointer): Pointer; asm {B:=Copy(A);} LEA ECX,Result call System.@DynArrayCopy end; procedure DynClear(a: Pointer; typeInfo: Pointer); asm {tab := nil } jmp System.@DynArrayClear end;
Utilisation
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 function DynCopy(a: Pointer; typeInfo: Pointer): Pointer; asm {B:=Copy(A);} LEA ECX,Result call System.@DynArrayCopy end; procedure DynClear(a: Pointer; typeInfo: Pointer); asm {tab := nil } jmp System.@DynArrayClear end; procedure CopyArrayRec(var Dest;Source:Pointer;typeinfo:PDynArrayTypeInfo); var i,Len:integer; Ar:array of Pointer; begin if Assigned(Source) and Assigned(typeinfo) and (typeinfo.kind = 17) then begin DynClear(@Dest,typeinfo); if Assigned(typeinfo.elType) then begin Inc(PChar(typeinfo), Length(typeinfo.name)); Len:= Pinteger(Integer(Source)-4)^ ; Setlength(Ar,Len); for i := 0 to Len-1 do CopyArrayRec(Ar[i],PPointerArray(Source)[i],typeinfo.elType^); Pointer(Dest):= Pointer(Ar); Pointer(Ar):=nil; end else Pointer(Dest):= DynCopy(Source,typeinfo); end; end;
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 procedure TForm1.Button1Click(Sender: TObject); type TNewtype= array of array of array of Word; var h,k :TNewtype; i,C :integer; x,y,z :integer; ix,iy,iz:integer; begin k:=nil; i:=0; x:=2; y:=2; z:=2; SetLength(h,x,y,z); for ix := 0 to x-1 do for iy := 0 to y-1 do for iz := 0 to z-1 do begin h[ix,iy,iz]:=i; inc(i); end; C:=AllocMemSize; {Rien se passe lorsque on active cette ligne puisque } {le tableau est effacé avant d'etre reutiliser.} //SetLength(k,x,y,z); CopyArrayRec(k,H,TypeInfo(TNewtype)); Showmessagefmt('Taille allouée : %d',[AllocMemSize-C]); k[1,1,1]:=133; for ix := 0 to x-1 do for iy := 0 to y-1 do for iz := 0 to z-1 do begin Showmessagefmt('%p -> %d'#10'%p -> %d',[ @k[ix,iy,iz],k[ix,iy,iz], @h[ix,iy,iz],h[ix,iy,iz] ]); end; end;
Partager