XProfan

Keywords: Speicher, Memory, 64-Bit-Largo
Systemspeicher durchleuchten
(debería eigentlich auch con 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

    Parámetros anzeigetext$, groesse!
    Declarar 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

    Imprimir    ;anzeigetext$; :, Formato$(#0,groesse!), Typ$

ENDPROC

cls
declarar b#, f!
Dim b#, MemEx
b#.dwLength& = SizeOf(b#)
Externo(~kernel32,GlobalMemoryStatusEx,b#)
Imprimir
Imprimir    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!)
Imprimir
Imprimir -Ende después de Tastendruck-
Disponer b#
waitkey
end

 $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
        -------------------------<