Fonte/ Codesnippets | | | | Michael Wodrich |
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
-------------------------< -------------
|
| | | | |
| | Jac de Lad | Zuerst ein Fenster mit MajorVersion 6 und MinorVersion 0 also Windows Vista.
SystemInfos -> beim RAM steht vor MB nichs (Screenshot). |
| | | 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 naturalmente 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.
Saluto 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 |
| | | | |
| | 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.
Saluto 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. |
| | | 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-File eingeladen |
| | | | |
| | Andreas Miethe
| Bei meinen 4GB geht es jedenfalls. |
| | | 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 Mostra.
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 QuelltextTopic-Options | 40.877 Views |
ThemeninformationenDieses Thema hat 9 subscriber: |