XProfan

Laufwerke und Speicher auslesen
(c) Frank Abbing
Declare x&,y&,bereich#,text$,t$,f!,bereich2#,bereich3#,bereich4#
Dim bereich#,1024
Dim bereich2#,256
Dim bereich3#,256
Dim bereich4#,256
Def GetVolumeInformation(8) !"KERNEL32","GetVolumeInformationA"
Def GetDriveType(1) !"KERNEL32","GetDriveTypeA"
Def GetDiskFreeSpaceEx(4) !"KERNEL32","GetDiskFreeSpaceExA"
Def GlobalMemoryStatus(1) !"KERNEL32","GlobalMemoryStatus"
Def @x!(8) (((((((@%(8)*256+@%(7))*256+@%(6))*256+@%(5))*256+@%(4))*256+@%(3))*256+@%(2))*256+@%(1))

Proc Get64

    Parameters cc&
    f!= @x!(@Byte(cc&,0),@Byte(cc&,1),@Byte(cc&,2),@Byte(cc&,3),@Byte(cc&,4),@Byte(cc&,5),@Byte(cc&,6),@Byte(cc&,7))

EndProc

Decimals 0
Window 0,0-%maxx,%maxy
String bereich2#,0="A:/"

Whileloop 16

    x&=GetVolumeInformation(bereich2#,bereich#,1024,0,0,0,bereich3#,256)

    If x&

        text$=String$(bereich2#,0)+Chr$(10)+"Name = "+String$(bereich#,0)+Chr$(10)+"Filesystem = "+String$(bereich3#,0)+Chr$(10)
        x&=GetDriveType(bereich2#)
        t$="Unbekannt"
        Case x&=5:t$="CDROM"
        Case x&=3:t$="FIXED (z.B. Festplatte)"
        Case x&=1:t$="NO ROOT DIR"
        Case x&=6:t$="RAMDISK"
        Case x&=4:t$="REMOTE"
        Case x&=2:t$="REMOVEABLE (z.B. Diskette)"
        text$=text$+"Laufwerkstyp = "+t$+Chr$(10)
        GetDiskFreeSpaceEx(bereich2#,bereich#,bereich3#,bereich4#)
        Get64 bereich3#
        text$=text$+"Kapatität = "+Str$(f!)+" (belegt) / "
        Get64 bereich4#
        text$=text$+Str$(f!)+" (frei) Bytes"
        Print text$
        Print

    EndIf

    Byte bereich2#,0=Byte(bereich2#,0)+1

EndWhile

Clear bereich#
Long bereich#,0=32
GlobalMemoryStatus(bereich#)
Print "Ram-Speicher = "+Str$(Long(bereich#,8))+" (total) / "+Str$(Long(bereich#,12))+" (frei) Bytes"
WaitInput
Dispose bereich#
Dispose bereich2#
Dispose bereich3#
Dispose bereich4#
End