XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
System: Laufwerksdaten anzeigen
Testprogramm für die Prozedur InfoLaufwerk.
Die Prozedur InfoLaufwerk holt Informationen zu einem Laufwerk (Diskette, Platte, CD ...)
Das Testprogramm liest in eine Bereichsvariable für alle im PC vorhandenen Laufwerke
die Laufwerksbuchstaben ein.
Mit Hilfe der gefundenen Laufwerke werden die Informationen mit der Prozedur gelesen
und pro Laufwerk als Zeile in die Listboxliste übertragen.
Die Anzeige erfolgt in einer Listbox.
Entwickelt unter Profan 7.5 und Windows 2000
----------------------------------------------------------------------------------
Version 1.0  6.06.2005.      Das Programmbeispiel kann frei benutzt werden, für
Schäden kann keine Haftung übernommen werden.
Autor: Gerhard Putschalka
email: g.putschalka@web.de
homepage: http://members.telering.at/g.putschalka/index.html
----------------------------------------------------------------------------------
Declare LaufwerkType$,Laufwerknummer$,Volum-Id$,Dateisystem$,Dateisystem-Flags$
Declare Buf#,Drv$,X%,Y&
Def GetDriveString(2) ! KERNEL32,GetLogicalDriveStringsA
Def GetDriveType(1)   ! KERNEL32,GetDriveTypeA
 $I InfoLaufwerk.inc
die Daten der Laufwerke befinden sich in der Listboxliste. Um die Daten formatiert
anzeigen zu können wird eine Listbox verwendet der Tabulatorstopps zugeordnet werden.

Proc Zeige_die_Daten_an

    Declare Dlg%,LiBox%,EndBut%
    Dlg% = @CreateDialog(%Hwnd,Laufwerksdaten anzeigen,10,10,530,460)
    @CreateText(Dlg%,LW,10,8,35,18)
    @CreateText(Dlg%,Typ,45,8,35,18)
    @CreateText(Dlg%,int. Nummer,80,8,80,18)
    @CreateText(Dlg%,Volume-Id,185,8,80,18)
    @CreateText(Dlg%,DateiSystem,330,8,85,18)
    @CreateText(Dlg%,Flags,440,8,40,18)
    @CreateText(Dlg%,Typ:,10,290,35,18)
    @CreateText(Dlg%,0 =  ???,60,290,150,18)
    @CreateText(Dlg%,1 = no Root directory,60,310,150,18)
    @CreateText(Dlg%,2 = Removable Disk,60,330,150,18)
    @CreateText(Dlg%,3 = Fixed Disk,60,350,150,18)
    @CreateText(Dlg%,4 = Remote drive,60,370,150,18)
    @CreateText(Dlg%,5 = CD-Rom,60,390,150,18)
    @CreateText(Dlg%,6 = RAM Disk,60,410,150,18)
    EndBut% = @CreateButton(Dlg%,Ende,440,290,65,30)
    LiBox% = @CreateListBox(Dlg%,,10,25,500,250)
    setze Tabulatoren in die Listbox
    Dim Buf#,20
    Long Buf#,0 = 20
    Long Buf#,4 = 35
    Long Buf#,8 = 86
    Long Buf#,12 = 170
    Long Buf#,16 = -235  Negativwert: rechtsbündig stellen
    @SendMessage(LiBox%,$0192,5,Buf#)  setze die Tabulatoren
    Dispose Buf#
    übertrage die Listboxliste in die Listbox (inklusive der Tab-Bytes)
    @MoveListToList(LiBox%)

    WhileNot @GetFocus(EndBut%)

        WaitInput

    EndWhile

EndProc

=============
Programmstart
=============
cls
-------------- entweder
ist nur ein bestimmtes Laufwerk auszuwerten so genügen folgende Anweisungen:
Drv$ = C:    wenn die Daten von C: erfaßt werden sollen
InfoLaufwerk Drv$   Aufruf der Prozedur
Die Returnvariable enthält die Daten, durch Tabulatoren getrennt.
holen der einzelnen Werte in Variablen
Drv$   ist unverändert
LaufwerkType$ = @Substring$(@$(0),2,@Chr$(9))
Laufwerknummer$ = @Substring$(@$(0),3,@Chr$(9))
Volum-Id$ = @Substring$(@$(0),4,@Chr$(9))
Dateisystem$ = @Substring$(@$(0),5,@Chr$(9))
Dateisystem-Flags$ = @Substring$(@$(0),6,@Chr$(9))
End
------------ oder
die Daten aller Laufwerke holen und in der Listboxliste sammeln (pro Laufwerk eine Zeile):
die 6 Daten jeder Zeile sind durch Tabulatorbytes getrennt.
Dim Buf#,150
Clear Buf#
Y& = GetDriveString(148,Buf#)  hole alle Laufwerksbuchstaben
ClearList
X% = 0

While (X% < Y&)

    Drv$ = @Left$(@String$(Buf#,X%),2)+
    InfoLaufwerk Drv$  Buchstabe+:   z.B.: C:
    in @$(0) ist der String mit den Daten des Laufwerks Drv$ (Aufbau siehe oben)
    AddString @$(0)  füge die Daten zur Listboxliste hinzu
    X% = (X% + 4)

EndWhile

Dispose Buf#
Zeige_die_Daten_an
End