No hay respuestas en este tema

[monchito_elroro]

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

unit Unit1;
{$mode objfpc}{$H+}
 
interface
 
uses
  windows,
  Classes,
  SysUtils,
  FileUtil,
  Forms,
  Controls,
  Graphics,
  Dialogs,
  Buttons, StdCtrls;
  {ECProgressBar,
  BGRAFlashProgressBar;}
 
type
   SYSTEM_INFORMATION_CLASS = (
      SystemFileCacheInformation = 21,
      SystemMemoryListInformation = 80
   );
 
   SYSTEM_FILECACHE_INFORMATION = record
      CurrentSize : NativeUInt;
      PeakSize : NativeUInt;
      PageFaultCount : ULONG;
      MinimumWorkingSet : NativeInt;
      MaximumWorkingSet : NativeInt;
      CurrentSizeIncludingTransitionInPages : NativeUInt;
      PeakSizeIncludingTransitionInPages : NativeUInt;
      TransitionRePurposeCount : ULONG;
      Flags : ULONG;
   end;
   PSYSTEM_FILECACHE_INFORMATION = ^SYSTEM_FILECACHE_INFORMATION;
 
   SYSTEM_MEMORY_LIST_COMMAND = (
      MemoryCaptureAccessedBits,
      MemoryCaptureAndResetAccessedBits,
      MemoryEmptyWorkingSets,
      MemoryFlushModifiedList,
      MemoryPurgeStandbyList,
      MemoryPurgeLowPriorityStandbyList,
      MemoryCommandMax
   );
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label1: TLabel;
    Memo1: TMemo;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
     NtSetSystemInformation : function  (
      SystemInformationClass: SYSTEM_INFORMATION_CLASS;
      SystemInformation: Pointer; //  __in_bcount_opt(SystemInformationLength) PVOID SystemInformation,
      SystemInformationLength: ULONG) : Integer; stdcall;
      full : Boolean;
 
         ntdll : HMODULE;
   processToken : THandle;
   info : SYSTEM_FILECACHE_INFORMATION;
   command : Integer;
   option : String;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
function SetPrivilege(hToken : THandle; lpszPrivilege : PChar; bEnablePrivilege : Boolean) : Boolean;
var
   tp : TTokenPrivileges;
   luid : Int64;
   rl : DWORD;
begin
   if (not LookupPrivilegeValue(nil, lpszPrivilege, luid)) then
      Exit(False);
 
   tp.PrivilegeCount := 1;
   tp.Privileges[0].Luid := luid;
   if bEnablePrivilege then
      tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
   else tp.Privileges[0].Attributes := 0;
 
   if (not AdjustTokenPrivileges(hToken, FALSE, tp, sizeof(TOKEN_PRIVILEGES), PTokenPrivileges(NIL)^, rl)) then
      Exit(False);
 
   Result := (GetLastError() <> ERROR_NOT_ALL_ASSIGNED);
end;
 
function SendMemoryCommand(command : SYSTEM_MEMORY_LIST_COMMAND) : Integer;
var
   buf : Integer;
begin
   buf:=Integer(command);
   Result:=NtSetSystemInformation(SystemMemoryListInformation, @buf, SizeOf(buf))
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   form1.Memo1.Clear;
     // Get NtSetSystemInformation
   ntdll := LoadLibrary('NTDLL.DLL');
   pointer(NtSetSystemInformation) := GetProcAddress(ntdll, 'NtSetSystemInformation');
   if not Assigned(NtSetSystemInformation) then begin
 
      form1.Memo1.Lines.Add('Unsupported OS version');
      Exit;
   end;
 
   if (OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, processToken) = FALSE) then begin
      form1.Memo1.Lines.Add('Failed to open privileges token');
      Exit;
   end;
end;
 
procedure limpiar_ram;
begin
  form1.Memo1.Clear;
 
     // Clear FileCache WorkingSet
 
   if SetPrivilege(processToken, 'SeIncreaseQuotaPrivilege', True) then begin
 
      ZeroMemory(@info, sizeof(info));
      info.MinimumWorkingSet := -1;
      info.MaximumWorkingSet := -1;
      if NtSetSystemInformation(SystemFileCacheInformation, @info, sizeof(info))>=0 then
         form1.Memo1.Lines.Add('Flushed FileCache WorkingSet')
      else form1.Memo1.Lines.Add('Failed to flush FileCache WorkingSet');
 
   end else form1.Memo1.Lines.Add('Failed to obtain IncreaseQuotaPrivilege');
 
   // Purge Memory Standby
 
   if SetPrivilege(processToken, 'SeProfileSingleProcessPrivilege', True) then begin
 
      command := Integer(MemoryEmptyWorkingSets);
      if NtSetSystemInformation(SystemMemoryListInformation, @command, sizeof(command))>=0 then
         form1.Memo1.Lines.Add('Emptied Memory Working Sets')
      else form1.Memo1.Lines.Add('Failed to empty Memory Working Sets');
 
      if full then begin
         if SendMemoryCommand(MemoryFlushModifiedList)>=0 then
            form1.Memo1.Lines.Add('Flush Modified List')
         else form1.Memo1.Lines.Add('Failed to flush Modified List');
 
         if SendMemoryCommand(MemoryPurgeStandbyList)>=0 then
            form1.Memo1.Lines.Add('Purged Memory Standby List')
         else form1.Memo1.Lines.Add('Failed to purge Memory Standby List');
 
         if SendMemoryCommand(MemoryPurgeLowPriorityStandbyList)>=0 then
            form1.Memo1.Lines.Add('Purged Memory Low-Priority Standby List')
         else form1.Memo1.Lines.Add('Failed to purge Memory Low-Priority Standby List');
      end;
 
   end else form1.Memo1.Lines.Add('Failed to obtain ProfileSingleProcessPrivilege');
end;
 
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  full:=false;
  limpiar_ram;
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  full:=true;
  limpiar_ram;
end;
 
end.

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.