XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Laufwerkserkennung und Verzeichniswechsel
selbstgebauter Verzeichnis-, Laufwerkswechsel
© Hans-Jürgen Trog, Berlin Mai 1998 (e-mail: sumatra@berlin.snafu.de)
Dieser Quelltext darf beliebig verwendet werden.
manche Routinen stammen auch von Tips aus dem Internet!
Ich bitte, weitere Verbesserungen an mich zu schicken
DANKE
lw$  =  Angabe des gewählten Laufwerks, z.B. c:
wahl$ = das ausgewählte Verzeichnis, z.B.   Kopie

PROC LW_INFO

    allgemeine Deklarationen
    declare _ende%
    declare _dlg%
    declare verz%,jetzt%
    declare ende%,wahl$
    declare l%,a%,zeile$, c%,pfad$,bild$
    declare edit%,endung$,endung%
    let bild$=
    zentrieren des Dialogfensters
    DEF @PosX(1) @Int(@Div(@Sub(%MaxX,@%(1)),2))
    DEF @PosY(1) @Int(@Div(@Sub(%MaxY,@%(1)),2))
    Laufwerke ermitteln
    def HoleLWKennung(2) ! KERNEL32.DLL,GetLogicalDriveStringsA
    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%
    Let MaxZeichen%=104                26*4 Zeichen für LWKennung
    Dim LWkennung#,MaxZeichen%         Bereichsvariable dimensionieren
    declare LwAuswahl%
    declare lw$
    declare zahl%				zum Vergleich für Markierung Listeneintrag

    Proc  Laufwerkskennung

        Let LWInstall&=HoleLWKennung(MaxZeichen%,LWKennung#)
        Let I%=0
        let zahl%=-1

        whileNot equ(i%,LWInstall&)

            @AddChoice(LWAuswahl%,String$(Lwkennung#,i%))
            let pfad$=@Lower$(pfad$)			weil Pfad in Großbuchstaben ist
            inc zahl%

            if @equ$(String$(Lwkennung#,i%),pfad$)

                @SendMessage(LWAuswahl%,$014E,zahl%,0)		auf akt. Laufwerk setzen

            endif

            let I%=add(i%,4)  die nächste Adresse setzen

        wend

    endproc

    Proc Einlesen

        clearlist

        if @neq$(endung$,*.*)

            Addfiles *.*
            MoveListToList(verz%)

        endif

        let c%=5
        let a%=@GetCount(verz%)

        WHILE @GT(c%,0)

            let zeile$=@GetString$(verz%,a%)

            if @neq$(@left$(zeile$,1),[)

                @DeleteString(verz%,a%)

            endif

            if @equ$(@left$(zeile$,3),[.])

                @DeleteString(verz%,a%)

            endif

            dec a%

            if @lt(a%,0)

                let c%=0
                clearlist
                ab hier können beliebige Zusammenstellungen gebaut werden,
                die aber in DATEIENDUNGEN eingetragen werden müssen

                if @equ$(endung$, Bilder)

                    Addfiles *.BMP
                    Addfiles *.JPG
                    Addfiles *.GIF
                    Addfiles *.TGA
                    Addfiles *.PCX

                elseif @equ$(endung$, Profandateien)

                    Addfiles *.PRF
                    Addfiles *.PRC
                    Addfiles *.INC
                    Addfiles *.PRV

                elseif @equ$(endung$, Ausführbare)

                    Addfiles *.EXE
                    Addfiles *.COM
                    Addfiles *.BAT

                elseif @equ$(endung$, Texte)

                    Addfiles *.DOC
                    Addfiles *.DOK
                    Addfiles *.TXT
                    Addfiles *.BAK
                    Addfiles *.ASC

                else

                    Addfiles endung$

                endif

                MoveListToList(verz%)

            endif

        WEND

        Let Pfad$=@GetDir$(@)
        let pfad$=@upper$(pfad$)
        SetText jetzt%,pfad$

    endproc

    PROC DATEIENDUNGEN

        einlesen der verschiedenen Dateiendungen in die Auswahl
        Um die Textformen am Anfang zu haben, muß ein Leerzeichen
        vor den Text gesetzt werden
        in EINLESEN dann die Endungsformen einbauen
        @AddChoice(edit%, - ohne Dateien)   Schreibweise nicht ändern = 1. Eintrag
        @AddChoice(edit%,*.*)
        @AddChoice(edit%, Bilder)
        @AddChoice(edit%, Ausführbare)
        @AddChoice(edit%, Texte)
        @AddChoice(edit%, Profandateien)
        @AddChoice(edit%,*.EXE)
        @AddChoice(edit%,*.COM)
        @AddChoice(edit%,*.BAT)
        @AddChoice(edit%,*.SYS)
        @AddChoice(edit%,*.INI)
        @AddChoice(edit%,*.TXT)
        @AddChoice(edit%,*.DOC)
        @AddChoice(edit%,*.XLS)
        @AddChoice(edit%,*.MDB)
        @AddChoice(edit%,*.BAK)
        @AddChoice(edit%,*.PRF)
        @AddChoice(edit%,*.PRC)
        @AddChoice(edit%,*.INC)

    ENDPROC

    proc dialog

        SetDialogFont 1
        UseFont ARIAL,14,0,1,0,0
        let _dlg%=@createdialog(%Hwnd,Auswahl,@PosX(195),@PosY(370),230,370)
        let verz%=@createsortedlistbox(_dlg%,,15,30,193,155)
        let ende%=@createbutton(_dlg%,Ende,56,310,120,24)
        let jetzt%= @createtext(_dlg%,,15,10,400,16)
        Let edit%=@CreateChoiceBox(_dlg%,,100,210,110,100)
        Let LWAuswahl%=@CreateChoiceBox(_dlg%,,15,210,75,100)
        @CreateText(_dlg%, Laufwerk,15,190,80,20)
        @CreateText(_dlg%, Dateiendung,100,190,80,20)
        Let Pfad$=@GetDir$(@)
        Let Pfad$=@left$(pfad$,3)
        chdir pfad$
        LAUFWERKSKENNUNG
        EINLESEN
        DATEIENDUNGEN
        @SendMessage(edit%,$014E,0,0)		auf 1. Dateiendung setzen
        let _ende% = 0

        whilenot _ende%

            let wahl$=@GetString$(verz%,@GetCursel(verz%))
            let l%=@len(wahl$)
            let l%=@sub(l%,2)
            let wahl$=@mid$(wahl$,2,l%)
            chdir wahl$

            WHILE @GT(@GetCount(verz%),0)

                @DeleteString(verz%,0)

            WEND

            EINLESEN
            waitinput

            if @equ(%key,2)

                let _ende% = 1

            elseif @getfocus(LWAuswahl%)

                let lw$=@GetText$(LWAuswahl%)
                chdir lw$
                let endung$=@GetText$(edit%)
                EINLESEN

            elseif @getfocus(edit%)

                let endung$=@GetText$(edit%)
                EINLESEN

            elseif @getfocus(ende%)

                let _ende% = 1

            endif

        wend

        @destroywindow(_dlg%)

    endproc

    DIALOG
    die folgenden Zeilen bis ENDIF können entfallen.
    sie dienen nur der Anzeige für die Abfragemöglichkeiten

    if @equ$(lw$,)

        let lw$=pfad$
        @messagebox (lw$,gewähltes Verzeichnis,64)

    else

        @messagebox (@add$(lw$,wahl$),gewähltes Verzeichnis,64)

    endif

ENDPROC

Aufruf der Prozedur
WindowStyle $F0
w 0,0-0,0
LW_INFO
end