XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
System: Laufwerks- und Datenträger-Informationen
===================================================================
Alle Laufwerks-, und Datenträgerinformationen
mit Profan 32 Bit u. Win 95 Abfragen
1998 Richard Maurukas
===================================================================
1. Anzahl der installierten Laufwerke ermitteln
2. Kennbuchstaben der Installierten Laufwerke ermitteln
3. Laufwerkseigenschaften abfragen.(Festplatte, CD-ROM usw.)
4. Datenträger Speicherinformationen ermitteln(Cluster, Sektoren...)
5. Datenträger-Informationen ermitteln(Laufwerksname, SerienNr....)
----------------------------------------------------------------------
### Definition für 1. und 2.
Def HoleLWKennung(2) ! KERNEL32.DLL,GetLogicalDriveStringsA
### Definition für 3.
Def GetDriveType(1) ! KERNEL32.DLL,GetDriveTypeA
### Definition für 4.
Def HoleLaufwerkskapazität(5) ! KERNEL32.DLL,GetDiskFreeSpaceA
### Defintion für 5.
Def GetVolumeInfo(8) ! Kernel32.dll,GetVolumeInformationA
declare MaxZeichen%         Max. Anzahl der Zeichen der Bereichsvariablen
declare LWKennung#          Nimmt die Laufwerksbuchstaben auf
declare LWInstall&          Anzahl der ermittelten Zeichen einschl. Null Byte
Declare i%
declare Laufwerk$
declare LWTyp&
declare Laufwerk#
declare SectperCluster#
declare BytesperSector#
declare Freeclusters#
declare Clusters#
declare LWName#
declare LWNameLänge#
Declare LWSerNr#
declare MaxDatNamlänge#
declare DateiSystemFlag#
declare DateiSystemName#
declare DatSystemNamLänge#
declare test&
declare LWNamelänge&,DatsystemNamLänge&
Let MaxZeichen%=104                26*4 Zeichen für LWKennung
Dim LWkennung#,MaxZeichen%         Bereichsvariable dimensionieren
Dim Laufwerk#,4                    Drei Zeichen für die Laufwerksangabe
Dim SectperCluster#,1              Zeichen für die Anzahl die Cluster
Dim BytesperSector#,1              Bytes und Sektoren sollten  ausreichen.
Dim Freeclusters#,1
Dim Clusters#,1
dim LWName#,16
dim LwNameLänge#,4
dim LWSerNr#,16
dim DateisystemName#,255
dim DatsystemNamLänge#,1
dim MaxDatNamLänge#,1
dim Dateisystemflag#,1
declare LwAuswahl%,Ende%
----------------------------------------------------------------------

Proc  Laufwerkskennung

    Let LWInstall&=HoleLWKennung(MaxZeichen%,LWKennung#)
    print
    Print Installierte Laufwerke   :;div&(LWInstall&,4)
    print ================================================
    Let I%=0

    whileNot equ(i%,LWInstall&)

        Print Installiertes Laufwerk   :;string$(LWKennung#,I%)
        Hier kann noch in Großbuchstaben umgewandelt werden.
        addstring(LWAuswahl%,String$(Lwkennung#,i%))
        let I%=add(i%,4)  die nächste Adresse setzen

    wend

    Print ---------------------------------------------

endproc

--------------------------------------------------------------------------

Proc LaufwerksType

    decimals 0                       Für die Anzeige keine Nachkommastellen
    String Laufwerk#,0=Laufwerk$
    Let LWTyp&=GetDriveType(Laufwerk#)
    Print LaufwerksType : ;LWTYp&
    Print ---------------------------------------------
    case equ(LWTyp&,0) :Print Laufwerk : ;Laufwerk$; Ist nicht ermittelbar.
    case equ(LWTyp&,1) :Print Laufwerk : ;Laufwerk$; ist im System nicht vorhanden.
    Case equ(LWTyp&,2) :Print Laufwerk : ;Laufwerk$; ist Laufwerk mit wechselbaren Datenträger.
    case equ(LWTyp&,3) :Print Laufwerk : ;Laufwerk$; ist ein Festplattenlaufwerk.
    case equ(LWTyp&,4) :Print Laufwerk : ;Laufwerk$; ist ein Netzwerklaufwerk.
    case equ(LwTyp&,5) :Print Laufwerk : ;Laufwerk$; ist ein CD-ROM Laufwerk.
    case equ(lwTyp&,6) :Print Laufwerk : ;Laufwerk$; ist eine RAM-Disk.
    Print =============================================
    -----------------------------------------------------------------------------
    Laufwerkskapazität ermitteln--------------------------------------------------
    HoleLaufwerksKapazität(Laufwerk#,SectperCluster#,BytesperSector#,Freeclusters#,Clusters#)
    Print Speicherinformationen von Laufwerk : ;Laufwerk$
    Print ---------------------------------------------
    print Cluster                :;long(Clusters#,0)
    print Sektoren pro Cluster   :;long(SectperCluster#,0)
    print Bytes pro Sektor       :;long(BytesperSector#,0)
    Print Bytes Pro Cluster      :;mul(long(SectperCluster#,0),long(BytesperSector#,0))
    print Freie Cluster          :;long(Freeclusters#,0)
    Print ---------------------------------------------
    Print Bytes Gesamt           :;mul(Mul(long(Clusters#,0),long(SectperCluster#,0)),long(BytesperSector#,0))
    Print Bytes Frei             :;mul(Mul(long(FreeClusters#,0),long(SectperCluster#,0)),long(BytesperSector#,0))
    Print =============================================
    Laufwerkseigenschaft ermitteln------------------------------------------------------
    let LWNamelänge&=16
    Let DatsystemNamLänge&=255
    Let test&=GetvolumeInfo(Laufwerk#,LWName#,LWNameLänge&,
    LWSerNr#,MaxDatNamLänge#,DateiSystemFlag#,
    DateiSystemName#,DatSystemNamLänge&)

    If test&

        Print Datenträger-Informationen
        Print ---------------------------------------------
        Print Laufwerk               :;String$(Laufwerk#,0)
        Print Laufwerksname          :;String$(LWName#,0)
        Print LW-Serien Nummer DEZ   :;long(LWSernr#,0)
        Print LW-Serien Nummer HEX   :;add$(add$(left$(Hex$(long(LWSernr#,0)),4),-),right$(Hex$(long(LWSernr#,0)),4))
        Print Max. Dateinamenlänge   :;Long(MaxDatNamLänge#,0)
        Print DateisystemName        :;String$(DateiSystemName#,0)
        Print DateisystemFlag   DEZ  :;byte(DateiSystemflag#,0)
        Print Dateisystemflag   BIN  :;BIN$(Long(Dateisystemflag#,0))
        ----------------------------------------------------------------------------------
        Dateisystemflags können noch als Text angezeigt werden.
        Die Flags werden von rechts nach links aus Bin$(Long(Dateisystemflag#,0))
        ausgelesen.
        Gibt die Flags des Laufwerks zurück. (Bezogen auf das verwendete Dateisystem)
        Die Flages FS_FILE_COMPRESSION und FS_VOL_IS_COMPRESSED sind nur entweder oder
        vorhanden.
        Dieser Parameter kann eine Kombination von den folgenden Werten sein:
        Wert	Bedeutung
        FS_CASE_IS_PRESERVED	Wenn dieses Flag gesetzt ist, wird ein Dateiname
        benötigt um Daten in das Dateisystem zu schreiben.
        FS_CASE_SENSITIVE	Wenn dieses Flag gesetzt ist, werden bei Dateinamen
        zwischen Groß- und Kleinbuchstaben unterschieden.
        FS_UNICODE_STORED_ON_DISK	Wenn dieses Flag gesetzt ist, wird UNICODE bei
        den Dateinnamen unterstützt.
        FS_PERSISTENT_ACLS	Wenn dieses Flag gesetzt ist, benötigt das Dateisystem
        ACLs. NTFS benötigt ACLs, HPFS und FAT nicht.
        FS_FILE_COMPRESSION	Wenn dieses Flag gesetzt ist, unterstützt das
        Dateisystem Dateikomprimierung.
        FS_VOL_IS_COMPRESSED	Das angegebene Laufwerk ist komprimiert.
        Werte
        FS_CASE_SENSITIVE               $00000001
        FS_CASE_IS_PRESERVED            $00000002
        FS_UNICODE_STORED_ON_DISK       $00000004
        FS_PERSISTENT_ACLS              $00000008
        FS_VOL_IS_COMPRESSED            $00008000
        FS_FILE_COMPRESSION             $00000010
        --------------------------------------------------------------------------------------

    else

        print Fehler beim Lesen. Die angezeigten Werte stimmen nicht.

    endif

Endproc

--------------------------------------------------------------------------------------
Window 0,0-600,400
Windowtitle Laufwerks Informationen abfragen. 1998 Richard Maurukas
Let LWAuswahl%=Createlistbox(%Hwnd,,500,20,80,100)
Laufwerkskennung

whilenot Ende%

    waitinput
    cls
    let Laufwerk$=Trim$(Getstring$(LWauswahl%,Getcursel(LWauswahl%)))
    LaufwerksType
    String Laufwerk#,0=

wend

Bereichsvariablen Freigeben-----------nicht vergessen----------------
Dispose Laufwerk#
Dispose LWKennung#
Dispose SectperCluster#
Dispose BytesperSector#
Dispose Freeclusters#
Dispose Clusters#
Dispose LWName#
Dispose LWNameLänge#
Dispose LWSerNr#
Dispose MaxDatNamlänge#
Dispose DateiSystemFlag#
Dispose DateiSystemName#
Dispose DatSystemNamLänge#
------------------------------------------------------------------ass=s2>------
end