Ir al contenido


Foto

limpiar toda la memoria ram


  • Por favor identifícate para responder
No hay respuestas en este tema

#1 monchito_elroro

monchito_elroro

    Advanced Member

  • Miembros
  • PipPipPip
  • 255 mensajes

Escrito 15 octubre 2020 - 09:01

hola amigos a los tiempos, espero se encuentren bien.

una consulta estoy queriendo crear una aplicación para poder limpiar la memoria ram, tal como lo hacen varios programas freeware.

 

buscando he encontrado este código que funciona a la perfección, dandome dos tipos de limpieza:

1. rápida y libera poca memoria ram

2. lenta y libera mucha ram.

 

aquí les comparto el código:
 


php
  1. unit Unit1;
  2. {$mode objfpc}{$H+}
  3.  
  4. interface
  5.  
  6. uses
  7.   windows,
  8.   Classes,
  9.   SysUtils,
  10.   FileUtil,
  11.   Forms,
  12.   Controls,
  13.   Graphics,
  14.   Dialogs,
  15.   Buttons, StdCtrls;
  16.   {ECProgressBar,
  17.   BGRAFlashProgressBar;}
  18.  
  19. type
  20.    SYSTEM_INFORMATION_CLASS = (
  21.       SystemFileCacheInformation = 21,
  22.       SystemMemoryListInformation = 80
  23.    );
  24.  
  25.    SYSTEM_FILECACHE_INFORMATION = record
  26.       CurrentSize : NativeUInt;
  27.       PeakSize : NativeUInt;
  28.       PageFaultCount : ULONG;
  29.       MinimumWorkingSet : NativeInt;
  30.       MaximumWorkingSet : NativeInt;
  31.       CurrentSizeIncludingTransitionInPages : NativeUInt;
  32.       PeakSizeIncludingTransitionInPages : NativeUInt;
  33.       TransitionRePurposeCount : ULONG;
  34.       Flags : ULONG;
  35.    end;
  36.    PSYSTEM_FILECACHE_INFORMATION = ^SYSTEM_FILECACHE_INFORMATION;
  37.  
  38.    SYSTEM_MEMORY_LIST_COMMAND = (
  39.       MemoryCaptureAccessedBits,
  40.       MemoryCaptureAndResetAccessedBits,
  41.       MemoryEmptyWorkingSets,
  42.       MemoryFlushModifiedList,
  43.       MemoryPurgeStandbyList,
  44.       MemoryPurgeLowPriorityStandbyList,
  45.       MemoryCommandMax
  46.    );
  47.  
  48. type
  49.  
  50.   { TForm1 }
  51.  
  52.   TForm1 = class(TForm)
  53.     BitBtn1: TBitBtn;
  54.     BitBtn2: TBitBtn;
  55.     Label1: TLabel;
  56.     Memo1: TMemo;
  57.     procedure BitBtn1Click(Sender: TObject);
  58.     procedure BitBtn2Click(Sender: TObject);
  59.     procedure FormCreate(Sender: TObject);
  60.   private
  61.     { private declarations }
  62.   public
  63.     { public declarations }
  64.   end;
  65.  
  66. var
  67.   Form1: TForm1;
  68.      NtSetSystemInformation : function  (
  69.       SystemInformationClass: SYSTEM_INFORMATION_CLASS;
  70.       SystemInformation: Pointer; //  __in_bcount_opt(SystemInformationLength) PVOID SystemInformation,
  71.       SystemInformationLength: ULONG) : Integer; stdcall;
  72.       full : Boolean;
  73.  
  74.          ntdll : HMODULE;
  75.    processToken : THandle;
  76.    info : SYSTEM_FILECACHE_INFORMATION;
  77.    command : Integer;
  78.    option : String;
  79.  
  80. implementation
  81.  
  82. {$R *.lfm}
  83.  
  84. { TForm1 }
  85.  
  86. function SetPrivilege(hToken : THandle; lpszPrivilege : PChar; bEnablePrivilege : Boolean) : Boolean;
  87. var
  88.    tp : TTokenPrivileges;
  89.    luid : Int64;
  90.    rl : DWORD;
  91. begin
  92.    if (not LookupPrivilegeValue(nil, lpszPrivilege, luid)) then
  93.       Exit(False);
  94.  
  95.    tp.PrivilegeCount := 1;
  96.    tp.Privileges[0].Luid := luid;
  97.    if bEnablePrivilege then
  98.       tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
  99.    else tp.Privileges[0].Attributes := 0;
  100.  
  101.    if (not AdjustTokenPrivileges(hToken, FALSE, tp, sizeof(TOKEN_PRIVILEGES), PTokenPrivileges(NIL)^, rl)) then
  102.       Exit(False);
  103.  
  104.    Result := (GetLastError() <> ERROR_NOT_ALL_ASSIGNED);
  105.  
  106. function SendMemoryCommand(command : SYSTEM_MEMORY_LIST_COMMAND) : Integer;
  107. var
  108.    buf : Integer;
  109. begin
  110.    buf:=Integer(command);
  111.    Result:=NtSetSystemInformation(SystemMemoryListInformation, @buf, SizeOf(buf))
  112.  
  113. procedure TForm1.FormCreate(Sender: TObject);
  114. begin
  115.    form1.Memo1.Clear;
  116.      // Get NtSetSystemInformation
  117.    ntdll := LoadLibrary('NTDLL.DLL');
  118.    pointer(NtSetSystemInformation) := GetProcAddress(ntdll, 'NtSetSystemInformation');
  119.    if not Assigned(NtSetSystemInformation) then begin
  120.  
  121.       form1.Memo1.Lines.Add('Unsupported OS version');
  122.       Exit;
  123.    end;
  124.  
  125.    if (OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, processToken) = FALSE) then begin
  126.       form1.Memo1.Lines.Add('Failed to open privileges token');
  127.       Exit;
  128.    end;
  129.  
  130. procedure limpiar_ram;
  131. begin
  132.   form1.Memo1.Clear;
  133.  
  134.      // Clear FileCache WorkingSet
  135.  
  136.    if SetPrivilege(processToken, 'SeIncreaseQuotaPrivilege', True) then begin
  137.  
  138.       ZeroMemory(@info, sizeof(info));
  139.       info.MinimumWorkingSet := -1;
  140.       info.MaximumWorkingSet := -1;
  141.       if NtSetSystemInformation(SystemFileCacheInformation, @info, sizeof(info))>=0 then
  142.          form1.Memo1.Lines.Add('Flushed FileCache WorkingSet')
  143.       else form1.Memo1.Lines.Add('Failed to flush FileCache WorkingSet');
  144.  
  145.    end else form1.Memo1.Lines.Add('Failed to obtain IncreaseQuotaPrivilege');
  146.  
  147.    // Purge Memory Standby
  148.  
  149.    if SetPrivilege(processToken, 'SeProfileSingleProcessPrivilege', True) then begin
  150.  
  151.       command := Integer(MemoryEmptyWorkingSets);
  152.       if NtSetSystemInformation(SystemMemoryListInformation, @command, sizeof(command))>=0 then
  153.          form1.Memo1.Lines.Add('Emptied Memory Working Sets')
  154.       else form1.Memo1.Lines.Add('Failed to empty Memory Working Sets');
  155.  
  156.       if full then begin
  157.          if SendMemoryCommand(MemoryFlushModifiedList)>=0 then
  158.             form1.Memo1.Lines.Add('Flush Modified List')
  159.          else form1.Memo1.Lines.Add('Failed to flush Modified List');
  160.  
  161.          if SendMemoryCommand(MemoryPurgeStandbyList)>=0 then
  162.             form1.Memo1.Lines.Add('Purged Memory Standby List')
  163.          else form1.Memo1.Lines.Add('Failed to purge Memory Standby List');
  164.  
  165.          if SendMemoryCommand(MemoryPurgeLowPriorityStandbyList)>=0 then
  166.             form1.Memo1.Lines.Add('Purged Memory Low-Priority Standby List')
  167.          else form1.Memo1.Lines.Add('Failed to purge Memory Low-Priority Standby List');
  168.       end;
  169.  
  170.    end else form1.Memo1.Lines.Add('Failed to obtain ProfileSingleProcessPrivilege');
  171.  
  172. procedure TForm1.BitBtn1Click(Sender: TObject);
  173. begin
  174.   full:=false;
  175.   limpiar_ram;
  176.  
  177. procedure TForm1.BitBtn2Click(Sender: TObject);
  178. begin
  179.   full:=true;
  180.   limpiar_ram;
  181.  

mi consulta es como puedo evitar que me pida ejecutarlo como administrador, pues en los programas freeware que abundan en internet la mayoría realiza la tarea sin ser administrador o al menos eso creo.

 

muchas gracias por sus respuestas.

 

PD: adjunto el proyecto en lazarus.


  • 0