Totale/ Verfügbaren Ram Größe ermitteln... (gelöst)

[Corpsman]

Hossa Leutz,

ich habe hier die Funktionen

Delphi-Quellcode:

Function GetTotalRAM: Dword; // Liefert den Totalen RAM in Byte 
Var
  Memory: TMemoryStatus;
Begin
  Memory.dwLength := SizeOf(Memory);
  GlobalMemoryStatus(Memory);
  Result := Memory.dwTotalPhys;
End;

function GetFreeRAM : Dword; // Liefert den freien RAM in Byte
var
 Memory: TMemoryStatus;
begin
 Memory.dwLength := SizeOf(Memory);
  GlobalMemoryStatus(Memory);
  Result := Memory.dwAvailPhys;
end;

Und die Funktionieren auch wunderbar, das Problem ist nud das das alles nicht mehr geht wenn man 3 GB Ram hat :(

Hat mir da jemand ne Idee wie ich das lösen kann ?

[Christian Seehase]

Moin Corpsman,

hast Du das hier berücksichtigt?

Zitat:

Zitat von PSDK - GlobalMemoryStatus - Remarks

On Intel x86 computers with more than 2 GB and less than 4 GB of memory, the GlobalMemoryStatus function will always return 2 GB in the dwTotalPhys member of the MEMORYSTATUS structure. Similarly, if the total available memory is between 2 and 4 GB, the dwAvailPhys member of the MEMORYSTATUS structure will be rounded down to 2 GB. If the executable is linked using the /LARGEADDRESSAWARE linker option, then the GlobalMemoryStatus function will return the correct amount of physical memory in both members.

Vielleicht solltest Du es mal mit GlobalMemoryStatusEx probieren (ggf. selber importieren, bzw. die Datenstruktur deklarieren).
Length muss übrigens nicht initialisisert werden.

[Corpsman]

hossa Christian Seehase,

ich mus zugeben, ich hab dieses teil als ein Sample irgendwo mal gefunden und dann entsprechend zusammengestückelt wies die Delphi Hilfe Her gab.

in meinem Delphi5 stand da allerdings nichts von dem Bekannten Problem wie du es da Zitierst...

und die "GlobalMemoryStatusEx" gibts bei Delphi5 nicht,

gibts dann noch ne Möglichkeit das zum laufen zu bekommen ?

Du schreibst zwar selber machen, doch kenne ich mich da irgendwie wohl nicht genug damit aus .

[Christian Seehase]

Moin Corpsman,

ich habe das mal eben, quick and dirty, übersetzt:

Delphi-Quellcode:

type
  DWORDLONG = LONGLONG;
  _MEMORYSTATUSEX = packed record // packed, damit keine Speicherlöcher entstehen
    dwLength                : DWORD;
    dwMemoryLoad            : DWORD;
    ullTotalPhys            : DWORDLONG;
    ullAvailPhys            : DWORDLONG;
    ullTotalPageFile        : DWORDLONG;
    ullAvailPageFile        : DWORDLONG;
    ullTotalVirtual         : DWORDLONG;
    ullAvailVirtual         : DWORDLONG;
    ullAvailExtendedVirtual : DWORDLONG;
  end;

  TMemoryStatusEx = _MEMORYSTATUSEX;

// stdcall, weil die meisten API-Funktionen diese Aufrufkonvention verwenden
procedure GlobalMemoryStatusEx(var ABuffer : _MEMORYSTATUSEX); stdcall; external 'kernel32.dll';


// Anwendung

var
  ms : TMemoryStatusEx;

begin
  ms.dwLength := SizeOf(ms); // Bei dieser Funktion muss die Länge gesetzt werden
  GlobalMemoryStatusEx(ms);
  ShowMessage(IntToStr(ms.ullTotalPhys));
end;

So ganz gefällt mir das Ganze nicht, aber das liegt in erster Linie daran, dass ich, normaler Weise, nicht die borland-spezifische Übersetzung für Parameter verwende, wie hier, aber es ist leichter in der Anwendung, da man nicht extra Speicher reservieren, und später wieder freigeben muss.
Ein weiterer Punkt, der nicht ganz sauber ist, ist die Deklaration von DWORDLONG. LONGLONG ist als Int64 deklariert, ein DWORD sollte allerdings eigentlich ohne Vorzeichen sein. Bis wir über Rechner verfügen können, bei denen das eine Rolle spielt, haben wir wohl auch ein Delphi mit 64-Bit-Cardinal ;-)
Ausserdem könnte man die Funktion auch dynamisch importieren, und nicht statisch, wie hier, was den Vorteil hätte, vorher zu prüfen, ob die Funktion überhaupt verfügbar ist, und sie ggf. wegzulassen.
Bei statischem Import startet das Programm gar nicht erst, wenn die Funktion nicht vorhanden ist.

[hathor]

Teste doch mal das:

Delphi-Quellcode:

type
  PMemoryStatusEx = ^TMemoryStatusEx;
  LPMEMORYSTATUSEX = PMemoryStatusEx;
  {$EXTERNALSYM LPMEMORYSTATUSEX}
  _MEMORYSTATUSEX = packed Record
    dwLength : DWORD;
    dwMemoryLoad : DWORD;
    ullTotalPhys : Int64;
    ullAvailPhys : Int64;
    ullTotalPageFile: Int64;
    ullAvailPageFile: Int64;
    ullTotalVirtual : Int64;
    ullAvailVirtual : Int64;
    ullAvailExtenededVirtual : Int64;
  end;
  {$EXTERNALSYM _MEMORYSTATUSEX}
  TMemoryStatusEx = _MEMORYSTATUSEX;
  MEMORYSTATUSEX = _MEMORYSTATUSEX;
  {$EXTERNALSYM MEMORYSTATUSEX}

function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): BOOL; stdcall;
type
  TFNGlobalMemoryStatusEx = function(var msx: TMemoryStatusEx): BOOL;
  stdcall;
var
  FNGlobalMemoryStatusEx: TFNGlobalMemoryStatusEx;
begin
  lpBuffer.dwLength := SizeOf(TMemoryStatusEx);

  FNGlobalMemoryStatusEx := TFNGlobalMemoryStatusEx(
    GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx'));
  if not Assigned(FNGlobalMemoryStatusEx) then
  begin
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
    Result := False;
  end
  else
  begin
    Result := FNGlobalMemoryStatusEx(lpBuffer);
  end;
end;

function getIsWin2kXP: Boolean;
var
  oviVersionInfo: TOSVERSIONINFO;
begin
  oviVersionInfo.dwOSVersionInfoSize := SizeOf(oviVersionInfo);
  if not GetVersionEx(oviVersionInfo) then raise
    Exception.Create('Can''t get the Windows version');
  if (oviVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and
    (oviVersionInfo.dwMajorVersion >= 5) then getIsWin2kXP := true
  else getIsWin2kXP := false;
end;

function gettotalphysmemory: Int64;
var
  memory: TMemoryStatus;
  memoryEx: TMemoryStatusEx;
begin
  if getIsWin2kXP then
  begin
    memoryEx.dwLength := sizeof(TMemoryStatusEx);
    if GlobalMemoryStatusEx(memoryEx) then gettotalphysmemory :=
      memoryEx.ulltotalphys
    else gettotalphysmemory := 0;
  end
  else
  begin
    memory.dwLength := sizeof(TMemoryStatus);
    GlobalMemoryStatus(memory);
    gettotalphysmemory := memory.dwtotalphys;
  end;
end;

function getavailphysmemory: Int64;
var
  memory: TMemoryStatus;
  memoryEx: TMemoryStatusEx;
begin
  if getIsWin2kXP then
  begin
    memoryEx.dwLength := sizeof(TMemoryStatusEx);
    if GlobalMemoryStatusEx(memoryEx) then getavailphysmemory :=
      memoryEx.ullavailphys
    else getavailphysmemory := 0;
  end
  else
  begin
    memory.dwLength := sizeof(TMemoryStatus);
    GlobalMemoryStatus(memory);
    getavailphysmemory := memory.dwavailphys;
  end;
end;

function gettotalpagefile: Int64;
var
  memory: TMemoryStatus;
  memoryEx: TMemoryStatusEx;
begin
  if getIsWin2kXP then
  begin
    memoryEx.dwLength := sizeof(TMemoryStatusEx);
    if GlobalMemoryStatusEx(memoryEx) then gettotalpagefile :=
      memoryEx.ulltotalpagefile
    else gettotalpagefile := 0;
  end
  else
  begin
    memory.dwLength := sizeof(TMemoryStatus);
    GlobalMemoryStatus(memory);
    gettotalpagefile := memory.dwtotalpagefile;
  end;
end;

function getavailpagefile: Int64;
var
  memory: TMemoryStatus;
  memoryEx: TMemoryStatusEx;
begin
  if getIsWin2kXP then
  begin
    memoryEx.dwLength := sizeof(TMemoryStatusEx);
    if GlobalMemoryStatusEx(memoryEx) then getavailpagefile :=
      memoryEx.ullavailpagefile
    else getavailpagefile := 0;
  end
  else
  begin
    memory.dwLength := sizeof(TMemoryStatus);
    GlobalMemoryStatus(memory);
    getavailpagefile := memory.dwavailpagefile;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
BEGIN
Memo1.clear;
Memo1.lines.add(' gettotalphysmemory : '+ IntToStr(gettotalphysmemory));
Memo1.lines.add(' getavailphysmemory : '+ IntToStr(getavailphysmemory));
Memo1.lines.add(' gettotalpagefile : '+ IntToStr(gettotalpagefile));
Memo1.lines.add(' getavailpagefile : '+ IntToStr(getavailpagefile));
END;

[hathor]

Mit WMI sollte es auch gehen:

Delphi-Quellcode:

function GetWMIstring (wmiHost, wmiClass, wmiProperty : string):string;
var  // These are all needed for the WMI querying process
  Locator:  ISWbemLocator;
  Services: ISWbemServices;
  SObject:  ISWbemObject;
  ObjSet:   ISWbemObjectSet;
  SProp:    ISWbemProperty;
  Enum:     IEnumVariant;
  Value:    Cardinal;
  TempObj:  OleVariant;
  SN: string;
begin
  try
  Locator := CoSWbemLocator.Create;
   Services :=  Locator.ConnectServer(wmiHost, 'root\cimv2', '', '', '','', 0, nil);
  ObjSet := Services.ExecQuery('SELECT * FROM '+wmiClass, 'WQL',
    wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
  Enum :=  (ObjSet._NewEnum) as IEnumVariant;
  while (Enum.Next(1, TempObj, Value) = S_OK) do
  begin
    SObject := IUnknown(tempObj) as ISWBemObject;
    SProp := SObject.Properties_.Item(wmiProperty, 0);
    if VarIsNull(SProp.Get_Value) then
      result := ''
    else
    begin
      SN := SProp.Get_Value;
      result :=  SN;
    end;
  end;
  except // Trap any exceptions (Not having WMI installed will cause one!)
   on exception do
    result := '';
   end;
end;

function AddThouSeps (const S: string): string;
var LS, L2, I : Integer;
    Temp : string;
begin
    result := S ;
    LS := Length (S);
    if LS <= 3 then exit ;
    L2 := (LS - 1) div 3;
    Temp := '';
    for I := 1 to L2 do
            Temp := ThousandSeparator + Copy (S, LS - 3 * I + 1, 3) + Temp;
    Result := Copy (S, 1, (LS - 1) mod 3 + 1) + Temp;
end;

procedure TForm1.FormCreate(Sender: TObject);
var 
MaxProcessMemorySize1,FreePhysicalMemory1,FreeSpaceInPagingFiles1,FreeVirtualMemory1 :string;
begin
  Memo1.clear;
  MaxProcessMemorySize1:= getWMIstring('','Win32_OperatingSystem','MaxProcessMemorySize');
  FreePhysicalMemory1:= getWMIstring('','Win32_OperatingSystem','FreePhysicalMemory');
  FreeSpaceInPagingFiles1:= getWMIstring('','Win32_OperatingSystem','FreeSpaceInPagingFiles');
  FreeVirtualMemory1:= getWMIstring('','Win32_OperatingSystem','FreeVirtualMemory');

  Memo1.lines.add(' MaxProcessMemorySize : '+ AddThouSeps(MaxProcessMemorySize1) + ' kB');
  Memo1.lines.add(' FreePhysicalMemory : '+ AddThouSeps(FreePhysicalMemory1) + ' kB');
  Memo1.lines.add(' FreeSpaceInPagingFiles : '+ AddThouSeps(FreeSpaceInPagingFiles1) + ' kB');
  Memo1.lines.add(' FreeVirtualMemory : '+ AddThouSeps(FreeVirtualMemory1) + ' kB');
end;

[Corpsman]

Vielen Dank leute,

ich werde hathor's variante ohne WMI nehmen, da da keine Strings drin sind, und mir das irgendwie Sympathischer ist.