🚀 go-pugleaf

In <1992Apr3.062548.7308@cc.uow.edu.au> dryan@cc.uow.edu.au writes:

> Greetings alt.lang.basic.people,
> 				I was wondering if it were possible to shell 
> out to dos, do a directory listing, but then store that listing into an
> array so that I may have my way with the elements. The upshot of this being
> that I would like to display the dir listing in a column rather than the
> usual way that DOS does. By the way I am using Quickbasic 4.0.
> 
> 					Thanks in the future, Davidius.

I can make this for the QB 4.5 (I can't QB 4.0).

Good Luck.

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

This is a BASIC implementation of interrupt calls ReadFirstEntry and
ReadNextEntry.

The QB is executed with the "/L qb.qlb" commandline option.

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

DECLARE FUNCTION Conv$ (Dat AS STRING)
DECLARE FUNCTION Errors$ (errr AS INTEGER)
DECLARE FUNCTION GetAttributes$ ()
DECLARE FUNCTION GetDate$ ()
DECLARE FUNCTION GetSize! ()
DECLARE FUNCTION gettime$ ()
DECLARE FUNCTION ReadFirstEntry$ (errr AS INTEGER)
DECLARE FUNCTION ReadNextEntry$ (errr AS INTEGER)

DEFINT A-Z

TYPE REGTYPE
  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

TYPE DATATYPE
  Dt AS STRING * 21   'reserved for FindNextEntry
  At AS STRING * 1    '1:ReadOnly,  2:Hidden,     4:System
                      '8:Label,    16:Directory, 32:Archive
  Ti AS INTEGER       'time
  Da AS INTEGER       'date
  Si AS STRING * 4    'size
  Na AS STRING * 13   'name
END TYPE

DIM SHARED Path AS STRING * 64, Dta AS DATATYPE
DIM SHARED RegA AS REGTYPE, RegB AS REGTYPE

' example of a simple DIR program

INPUT "dir ", a$

IF a$ = "" THEN a$ = "*.*"

Path = a$ + CHR$(0)     ' Path requires a CHR$(0)

PRINT ReadFirstEntry(errr),

IF errr = 0 THEN
  PRINT GetDate, gettime, GetSize, GetAttributes
END IF

DO UNTIL errr > 0
  PRINT ReadNextEntry(errr), GetDate, gettime, GetSize, GetAttributes
LOOP

IF errr > 0 THEN
  PRINT Errors(errr)
END IF

FUNCTION Conv$ (Dat AS STRING) STATIC

STATIC k AS INTEGER

Conv = "            "
k = 1
WHILE MID$(Dat, k, 1) <> CHR$(0)
  MID$(Conv, k, 1) = MID$(Dat, k, 1)
  k = k + 1
WEND

END FUNCTION

FUNCTION Errors$ (errr AS INTEGER) STATIC

SELECT CASE errr
  CASE 0:  Errors$ = "no error has occurred"
  CASE 1:  Errors$ = "invalid dos service"
  CASE 2:  Errors$ = "file not found"
  CASE 3:  Errors$ = "path not found"
  CASE 4:  Errors$ = "no handle available"
  CASE 5:  Errors$ = "access denied"
  CASE 6:  Errors$ = "invalid handle"
  CASE 7:  Errors$ = "memory control block destroyed"
  CASE 8:  Errors$ = "insufficient memory"
  CASE 9:  Errors$ = "invalid memory address"
  CASE 10: Errors$ = "invalid environment"
  CASE 11: Errors$ = "invalid format"
  CASE 12: Errors$ = "invalid access code"
  CASE 13: Errors$ = "invalid data"
  CASE 15: Errors$ = "invalid disk drive"
  CASE 16: Errors$ = "current directory in use"
  CASE 17: Errors$ = "different device"
  CASE 18: Errors$ = "no more files"
  CASE 21: Errors$ = "disk full"
  CASE 22: Errors$ = "end of file"
CASE ELSE
    Errors$ = "undefined error code"
END SELECT

END FUNCTION

FUNCTION GetAttributes$ STATIC

STATIC a AS INTEGER, s AS STRING

a = ASC(Dta.At)

s = ""

IF (a AND 1) > 0 THEN s = s + "R"
IF (a AND 2) > 0 THEN s = s + "H"
IF (a AND 4) > 0 THEN s = s + "S"
IF (a AND 8) > 0 THEN s = s + "L"
IF (a AND 16) > 0 THEN s = s + "D"
IF (a AND 32) > 0 THEN s = s + "A"

GetAttributes = s

END FUNCTION

FUNCTION GetDate$ STATIC

STATIC a AS STRING * 8

MID$(a, 1, 3) = RIGHT$("0" + MID$(STR$(Dta.Da AND 31), 2), 2) + "-"
MID$(a, 4, 3) = RIGHT$("0" + MID$(STR$(INT(Dta.Da / 32) AND 15), 2), 2) + "-"
MID$(a, 7, 2) = MID$(STR$(INT(Dta.Da / 512) + 80), 2, 2)

GetDate = a

END FUNCTION

FUNCTION GetSize! STATIC

STATIC a AS SINGLE

a = ASC(Dta.Si) + ASC(MID$(Dta.Si, 2)) * 256!
a = a + ASC(MID$(Dta.Si, 3)) * 65536! + ASC(MID$(Dta.Si, 4)) * 16777216

GetSize = a

END FUNCTION

FUNCTION gettime$ STATIC

STATIC a AS STRING * 8

MID$(a, 1, 3) = RIGHT$("0" + MID$(STR$(INT(Dta.Ti / 2048) AND 31), 2), 2) + ":"
MID$(a, 4, 3) = RIGHT$("0" + MID$(STR$(INT(Dta.Ti / 32) AND 63), 2), 2) + ":"
MID$(a, 7, 2) = RIGHT$("0" + MID$(STR$((Dta.Ti AND 31) * 2), 2), 2)

gettime = a

END FUNCTION

FUNCTION ReadFirstEntry$ (errr AS INTEGER) STATIC

RegA.ax = &H1A00
RegA.dx = VARPTR(Dta)
RegA.ds = VARSEG(Dta)

CALL INTERRUPT(&H21, RegA, RegB)

RegA.ax = &H4E00
RegA.dx = VARPTR(Path)
RegA.ds = VARSEG(Path)
RegA.cx = 255                   'search attribute : 255 = ALL files

CALL INTERRUPT(&H21, RegA, RegB)

ReadFirstEntry = Conv(Dta.Na)
errr = RegB.ax

END FUNCTION

FUNCTION ReadNextEntry$ (errr AS INTEGER) STATIC

RegA.ax = &H1A00
RegA.dx = VARPTR(Dta)
RegA.ds = VARSEG(Dta)

CALL INTERRUPT(&H21, RegA, RegB)

RegA.ax = &H4F00

CALL INTERRUPT(&H21, RegA, RegB)

ReadNextEntry = Conv(Dta.Na)
errr = RegB.ax

END FUNCTION

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

           /**************************************\
           * Ghielmetti Leopoldo                  *
           \**************************************/*****\
                   *   e-mail : ghielmet@eldi.epfl.ch   *
                   \************************************/