(940)  Anmelden

Deutsch
Quelltexte/ Codesnippets

Frei Giga Größe Mem Ram Speicher System Verfügbar

 

Michael
Wodrich

KompilierenMarkierenSeparieren
Keywords: Speicher, Memory, 64-Bit-Long
Systemspeicher durchleuchten
(sollte eigentlich auch mit gigas zurechtkommen)
jac/wod
 $H windows.ph
struct MemEx = dwLength&,
dwMemoryLoad&,
TotalPhysLo&,TotalPhysHi&,
AvailPhysLo&,AvailPhysHi&,
TotalPageFileLo&,TotalPageFileHi&,
AvailPageFileLo&,AvailPageFileHi&,
TotalVirtualLo&,TotalVirtualHi&,
AvailVirtualLo&,AvailVirtualHi&,
AvailExtendedVirtualLo&,AvailExtendedVirtualHi&

Proc Zeige_Mem

    Parameters anzeigetext$, groesse!
    Declare Typ$
    Typ$ = Bytes

    If groesse! > 1024

        groesse! = groesse! / 1024
        Typ$ = KB

    EndIf

    If groesse! > 1024

        groesse! = groesse! / 1024
        Typ$ = MB

    EndIf

    If groesse! > 1024

        groesse! = groesse! / 1024
        Typ$ = GB

    EndIf

    Print    ;anzeigetext$; :, Format$(#,0,groesse!), Typ$

EndProc

cls
declare b#, f!
Dim b#, MemEx
b#.dwLength& = SizeOf(b#)
External(~kernel32,GlobalMemoryStatusEx,b#)
Print
Print    Load:  + Str$(b#.dwMemoryLoad&) + %
f! = b#.TotalPhysHi& * 2^32 + b#.TotalPhysLo&
Zeige_Mem(TotalPhys, f!)
f! = b#.AvailPhysHi& * 2^32 + b#.AvailPhysLo&
Zeige_Mem(AvailPhys, f!)
f! = b#.TotalPageFileHi& * 2^32 + b#.TotalPageFileLo&
Zeige_Mem(TotalPageFile, f!)
f! = b#.AvailPageFileHi& * 2^32 + b#.AvailPageFileLo&
Zeige_Mem(AvailPageFile, f!)
f! = b#.TotalVirtualHi& * 2^32 + b#.TotalVirtualLo&
Zeige_Mem(TotalVirtual, f!)
f! = b#.AvailVirtualHi& * 2^32 + b#.AvailVirtualLo&
Zeige_Mem(AvailVirtual, f!)
f! = b#.AvailExtendedVirtualHi& * 2^32 + b#.AvailExtendedVirtualLo&
Zeige_Mem(AvailExtendedVirtual, f!)
Print
Print -Ende nach Tastendruck-
Dispose b#
waitkey
end
 
Programmieren, das spannendste Detektivspiel der Welt.
03.01.2009  ▲
 




Jac
de
Lad
Zu erwähnen sei hier nochmals, dass das bei meinen 8GB immer noch 4 ausspuckt.
 
Profan² 2.6 bis XProfan 11.1+XPSE+XPIA+XPRR (und irgendwann XIDE)
Core2Duo E8500/T2250, 8192/1024 MB, Radeon HD4850/Radeon XPress 1250, Vista64/XP
03.01.2009  ▲
 



Hallo Jac
Hier ist ein Code von Andreas Miethe aus 2000
Was zeigt der Dir an ?
ScreenShot wäre schön
KompilierenMarkierenSeparieren
 $H Windows.ph
Print MajorVersion:  + @Str$((~GetVersion() & $FFFF) & $FF)
Print MinorVersion:  + @Str$((~GetVersion() & $FFFF) >> 8)
Print $WinVer
WaitInput
######################################
Short-System-Info
######################################
System-Informationen abfragen
ab Profan 7.X
Andreas Miethe Dezember 2000
######################################
--------------------------------------
Funktionen ( WIN-API )
--------------------------------------
DEF GetVersionEx(1) ! Kernel32,GetVersionExA
DEF GlobalMemoryStatus(1) ! Kernel32,GlobalMemoryStatus
DEF GetDiskFreeSpace(5) ! Kernel32,GetDiskFreeSpaceA
DEF GetDiskFreeSpaceEx(4) !KERNEL32,GetDiskFreeSpaceExA
DEf GetLogicalDriveStrings(2) ! KERNEL32,GetLogicalDriveStringsA
Def GetDriveType(1) ! KERNEL32,GetDriveTypeA
Def GetVolumeInformation(8) ! Kernel32.dll,GetVolumeInformationA
Def GetStockObject(1) !GDI32,GetStockObject
Def SetDefaultGUIFont(1) SendMessage(&(1),$30,Val(GetStockObject($11)),1)
DEF SetWindowlong(3) ! User32,SetWindowLongA
DEF @GSFP(4) ! Shell32,SHGetSpecialFolderPathA
DEF @GTP(2) ! Kernel32,GetTempPathA
DEF GetWindowlong(2) ! User32,GetWindowLongA
DEf LockWindowUpdate(1) ! USER32,LockWindowUpdate
DEf GetColor(1) ! User32,GetSysColor
--------------------------------------
Konstanten
--------------------------------------
DEf &Ver_Platform_Win32_Windows 1
DEf &Ver_Platform_Win32_NT 2
--------------------------------------
--------------------------------------
Strukturen
--------------------------------------
Struct OSVERSIONINFO = dwOSVersionInfoSize&,dwMajorVersion&,dwMinorVersion&,
dwBuildNumber&,dwPlatformId&,szCSDVersion$(128)
Struct MEMORYSTATUS  = dwLenght&,dwMemoryLaod&,dwTotalPhys&,dwAvailPhys&,
dwTotalPageFile&,dwAvailPageFile&,
dwTotalVirtual&,dwAvailVirtual&
Struct LW            = LWString$(104)
Struct RootString    = ROOT$(4)
Struct VolumeName    = VN$(260)
Struct FileSystemBuf = FS$(260)
Struct PfadInfo      = PfadInf$(260)
--------------------------------------
--------------------------------------
Globale Variablen und private Definitionen
--------------------------------------
Declare OS#,MEM#,LW#,RS#,VN#,FS#
Declare Liste&,SystemInfo&,LaufwerksInfo&,PfadInfo&,Ende&
Declare Ende%,St$
Declare Pfad#
Declare winver$
Usermessages $210
Def HiWord(1) Div&(&(1),$10000)
Def LoWord(1) And(&(1),$FFFF)
--------------------------------------
--------------------------------------
Prozeduren
--------------------------------------

Proc GetOSInfo

    IF $winver = 5.0

        Winver$=Windows XP

    ElseIf Winver$=5.1

        Winver$=Windows Vista

    EndIf

    RETURN winver$

EndProc

Proc GetMemoryStatus

    Decimals 2
    Dim MEM#,MEMORYSTATUS
    GlobalMemoryStatus(MEM#)
    Var A! = MEM#.dwAvailPhys&/1024/1024
    Var B! = MEM#.dwTotalPhys&/1024/1024
    AddString(Liste&,Arbeitsspeicher benutzt : + Str$(MEM#.dwMemoryLaod&) +  %)
    AddString(Liste&,Arbeitsspeicher total :  + Format$(###,###,###.##,B!) +  MB)
    AddString(Liste&,Arbeitsspeicher total gerechnet :  + Format$(###,###,###.##,Str$((((MEM#.dwAvailPhys&) / ( 100-MEM#.dwMemoryLaod&))*100)/1024/1024)) +  MB)
    AddString(Liste&,Arbeitsspeicher verfügbar:  + Format$(###,###,###.##,A!) +  MB)
    AddString(Liste&,Virtueller Speicher total :  + Format$(###,###,###.##,Str$(MEM#.dwTotalVirtual&/1024/1024)) +  MB)
    AddString(Liste&,Virtueller Speicher verfuegbar :  + Format$(###,###,###.##,Str$(MEM#.dwAvailVirtual&/1024/1024)) +  MB)
    PRINT Arbeitsspeicher total gerechnet :  + Format$(###,###,###.##,Str$((((MEM#.dwAvailPhys&) / ( 100-MEM#.dwMemoryLaod&))*100)/1024/1024)) +  MB
    Dispose MEM#

EndProc

Proc GetDiskSpace

    Declare lw#,freiuser#,total#,frei#,Lolong&,Hilong&,loergebnis!,hiergebnis!
    Declare Gesamt!,Frei!
    Declare alles!
    Declare RootPathName$
    Declare Ret&,Ver&,Z$
    Dim lw#,3
    Dim frei#,8
    Dim total#,8
    Dim freiuser#,8
    Ver& = 65
    Addstring(Liste&,)
    Addstring(Liste&,Speicherplatz :)

    Whilenot Ver& = 91

        RootPathName$ = CHR$(Ver&)+: Wurde von mir umgeändert
        RootPathName$ = CHR$(Ver&)
        String lw#,0=RootPathName$
        Ret& = GetDiskFreeSpaceEx(lw#,freiuser#,total#,frei#)

        If ret& > 0

            Let loergebnis!=Long(total#,0)
            Let hiergebnis!=Long(total#,4)
            case @Lt(loergebnis!,0): let loergebnis!= @Add(loergebnis!, @Pow(2,32))
            Let Gesamt!= @Add(@Mul(hiergebnis!, @Pow(2,32)), loergebnis!)
            Z$ = RootPathName$ + Format$(###,###,##0.##,(Gesamt!) / 1024 / 1024)
            Z$ = Z$ +  MB frei  -
            Let loergebnis!=Long(frei#,0)
            Let hiergebnis!=Long(frei#,4)
            case @Lt(hiergebnis!,0): let hiergebnis!= @Add(hiergebnis!, @Pow(2,32))
            case @Lt(loergebnis!,0): let loergebnis!= @Add(loergebnis!, @Pow(2,32))
            Let Frei!= @Add(@Mul(hiergebnis!, @Pow(2,32)), loergebnis!)
            Z$ = Z$ + Format$(###,###,##0.##,(Frei!) / 1024 / 1024)
            Z$ = Z$ +  MB frei  -
            Z$ = Z$ + Format$(###,###,##0.##,(Gesamt!-Frei!) / 1024 / 1024)
            Z$ = Z$ +  MB belegt
            Addstring(Liste&,z$)
            alles! = alles!+frei!

        Endif

        Ver& = Ver& +1

    EndWhile

    Addstring(Liste&,Format$(Frei insgesamt : ###,###,##0.## MB,alles! / 1024 / 1024 ))
    dispose lw#

EndProc

Proc GetVolumeInfos

    Parameters ROOT$
    Declare RET&,SerialNumber&,MCL&,Flag&
    Dim RS#,RootString
    Dim VN#,VolumeName
    Dim FS#,FileSystemBuf
    RS#.ROOT$ = ROOT$
    RET& = GetVolumeInformation(RS#,VN#,260,Addr(Serialnumber&),Addr(MCL&),Addr(Flag&),FS#,260)
    Case RET& > 0 : ST$ = ST$ + [+String$(VN#,0)+],
    Case RET& > 0 : ST$ = ST$ + Seriennummer : + Left$(Hex$(Serialnumber&),4)+-+Right$(Hex$(Serialnumber&),4)
    Case RET& > 0 : ST$ = ST$ +   +String$(FS#,0)
    Case RET& = 0 : ST$ = ST$ +
    Dispose RS#
    Dispose VN#
    Dispose FS#

EndProc

Proc GetLogicalDrives

    Decimals 0
    Declare LWZeichen&,Laufwerke&,LZ&,LW$
    Dim LW#,LW
    LWZeichen& = 104
    Laufwerke& = GetLogicalDriveStrings(LWZeichen&,LW#)
    Addstring(Liste&,Installierte Laufwerke : ,+ Laufwerke& / 4)

    Whilenot LZ& = Laufwerke&

        ST$ = Upper$(String$(LW#,LZ&));
        LW$ = String$(LW#,LZ&)
        Case GetDriveType(Addr(LW$)) = 2 : ST$ = ST$ +  Wechselmedium
        Case GetDriveType(Addr(LW$)) = 3 : ST$ = ST$ +  Festplatte
        Case GetDriveType(Addr(LW$)) = 4 : ST$ = ST$ +  Netzlaufwerk
        Case GetDriveType(Addr(LW$)) = 5 : ST$ = ST$ +  CD-ROM
        Case GetDriveType(Addr(LW$)) = 6 : ST$ = ST$ +  RAM-Disk
        Case GetDriveType(Addr(LW$)) = 0 : ST$ = ST$ +  unbekannt
        GetVolumeInfos lw$
        AddString(Liste&,ST$)
        LZ& = LZ& + 4

    EndWhile

    Dispose LW#

Endproc

Proc Pfade

    Declare x%
    Dim pfad#,PfadInfo

    Whilenot gt(x%,80) Wurde von mir umgeändert

        WHILENOT X% > 80

            @GSFP(%hwnd,pfad#,x%,0)
            Case gt$(pfad#.PfadInf$,):addstring(Liste&,CSIDL + format$(0000,str$(x%))+ = +String$(Pfad#,0)) Wurde von mir umgeändert
            Case (pfad#.PfadInf$ > ):addstring(Liste&,CSIDL + format$(0000,str$(x%))+ = +String$(Pfad#,0))
            inc x%

        Endwhile

        @GTP(260,Pfad#)
        AddString(Liste&,)
        AddString(Liste&,Windows-Ordner : +$WinPath)
        AddString(Liste&,System-Ordner : +$SysPath)
        AddString(Liste&,Temp-Ordner : + pfad#.PfadInf$)
        Dispose Pfad#

    Endproc

    Proc Aufbau

        Liste& = @Create(ListBox,%HWND,,0,0,0,0)
        SetWindowLong(Liste&,-20,$200)
        SetDefaultGUIFont(Liste&)
        SetWindowpos Liste& = 200,20-420,400
        SystemInfo& = @Create(Button,%HWND,SystemInfos,10,20,170,48)
        LaufwerksInfo& = @Create(Button,%HWND,LaufwerksInfos,10,70,170,48)
        PfadInfo& = @Create(Button,%HWND,PfadInfos,10,120,170,48)
        Ende& = @Create(Button,%HWND,Ende,10,170,170,48)
        SetDefaultGUIFont(SystemInfo&)
        SetDefaultGUIFont(LaufwerksInfo&)
        SetDefaultGUIFont(PfadInfo&)
        SetDefaultGUIFont(Ende&)

    EndProc

    --------------------------------------
    --------------------------------------
    Hauptprogramm
    --------------------------------------
    SetTrueColor 1
    WindowTitle System-Infos...
    WindowStyle 27
    Window %maxx+1,0-640,480
    Cls GetColor(15)
    UseIcon A
    Aufbau
    SetWindowPos %HWND = 10,10-640,480

    Whilenot Ende%

        Waitinput

        If AND(@GetFocus(SystemInfo&),neq(LoWord(&UWparam),513))

            If CLICKED(SystemInfo&) Wurde von mir umgeändert

                LockWindowUpdate(%hwnd)
                SendMessage(Liste&,$0184,0,0)
                GetOSInfo
                AddString(Liste&,Betriebssystem = + Winver$)
                AddString(Liste&,)
                AddString(Liste&,Speicherauslastung :)
                GetMemoryStatus
                LockWindowUpdate(0)

            ElseIf AND(@GetFocus(LaufwerksInfo&),neq(LoWord(&UWparam),513))

            ELSEIF CLICKED(LaufwerksInfo&) Wurde von mir umgeändert

                LockWindowUpdate(%hwnd)
                SendMessage(Liste&,$0184,0,0)
                GetLogicalDrives
                GetDiskSpace
                LockWindowUpdate(0)

            ElseIf AND(@GetFocus(PfadInfo&),neq(LoWord(&UWparam),513))

            ElseIf CLICKED(PfadInfo&) Wurde von mir umgeändert

                LockWindowUpdate(%hwnd)
                SendMessage(Liste&,$0184,0,0)
                AddString(Liste&,Pfadinfos :)
                AddString(Liste&,)
                Pfade
                LockWindowUpdate(0)

            ElseIf AND(@GetFocus(Ende&),neq(LoWord(&UWparam),513))

            ElseIf CLICKED(Ende&) Wurde von mir umgeändert

                Let Ende% = 1

            Endif

        EndWhile

        End
        --------------------------------------
 
03.01.2009  ▲
 




Jac
de
Lad
Zuerst ein Fenster mit MajorVersion 6 und MinorVersion 0 also Windows Vista.

SystemInfos -> beim RAM steht vor MB nichs (Screenshot).

31 kB
Hochgeladen:03.01.2009
Ladeanzahl: 165
Herunterladen
 
Profan² 2.6 bis XProfan 11.1+XPSE+XPIA+XPRR (und irgendwann XIDE)
Core2Duo E8500/T2250, 8192/1024 MB, Radeon HD4850/Radeon XPress 1250, Vista64/XP
03.01.2009  ▲
 




RGH
Andreas Programm nutzt API-Funktionen, die Speichergrößen und Festplattenplatz als Long zurückgeben. Und da das heutzutage nun nicht mehr ausreicht, liefert es natürlich bei Rechnern mit mehr als 2 GB RAM und Festplatten mit mehr als 2 GB freiem Speicherplatz falsche oder keine Werte. Außerdem nutzt es Operator-Ersatzfunktionen, so dass die PROFALT.INC includiert werden muss.

Gruß
Roland
 
Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4
03.01.2009  ▲
 



Schade, aber wie zeige ich denn Größen > 2 GB an ???
Bis zu 2 GB wird sauber gewertet
Siehe Anhang

62 kB
Hochgeladen:03.01.2009
Ladeanzahl: 146
Herunterladen
 
03.01.2009  ▲
 




RGH
Ohne PROFALT.INC würde es auch bei Dir spätestens bei den Laufwerksinfos haken, da der Interpreter/die Runtime dann auf die nicht vorhandenen Funktionen, wie z.B. @Lt() oder @Add() stoßen würde ... zumindest wenn Du ein Laufwerk mit weniger als 2 GB freien Speicher hast.
Für Werte > 2 GB sollte es in neueren Windowsversionen entsprechende erweiterte APIs geben. Auswendig weiß ich das jetzt nicht. Sorry.

Gruß
Roland
 
Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4
03.01.2009  ▲
 




Andreas
Miethe

Per WMI-Abfrage sollte es gehen.

4 kB
Hochgeladen:03.01.2009
Ladeanzahl: 114
Herunterladen
4 kB
Hochgeladen:03.01.2009
Ladeanzahl: 123
Herunterladen
 
Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage :  [...] 
03.01.2009  ▲
 




Jac
de
Lad
Ich krieg das Ding nicht zum Laufen.

Und eigentlich sollte ja auch GlobalMemoryStatusEx funktionieren.
 
Profan² 2.6 bis XProfan 11.1+XPSE+XPIA+XPRR (und irgendwann XIDE)
Core2Duo E8500/T2250, 8192/1024 MB, Radeon HD4850/Radeon XPress 1250, Vista64/XP
03.01.2009  ▲
 



Also bei mir zeigt die neue Version einwandfrei an.
Interessant wäre aber, dass bei Jac mit seinen 8GB Speicher angezeigt wird.

@Roland
Habe die notwendige INC-Datei eingeladen

64 kB
Hochgeladen:03.01.2009
Ladeanzahl: 190
Herunterladen
 
03.01.2009  ▲
 




Andreas
Miethe

Bei meinen 4GB geht es jedenfalls.

6 kB
Hochgeladen:03.01.2009
Ladeanzahl: 179
Herunterladen
 
Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage :  [...] 
03.01.2009  ▲
 




Jac
de
Lad
Könntet ihr bitte auf 8GB aufrüsten, damit ich das Problem nicht allein habe. Ich hab langsam das Gefühl, dass es nicht mit mehr als 4GB klarkommt, obwohl andere Programme das korrekt anzeigen.

Jac
 
Profan² 2.6 bis XProfan 11.1+XPSE+XPIA+XPRR (und irgendwann XIDE)
Core2Duo E8500/T2250, 8192/1024 MB, Radeon HD4850/Radeon XPress 1250, Vista64/XP
03.01.2009  ▲
 



►

Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

40.466 Betrachtungen

Unbenanntvor 0 min.
RudiB.17.08.2022
Jochen Roxlau28.07.2015
Paul Glatz08.04.2014
Michael Wodrich21.02.2014
Mehr...

Themeninformationen

Dieses Thema hat 9 Teilnehmer:

Jac de Lad (15x)
unbekannt (8x)
Andreas Miethe (5x)
E.T. (2x)
RGH (2x)
iF (1x)
KHR (1x)
Dieter Zornow (1x)
Michael Wodrich (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie