Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
44 - RESERVER LA MÉMOIRE PHYSIQUE

PRÉSENTATION : Réserver une partie de la mémoire en mémoire physique et non virtuelle.
ZIP : Téléchargez le zip APERÇUS :

NOTES : ATTENTION : Se source ne fonctionne qu'avec Windows 2000 Pro et Windows XP Pro. D'autre part si vous êtes débutant ne l'utilisez pas, car des erreurs dans l'utilisation des fonctione AWE peut avoir des conséquences graves.

Cet exemple est la traduction de celui de MSDN situé ici :
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/memory/base/awe_example.asp

Pour que la réservation fonctionne, il faut que l'utilisateur est le droit de verrouiller des pages en mémoire. Ce n'est jamais le cas par défaut même pour les sessions administrateurs. Pour ajouter ce droit, il faut procéder comme suit ( Windows 2000 Pro ) :
- Lacer une session administrateur
- puis aller dans le panneau de configuration
- Icône "outils d'administrations"
- double-click sur "stratégie locale"
- dans la fenêtre des stratégies, choisir dans la partie gauche "stratégies locales"
- puis choisir "Attribution des droits utilisateurs"
- dans la partie de droite, en fin de liste il y a "Verrouiller des pages en mémoire"
- double-click dessus et ajouter les comptes de type "Administrateurs"
- valider les modifications.

L'exemple donné ici réserve 1Mo en mémoire et le restitue ensuite à Windows. A la fin de la réservation le pointeur lpMemReserved indique le début de la zone en mémoire Physique.
Ici tout est dans la même procédure, mais vous pouvez bien sûr le faire en deux parties : réservation et libération. Mais attention, il faut alors que la variable aPFNs soit globale et que son contenu ne soit jamais modifié entre la réservation et la libération.


CODE :
Unit Unit1;
//
// Sujet : Réserver de la memoire Physique
//
// Par Nono40 : http://nono40.developpez.com   http://nono40.fr.st
//              mailTo:nono40@fr.st
//
// Le 15/03/2003
//
// Attention ne fonctionne qu'avec Windows 2000 PRO et Xp PRO
//
// C'est la traduction de l'exemple de MSDN :
// http://msdn.microsoft.com/library/default.asp?url=/library/en-us/memory/base/awe_example.asp
//

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

Type
  TForm1 = Class(TForm)
    Button1: TButton;
    Procedure Button1Click(Sender: TObject);
  Private
    { Déclarations privées }
  Public
    { Déclarations publiques }
  End;

Var
  Form1: TForm1;

Implementation

{$R *.dfm}

Function AllocateUserPhysicalPages(hProcess:THandle;NumberOfPages:Pointer;UserPfnArray:Pointer) 
          :Bool;StdCall; External 'Kernel32.dll' Name 'AllocateUserPhysicalPages'
Function MapUserPhysicalPages(lpAddress:Pointer;NumberOfPages:Cardinal;UserPfnArray:Pointer) 
          :Bool;StdCall; External 'Kernel32.dll' Name 'MapUserPhysicalPages'
Function FreeUserPhysicalPages(hProcess:THandle;NumberOfPages:Pointer;UserPfnArray:Pointer)
          :Bool;StdCall; External 'Kernel32.dll' Name 'FreeUserPhysicalPages'

Function _AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;
  NewState: PTokenPrivileges; BufferLength: DWORD;
  PreviousState: Integer; ReturnLength: Integer): BOOL;stdcall; 
  external advapi32 name 'AdjustTokenPrivileges';

Const MEM_PHYSICAL = $400000;

Function LoggedSetLockPagesPrivilege ( hProcess:THANDLE;bEnable:Boolean):Boolean; 
Var 
  Info  : TTokenPrivileges; 
  Token : THandle; 
  Res   : Boolean; 
Const SE_LOCK_MEMORY_NAME='SeLockMemoryPrivilege'
Begin
  // Open the token. 
  Res := OpenProcessToken ( hProcess,TOKEN_ADJUST_PRIVILEGES,Token); 

  If Not Res Then 
  Begin 
    ShowMessage('Cannot open process token.' ); 
    Result:=False; 
    Exit;
  End

  // Enable or disable? 
  Info.PrivilegeCount := 1
  If  bEnable 
    Then Info.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED 
    Else Info.Privileges[0].Attributes := 0

  // Get the LUID. 
  Res := LookupPrivilegeValue ( Nil,SE_LOCK_MEMORY_NAME,Info.Privileges[0].Luid);

  If Not Res Then 
  Begin
    ShowMessage('Cannot get privilege value For SE_LOCK_MEMORY_NAME.' ); 
    Result:=False; 
    Exit; 
  End;

  // Adjust the privilege. 
  Res := _AdjustTokenPrivileges ( Token, FALSE,@Info, 000); 

  If Not Res Then 
  Begin
    ShowMessage('Cannot adjust token privileges, error '+IntToStr(GetLastError)); 
    Result:=False; 
    Exit; 
  End 
  Else 
  Begin 
    If GetLastError<>ERROR_SUCCESS Then 
    Begin
      ShowMessage('Cannot enable SE_LOCK_MEMORY privilege, please check the local policy.'); 
      Result:=False; 
      Exit; 
    End
  End

  CloseHandle( Token );

  Result:=True; 
End;

Const MEMORY_REQUESTED=1024*1024;

Procedure TForm1.Button1Click(Sender: TObject);
Var
  bResult              : Boolean;     // generic Boolean value
  NumberOfPages        : Cardinal;    // number of pages to request
  NumberOfPagesInitial : Cardinal;    // initial number of pages requested
  aPFNs                : ^Cardinal;   // page info; holds opaque data
  lpMemReserved        : Pointer;     // AWE window
  sSysInfo             : TSystemInfo; // useful system information
  PFNArraySize         : Integer;     // memory to request for PFN array
Begin
  GetSystemInfo(sSysInfo);  // fill the system information structure

  ShowMessage('This computer has a page size Of '+IntToStr(sSysInfo.dwPageSize));

  // Calculate the number of pages of memory to request.

  NumberOfPages := MEMORY_REQUESTED Div sSysInfo.dwPageSize;
  ShowMessage('Requesting '+IntToStr(NumberOfPages)+' pages Of memory.\n');

  // Calculate the size of the user PFN array.
  PFNArraySize := NumberOfPages * sizeof (Cardinal);

  GetMem(aPFNS,PFNArraySize);
  If (aPFNs = Nil)
  Then Begin
    ShowMessage('Failed To allocate On heap.');
    Exit;
  End;

  // Enable the privilege.
  If Not LoggedSetLockPagesPrivilege( GetCurrentProcess, TRUE ) Then Exit;

  // Allocate the physical memory. 
  NumberOfPagesInitial := NumberOfPages; 
  bResult := AllocateUserPhysicalPages( GetCurrentProcess,@NumberOfPages,aPFNs ); 
  If Not bResult Then 
  Begin 
    ShowMessage('Cannot allocate physical pages, error '+IntToStr(GetLastError)); 
    Exit; 
  End
  If  NumberOfPagesInitial <> NumberOfPages Then
  Begin 
    ShowMessage('Allocated only '+IntToStr(NumberOfPages)+' pages.'); 
    Exit; 
  End

  // Reserve the virtual memory. 
  lpMemReserved := VirtualAlloc( Nil
                                 MEMORY_REQUESTED,
                                 MEM_RESERVE Or MEM_PHYSICAL,
                                 PAGE_READWRITE ); 
  If lpMemReserved = Nil Then 
  Begin 
    ShowMessage('Cannot reserve memory.'); 
    Exit; 
  End

  // Map the physical memory into the window. 
  bResult := MapUserPhysicalPages( lpMemReserved,NumberOfPages,aPFNs );
  If Not bResult Then 
  Begin 
    ShowMessage('MapUserPhysicalPages failed To map, error '+IntToStr(GetLastError));
    Exit; 
  End

  //****************************************
  //Utiliser ici la zone pointée par lpMemReserved
  //****************************************
  ShowMessage('Réservation réussie !!!');

  // unmap
  bResult := MapUserPhysicalPages( lpMemReserved,NumberOfPages,Pointer(0) );
  If Not bResult Then
  Begin
    ShowMessage('MapUserPhysicalPages failed To unmap, error '+IntToStr(GetLastError));
    Exit;
  End;

  // Free the physical pages.
  bResult := FreeUserPhysicalPages( GetCurrentProcess,@NumberOfPages,aPFNs );
  If Not bResult Then
  Begin
    ShowMessage('Cannot free physical pages, error '+IntToStr(GetLastError));
    Exit;
  End;

  // Free virtual memory.
  VirtualFree( lpMemReserved, 0, MEM_RELEASE );

  // Libération zone réservée avec GetMem
  FreeMem(aPFNS,PFNArraySize);
End;

End.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -