POINT Software Programming/PPROG1.ISO/basic/bmag/fulldir.bas

BASIC Source File | 1994-04-26 | 5.6 KB | 170 lines

'─ Area: F-QUICKBASIC ─────────────────────────────────────────────────────────
'  Msg#: 417                                          Date: 23 Apr 94  12:44:00
'  From: Tom Cunha                                    Read: Yes    Replied: No
'    To: Chris Gauvin                                 Mark:
'  Subj: Reading files from DIR
'──────────────────────────────────────────────────────────────────────────────
' > I need some help to get this to work... I can't figure out what
' > the problem
' > is. My goal is to eventually read the files from a dir into an
' > array called
' > FILE$.

'FULLDIR.BAS by Gaylon Hill
'
'CALL FullDir(Dir$(), DirNum, FileDir, Path$, WildCard$)
'Dir$()     - is filled with the directory file names, size, date, & time.
'Dirnum     - returns the number of Dir$() (arrays).
'FileDir    - if FileDir = 1 then sub-directories names are returned, also.
'Path$      - if Path$= "" then the default path is used. Please note,
'             if the Path$ is given then the wildcard will have to be
'             given with the path name.
'             Ex: Path$ = "\MAIN\QB\*.BAS" or Path$ = "A:\*.*"
'WildCard$  - the WildCard$ selects the type of file needed. Use ? or *
'             to narrow the file selection. If WildCard$ = "" then the
'             default is "*.*". This entry has NO EFFECT when the Path$
'             is given.

TYPE FileFindBuf
    DOS            AS STRING * 19
    CreateTime     AS STRING * 1
    Attributes     AS INTEGER
    AccessTime     AS INTEGER
    AccessDate     AS INTEGER
    FileSize       AS LONG
    FileName       AS STRING * 13
END TYPE

TYPE Register
    ax    AS INTEGER
    bx    AS INTEGER
    cx    AS INTEGER
    dx    AS INTEGER
    bp    AS INTEGER
    si    AS INTEGER
    di    AS INTEGER
    flags AS INTEGER
    ds    AS INTEGER
    es    AS INTEGER
END TYPE

DEFINT A-Z
'
SUB FullDir (Dir$(), DirNum, FileDir, path$, WildCard$)

    DIM inreg AS Register, outreg AS Register
    DIM Buffer AS FileFindBuf

    DirNum = 0

    IF WildCard$ = "" THEN
        WildCard$ = "*.*"
    END IF

    IF path$ = "" THEN
    '========================================================================
    'Get Current Drive
    '========================================================================

        inreg.ax = &H1900
        CALL Interrupt(&H21, inreg, inreg)
        Drive$ = CHR$(65 + inreg.ax MOD 256)

    '========================================================================
    'Get Current Path
    '========================================================================
        DIM PathSize AS STRING * 64
        inreg.ax = &H4700
        inreg.dx = ASC(Drive$) - 64
        inreg.ds = VARSEG(PathSize)
        inreg.si = VARPTR(PathSize)
        CALL InterruptX(&H21, inreg, inreg)
        path$ = LEFT$(PathSize, INSTR(PathSize, CHR$(0)) - 1)
        path$ = Drive$ + ":\" + path$ + "\" + WildCard$
    END IF
    '========================================================================
    'Set the area where the file information will be stored
    '========================================================================
    inreg.ax = &H1A00
    inreg.ds = VARSEG(Buffer)
    inreg.dx = VARPTR(Buffer)
    CALL Interrupt(&H21, inreg, outreg)

    '========================================================================
    'Find the first file, if FirstFM=0 then continue.
    '========================================================================
    inreg.ax = &H4E00
    inreg.cx = 62
    NPath$ = path$ + CHR$(0)
    inreg.dx = SADD(NPath$)
    CALL Interrupt(&H21, inreg, outreg)
    FirstFM = (outreg.ax AND &HF)

    '========================================================================
    'Find the next file(s), if NextFM<>0 then exit.
    '========================================================================
    IF FirstFM = 0 THEN
        GOSUB MakeFile
        DO
            inreg.ax = &H4F00
            inreg.dx = SADD(NPath$)
            CALL Interrupt(&H21, inreg, outreg)
            NextFM = outreg.ax AND &HF
            IF NextFM = 0 THEN
                GOSUB MakeFile
            END IF
        LOOP WHILE NextFM = 0
    END IF
    EXIT SUB

MakeFile:
    IF LEFT$(Buffer.FileName, 1) = "." THEN
        RETURN
    END IF

    FSize$ = RIGHT$(SPACE$(8) + STR$(Buffer.FileSize), 8)

    BitT = Buffer.AccessTime
    ahr = 0
    IF BitT < 0 THEN BitT = 32767 + BitT: ahr = 16
    hr = (BitT \ 2048)
    mm = (BitT - (hr * 2048)) \ 32
    hr = ahr + hr
    FTime$ = RIGHT$("00" + LTRIM$(STR$(hr)), 2) + ":" + RIGHT$("00" +
LTRIM$(STR$(mm)), 2)

    BitD = Buffer.AccessDate
    yr = BitD \ 512
    mo = (BitD - (yr * 512)) \ 32
    da = BitD - (yr * 512) - (mo * 32)
    FDate$ = RIGHT$("0" + LTRIM$(STR$(mo)), 2) + "-" + RIGHT$("0" +
LTRIM$(STR$(da)), 2) + "-" + LTRIM$(STR$(80 + yr))

    x = INSTR(Buffer.FileName, ".")
    IF x = 0 THEN
        FileTemp$ = LEFT$(Buffer.FileName + STRING$(12, 32), 12)
    ELSE
        FileTemp$ = LEFT$(LEFT$(Buffer.FileName, x - 1) + SPACE$(12), 8) +
MID$(Buffer.FileName, x, 4)
    END IF

    IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
        FileTemp$ = MID$(Buffer.FileName, 1, 12)
    END IF

    DirNum = DirNum + 1
    Dir$(DirNum) = FileTemp$ + FSize$ + "  " + FDate$ + "  " + FTime$

    IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
        MID$(Dir$(DirNum), 13, 9) = "<dir>    "
    END IF

    Buffer.Attributes = 0
    Buffer.AccessTime = 0
    Buffer.AccessDate = 0
    Buffer.FileSize = 0
    Buffer.FileName = STRING$(13, 32)
    RETURN

END SUB