'***************************************************************************
'
'   erweiterte Windows95 DIR$-Routine fr PowerBASIC 3.2
'
'   entwickelt von / developed by   :  Thomas Gohel
'                           Fido    :  Thomas Gohel@2:2410/330.1
'                           InterNet:  author@pbsound.snafu.de
'                           Homepage:  http://www.snafu.de/~pbsound/
'
'***************************************************************************

$COMPILE EXE

TYPE DTA_Struktur
        Reserviert     AS STRING * 21
        Attribut       AS BYTE
        Uhrzeit        AS WORD
        Datum          AS WORD
        FileLaenge     AS DWORD
        FileName       AS STRING * 13
END TYPE

TYPE LDTA_Struktur
        FileAttribut   AS LONG
        FileCreation   AS QUAD
        FileLastAccess AS QUAD
        FileLastMod    AS QUAD
        FileSizeHigh   AS DWORD
        FileSize       AS DWORD
        Reserve        AS QUAD
        LongName       AS STRING * 260
        FileName       AS STRING  * 14
END TYPE

DIM DTA AS SHARED DTA_Struktur PTR
DIM LDTA AS SHARED LDTA_Struktur
DIM FindNotNext AS SHARED INTEGER

SHARED DTAMode%, LDTASeg%, LDTAOff%
SHARED FindNotNext%, FindHandle%
SHARED DirPfad$, DirMaske$

LDTASeg% = VARSEG(LDTA.FileAttribut)
LDTAOff% = VARPTR(LDTA.FileAttribut)

Maske$ = "*.*"

CLS
DirFirst(Maske$)
DirNext
END

SUB DirFirst(Maske$) public
        FOR i% = LEN(Maske$) TO 1 STEP -1
            IF RIGHT$(MID$(Maske$, 1, i%), 1) = "\" THEN EXIT FOR
        NEXT i%
        DirPfad$ = MID$(Maske$, 1, i%)
        DirMaske$ = MID$(Maske$,i% + 1)
        ! mov ax, &h1600
        ! int &h2F
        ! mov DTAMode%, al
        IF DTAMode% < 4 THEN
            FindFirst(DirPfad$ + DirMaske$)
        ELSE
            LFindFirst(DirPfad$ + DirMaske$)
        END IF
END SUB

SUB DirNext public
        DO WHILE FindNotNext% = 0
            IF DTAMode% < 4 THEN
                FindNext
            ELSE
                LFindNext
            END IF
        LOOP
END SUB

SUB FindFirst(DirTemp$)
        ! mov ax, &h2f00             ; DTA-Adresse holen
        ! int &h21
        ! mov DTA[02], es            ; DTA_Struktur zur MS-DOS Struktur
        ! mov DTA[00], bx            ; verschieben

        Attribut? = &b00000000       ' Attribut definieren
        '               |||||| - Schreibschutz
        '               |||||  - Versteckt
        '               ||||   - Systemdatei
        '               |||    - Label
        '               ||     - Verzeichnis
        '               |      - Archiv

        DirTemp$ = DirTemp$ + CHR$(0)          ' Filenamen vorbereiten
        Dir_Pointer& = STRPTR32(DirTemp$)      ' 32bit-Adresse holen

        ! push ds
        ! mov ah, &h4e               ; ersten Directory-Eintrag holen
        ! mov cx, Attribut?
        ! mov dx, Dir_Pointer&[00]
        ! mov ds, Dir_Pointer&[02]
        ! int &h21
        ! pop ds
        ! jnc DTA_First_Lesen
        ! mov Fehler%, ax
        PRINT "Datei not found: ";Fehler%
        EXIT SUB

        DTA_First_Lesen:
        FindNotNext% = 0
        GetDTA
END SUB

SUB LFindFirst(DirTemp$) public
        DirTemp$  = DirTemp$ + CHR$(0)
        DirTempSeg% = STRSEG(DirTemp$)
        DirTempOff% = STRPTR(DirTemp$)
        Attribut? = &b00000000
        '               |||||| - Schreibschutz
        '               |||||  - Versteckt
        '               ||||   - Systemdatei
        '               |||    - Label
        '               ||     - Verzeichnis
        '               |      - Archiv

        ! push ds
        ! mov ax, &h714E
        ! mov si, 0
        ! mov cx, Attribut?
        ! mov es, LDTASeg%
        ! mov di, LDTAOff%
        ! mov dx, DirTempOff%
        ! mov ds, DirTempSeg%
        ! int &h21
        ! pop ds
        ! mov FindHandle%, ax
        ! jnc LDTA_First_Lesen
        PRINT "Datei not found: "; FindHandle%

        LDTA_First_Lesen:
        GetLDTA
END SUB

SUB FindNext public
        ! mov ah, &h4f               ; naechsten Directory-Eintrag holen
        ! int &h21
        ! jnc DTA_Next_Lesen
        ! mov FindNotNext%, ax
        PRINT "keine Datei(en) mehr gefunden!"
        EXIT SUB

        DTA_Next_Lesen:
        FindNotNext% = 0
        GetDTA
END SUB

SUB LFindNext public
        LDTA.LongName = STRING$(260, 0)
        LDTA.FileName = STRING$(14, 0)
        ! push ds
        ! mov ax, &h714F
        ! mov si, 0
        ! mov bx, FindHandle%
        ! mov es, LDTASeg%
        ! mov di, LDTAOff%
        ! int &h21
        ! pop ds
        ! jnc LDTA_Next_Lesen
        FindNotNext% = 1
        PRINT "keine Datei(en) mehr gefunden!"
        EXIT SUB

        LDTA_Next_Lesen:
        GetLDTA
END SUB

SUB GetDTA public
        Filename$ = @DTA.FileName
        @DTA.FileName = "             "    ' l”schen fr die n„chste Routine

        ' Laenge des File eintragen
        FileGross$   = USING$("###,###,###", @DTA.FileLaenge)

        ' Uhrzeit der letzten Modifikation
        FileStunde?? = INT(@DTA.Uhrzeit / 2048)
        FileMinute?? = INT(@DTA.Uhrzeit / 32) AND 63
        FileZeit$    = "00:00:1980"
        FileZeit$ = RIGHT$((STR$(FileStunde??)), 2) + ":" + RIGHT$((STR$(FileMinute??)), 2)

        ' Datum der letzten Modifikation
        FileDatum$   = USING$("##",@DTA.Datum AND 31) + "."
        FileDatum$   = FileDatum$ + USING$("##" , INT(@DTA.Datum/32) AND 15) + "."
        FileDatum$   = FileDatum$ + USING$("####",INT(@DTA.Datum/512) + 1980)
        REPLACE " " WITH "0" IN FileZeit$
        REPLACE " " WITH "0" IN FileDatum$

        ' Attribute holen
        FileAttribut? = @DTA.Attribut
        FileAttribut$ = "......"
        IF BIT(FileAttribut?,0) = 1 THEN MID$(FileAttribut$,1,1) = "r"
        IF BIT(FileAttribut?,1) = 1 THEN MID$(FileAttribut$,2,1) = "h"
        IF BIT(FileAttribut?,2) = 1 THEN MID$(FileAttribut$,3,1) = "s"
        IF BIT(FileAttribut?,3) = 1 THEN MID$(FileAttribut$,4,1) = "v"
        IF BIT(FileAttribut?,4) = 1 THEN MID$(FileAttribut$,5,1) = "d"
        IF BIT(FileAttribut?,5) = 1 THEN MID$(FileAttribut$,6,1) = "a"
        PRINT USING$("\            \",Filename$);" ";
        PRINT FileGross$ ;" ";FileDatum$;" "; FileZeit$;" "; FileAttribut$;"  ";
        PRINT LEFT$(LDTA.LongName,27)
END SUB

SUB GetLDTA public
        IF LDTA.FileName = STRING$(14, 0) THEN
            LDTA.FileName = LEFT$(LDTA.LongName, 14)
        END IF
        FindFirst(DirPfad$ + LDTA.Filename)
END SUB