Win3x.Org

DIM InArray%(9), OutArray%(9)
AX% = 0: DX% = 3: DS% = 8: CX% = 2  ' -- Register locations
DTA$ = SPACE$(43)                   ' -- DTA Buffer size
Path$ = "*.*" + CHR$(0)             ' -- Search path, plus null byte

REM -- Find Segment and Offset for the DTA (Disk Transfer Area)
CALL PTR86(Seg1%, Off1%, VARPTR(DTA$))

REM -- The real Offset for the string DTA$ is found by using the
REM    SADD function.
Off1% = SADD(DTA$)

REM -- Set the DTA with Interrupt Hex 21, and Function Hex 1A
InArray%(AX%) = &H1A00
InArray%(DX%) = Off1%
InArray%(DS%) = Seg1%
CALL INT86(&H21, VARPTR(InArray%(0)), VARPTR(OutArray%(0)))

REM -- Find the Segment and Offset for the Search Path
CALL PTR86(Seg1%, Off1%, VARPTR(Path$))

REM -- Real Offset is found by using the SADD function
Off1% = SADD(Path$)

REM -- Find the first file with Interrupt Hex 21, Function Hex 4E
InArray%(AX%) = &H4E00
InArray%(CX%) = 22
InArray%(DX%) = Off1%
InArray%(DS%) = Seg1%
CALL INT86(&H21, VARPTR(InArray%(0)), VARPTR(OutArray%(0)))

REM -- Stay in while loop until
REM    18 = No more files
REM     3 = Invalid search path -OR- no files found
WHILE (OutArray%(AX%) <> 18) AND (OutArray%(AX%) <> 3)
   a% = CVI(MID$(DTA$, 27, 2))  ' -- Low word of file size
   b% = CVI(MID$(DTA$, 29, 2))  ' -- High word of file size
   IF a% < 0 THEN               ' -- Calculate size relative to
      d! = 65536 + a%           '    Low word
   ELSE
      d! = a%
   END IF
   IF b% < 0 THEN               ' -- Calculate size with High word
      d! = d! + (65536 * (65536 + b%))
   ELSE
      d! = d! + (65536 * b%)
   END IF
   PRINT RIGHT$(DTA$, 13);      ' -- Print file name
   PRINT "  ";
   PRINT d!                     '    and file size
   MID$(DTA$, 31, 13) = SPACE$(13) ' -- Blank out current name
   InArray%(AX%) = &H4F00       ' Function Hex 4F - Find Next File
   CALL INT86(&H21, VARPTR(InArray%(0)), VARPTR(OutArray%(0)))
WEND
END

TYPE RegTypex
   AX    AS INTEGER
   BX    AS INTEGER
   CX    AS INTEGER
   DX    AS INTEGER
   BP    AS INTEGER
   SI    AS INTEGER
   DI    AS INTEGER
   DS    AS INTEGER
   ES    AS INTEGER
   Flags AS INTEGER
END TYPE
DIM DTA AS STRING
DTA = SPACE$(43)
DIM Path AS STRING
Path = "*.*" + CHR$(0)
DIM Segment AS INTEGER, Offset AS INTEGER
Segment = VARSEG(DTA)
Offset = SADD(DTA)
DIM RegIn AS RegTypex, RegOut AS RegTypex
RegIn.AX = &H1A00
RegIn.DX = Offset
RegIn.DS = Segment
CALL Interruptx(&H21, RegIn, RegOut)

Segment = VARSEG(Path)
Offset = SADD(Path)
DIM RegIn2 AS RegTypex, RegOut2 AS RegTypex
RegIn.AX = &H4E00
RegIn.CX = 23
RegIn.DX = Offset
RegIn.DS = Segment
CALL Interruptx(&H21, RegIn2, RegOut2)

SHELL "dir c:\repertoire > c:\file.txt"
OPEN "c:\file.txt" for output as #1
'tu sélectionne la première ligne ou la dernière suivant ce que tu veux...
'après la commande, je la connaissais mais ça fait longtemps que je n'ai pas fait de QBasic...
CLOSE #1

'$INCLUDE: 'qb.bi'
DECLARE SUB suivant ()
DECLARE SUB dta ()
DECLARE SUB premier (fic$)
'
' Ce programme affiche les fichiers présents sur une unité
' courante, programme simplifié sans gestion des répertoires...
'

SCREEN 0: CLS
' Definir le Masque Fichier
MASQ$ = "*.*" + CHR$(0)
CALL dta
CALL premier(MASQ$)
NBR% = 0
DO
	IF trouve THEN
		NBR% = NBR% + 1: NOMFIC$ = ""
		DEF SEG = dtaseg
		FOR I = 30 TO 42
			S% = PEEK(dtaofs + I)
			IF S% = 0 THEN EXIT FOR
			NOMFIC$ = NOMFIC$ + CHR$(S%)
		NEXT I
		DEF SEG
		PRINT NOMFIC$
	ELSE
		DEF SEG
		EXIT DO
	END IF
	CALL suivant
LOOP
PRINT STRING$(60, 196)
PRINT "FIN DE PROGRAMME, Nombre De Fichiers : "; NBR%
END

SUB dta STATIC
SHARED dtaofs, dtaseg, inregx AS RegTypeX, outregx AS RegTypeX
	inregx.ax = &H2F00
	CALL INTERRUPTX(&H21, inregx, outregx)
	dtaofs = outregx.bx
	dtaseg = outregx.es
END SUB

SUB premier (fic$) STATIC
SHARED trouve, inreg AS RegType, outreg AS RegType
	inreg.ax = &H4E00
	inreg.cx = &HFF
	inreg.dx = SADD(fic$)
	CALL INTERRUPT(&H21, inreg, outreg)
	trouve = ((outreg.flags AND 1) = 0)
END SUB

SUB suivant STATIC
SHARED inreg AS RegType, outreg AS RegType, trouve
	inreg.ax = &H4F00
	CALL INTERRUPT(&H21, inreg, outreg)
	trouve = ((outreg.flags AND 1) = 0)
END SUB

DECLARE FUNCTION FindFirstFile$ (fic$)
DECLARE FUNCTION FindNextFile$ ()
TYPE RegTypex
   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
CLS
DIM Recherche AS STRING
Recherche = FindFirstFile$("*.*")
WHILE Recherche <> CHR$(0)
PRINT Recherche
Recherche = FindNextFile$
WEND

FUNCTION FindFirstFile$ (File AS STRING)
DIM Fichier AS STRING
Fichier = File + CHR$(0)
DIM RegIn AS RegTypex, RegOut AS RegTypex
RegIn.AX = &H4E00
RegIn.CX = &HFF
RegIn.DX = SADD(Fichier)
CALL Interrupt(&H21, RegIn, RegOut)
IF RegOut.Flags = 2 THEN
   'Recherche de la position de la DTA
   RegIn.AX = &H2F00
   RegIn.CX = 0
   RegIn.DX = 0
   CALL INTERRUPTX(&H21, RegIn, RegOut)
   DIM DTASegment AS INTEGER, DTAOffset AS INTEGER
   DTASegment = RegOut.ES
   DTAOffset = RegOut.BX

   'Lecture du nom de fichier
   DEF SEG = DTASegment
   FOR A = 30 TO 42
      Char = PEEK(DTAOffset + A)
      IF Char = 0 THEN EXIT FOR
      TmpStr$ = TmpStr$ + CHR$(Char)
   NEXT
   DEF SEG
ELSE
   TmpStr$ = CHR$(0)
END IF
FindFirstFile$ = TmpStr$
END FUNCTION

FUNCTION FindNextFile$
DIM RegIn AS RegTypex, RegOut AS RegTypex
RegIn.AX = &H4F00
CALL Interrupt(&H21, RegIn, RegOut)
IF RegOut.Flags = 2 THEN
   'Recherche de la position de la DTA
   DIM DTASegment AS INTEGER, DTAOffset AS INTEGER
   RegIn.AX = &H2F00
   RegIn.CX = 0
   RegIn.DX = 0
   CALL INTERRUPTX(&H21, RegIn, RegOut)
   DTASegment = RegOut.ES
   DTAOffset = RegOut.BX
   
   'Lecture du nom de fichier
   DEF SEG = DTASegment
   FOR A = 30 TO 42
      Char = PEEK(DTAOffset + A)
      IF Char = 0 THEN EXIT FOR
      TmpStr$ = TmpStr$ + CHR$(Char)
   NEXT
   DEF SEG
ELSE
   TmpStr$ = CHR$(0)
END IF
FindNextFile$ = TmpStr$
END FUNCTION

FILES