home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
windows
/
baswind8.zip
/
POPDIR.SUB
< prev
next >
Wrap
Text File
|
1990-09-14
|
8KB
|
240 lines
'
'
'******************************************************************************
' Function : POPDIR *
' *
' Purpose: *
' *
' *
' Results: *
' *
' Usage : *
' *
' *
' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan *
' Date Modified: - : - : *
'-----------------------------------------------------------------------------*
' NOTE: *
'******************************************************************************
' *
' SUB PROGRAM NAME (PARAMETERS) STATIC/RECURSIVE *
'-----------------------------------------------------------------------------*
' *
SUB POPDIR(SEARCH$,SHOWITEMS%,FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,NUMFILES%,SELECTFILE$,RETURN.CODE%) STATIC
DEFINT A-Z 'make all short interger by default
RETURN.CODE%=0
DIR.RETURN.CODE=0
'
' not sure that FILES$ will be a FAR array, as it is a var. length string
'
REM $DYNAMIC 'allocate array off far heap
DIM FILES$(1) 'allocate an array of only 1 element
REM $STATIC 'default arrays back to Basic data segment
FILES.MIN%=UBOUND(FILES$) 'this set LBOUND to OPTION BASE 1 also
DIM SIZE.OF.FILE AS STRING * 10
POPDIR.START:
' ATTR=&H00FF
ATTR=NUMFILES%
ATTR=ATTR AND &H00FF
COUNT=&HFF00 OR ATTR 'Get number of filenames that match SEARCH$
I=INT(VARPTR(FILES$(FILES.MIN%))) 'get pointer to start of array to hold filenames found
CALL DIR(SEARCH$,I,COUNT,DIR.RETURN.CODE) 'see how many files match our filename spec.
IF (COUNT=-1) OR (COUNT = 0) THEN 'were any matching filenames found?
NUMFILES%=0 'NO
SELECTFILE$=""
RETURN.CODE%=-2
GOTO POPDIR.DONE
END IF
NUMFILES%=COUNT
IF COUNT > 0 THEN 'allocate the filename array big
REDIM FILES$(FILES.MIN% TO FILES.MIN%+COUNT) 'enough to hold all the filenames
END IF
HEADER$=SEARCH$ 'this was the filename spec used for serach
FOR I=FILES.MIN% TO FILES.MIN%+COUNT 'make each entry big enough to hold a filename
FILES$(I)=SPACE$(22)
NEXT
'
COUNT=ATTR
I=INT(VARPTR(FILES$(FILES.MIN%)))
CALL DIR(SEARCH$,I,COUNT,DIR.RETURN.CODE)
FOR I=FILES.MIN% TO FILES.MIN%+COUNT
SELECTFILE$=FILES$(I)
GOSUB EXPAND.FILES
FILES$(I)=SELECTFILE$
NEXT
MAXITEMS=COUNT 'this many file names can be displayed
SHOWFILES=SHOWITEMS% 'but only display this many at a time
SELECT.%=FILES.MIN%
CALL POPLIST(HEADER$,SHOWFILES,MAXITEMS,FILES$(),FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,SELECT.%,RETURN.CODE%)
IF RETURN.CODE%<0 THEN 'was a filename selected
SELECT.%=0
SELECTFILE$=""
ELSE
SELECTFILE$=FILES$(SELECT.%) 'return the filename selected
END IF
GOTO POPDIR.DONE
'
EXPAND.FILES:
FILENAME$=LEFT$(SELECTFILE$,13)
ASCIIZ=INSTR(FILENAME$,CHR$(0))
IF ASCIIZ>0 THEN
FILENAME$=LEFT$(FILENAME$,ASCIIZ-1)
END IF
FILENAME$=FILENAME$+SPACE$(80)
FILE.ATTR$=MID$(SELECTFILE$,14,1)
FILE.ATTR=ASC(FILE.ATTR$)
FILESIZE$=""
FILEATTR$=""
IF (FILE.ATTR AND &H10)<>0 THEN
FILESIZE$=" <DIR> "
END IF
IF (FILE.ATTR AND &H08)<>0 THEN
FILEATTR$=FILEATTR$+"+ LABEL "
END IF
IF (FILE.ATTR AND &H02)<>0 THEN
FILEATTR$=FILEATTR$+"+ HIDDEN "
END IF
IF (FILE.ATTR AND &H04)<>0 THEN
FILEATTR$=FILEATTR$+"+ SYSTEM "
END IF
IF (FILE.ATTR AND &H01)<>0 THEN
FILENATTR$="+READONLY"
END IF
IF (FILE.ATTR AND &H20)<>0 THEN
FILEATTR$=FILEATTR$+"+ ARCHIVE"
END IF
MONTH$=MID$(SELECTFILE$,17,1)
MONTH=ASC(MONTH$) AND &HE0
MONTH=MONTH/32
MONTH$=MID$(SELECTFILE$,18,1)
MONTH.TEMP=ASC(MONTH$) AND &H01
MONTH.TEMP=MONTH.TEMP*8
MONTH=MONTH+MONTH.TEMP
DAY$=MID$(SELECTFILE$,17,1)
DAY=ASC(DAY$) AND &H1F
YEAR$=MID$(SELECTFILE$,18,1)
YEAR=ASC(YEAR$) AND &HFE
YEAR=YEAR/2
YEAR=1980+YEAR
'
HOURS$=MID$(SELECTFILE$,16,1)
HOURS=ASC(HOURS$) AND &HF8
HOURS=HOURS/8
MINUTES$=MID$(SELECTFILE$,16,1)
MINUTES=ASC(MINUTES$) AND &H03
MINUTES=MINUTES*8
MINUTES$=MID$(SELECTFILE$,15,1)
MINUTES.TEMP=ASC(MINUTES$) AND &HE0
MINUTES.TEMP=MINUTES.TEMP/32
MINUTES=MINUTES+MINUTES.TEMP
SECONDS$=MID$(SELECTFILE$,15,1)
SECONDS=ASC(SECONDS$) AND &H1F
SECONDS=SECONDS*2
FILESIZE.ADDR=VARPTR(FILESIZE&)
POKE FILESIZE.ADDR,ASC(MID$(SELECTFILE$,19,1))
FILESIZE.ADDR=VARPTR(FILESIZE&)
POKE FILESIZE.ADDR+1,ASC(MID$(SELECTFILE$,20,1))
FILESIZE.ADDR=VARPTR(FILESIZE&)
POKE FILESIZE.ADDR+2,ASC(MID$(SELECTFILE$,21,1))
FILESIZE.ADDR=VARPTR(FILESIZE&)
POKE FILESIZE.ADDR+3,ASC(MID$(SELECTFILE$,22,1))
IF FILESIZE$="" THEN
FILESIZE$=STR$(FILESIZE&)
SIZE.OF.FILE=SPACE$(10)
RSET SIZE.OF.FILE=FILESIZE$
FILESIZE$=SIZE.OF.FILE
END IF
FILEDATE$=RIGHT$(STR$(MONTH),2)+"-"+RIGHT$(STR$(DAY),2)+"-"+RIGHT$(STR$(YEAR),2)
INSTR.POS=INSTR(2,FILEDATE$," ")
IF INSTR.POS>1 THEN
MID$(FILEDATE$,INSTR.POS,1)="0"
END IF
FILETIME$=RIGHT$(STR$(HOURS),2)+":"+RIGHT$(STR$(MINUTES),2)
INSTR.POS=INSTR(2,FILETIME$," ")
IF INSTR.POS>1 THEN
MID$(FILETIME$,INSTR.POS,1)="0"
END IF
MID$(FILENAME$,13)=FILESIZE$
MID$(FILENAME$,24)=FILEDATE$
MID$(FILENAME$,34)=FILETIME$
' MID$(FILENAME$,40)=FILEATTR$
FILENAME$=RTRIM$(FILENAME$)
SELECTFILE$=FILENAME$
RETURN
'
POPDIR.DONE:
ERASE FILES$ 'free memory allocated to array
HEADER$=""
FILENAME$=""
FILESIZE$=""
FILEATTR$=""
FILETIME$=""
FILEDATE$=""
MONTH$=""
DAY$="
YEAR$=""
HOURS$=""
MINUTES$=""
SECONDS$=""
END SUB