home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / BASWIND8.ZIP / POPDIR.SUB < prev    next >
Encoding:
Text File  |  1990-09-14  |  7.5 KB  |  240 lines
  1. '
  2. '
  3. '******************************************************************************
  4. '                    Function : POPDIR                                        *
  5. '                                                                             *
  6. ' Purpose:                                                                    *
  7. '                                                                             *
  8. '                                                                             *
  9. ' Results:                                                                    *
  10. '                                                                             *
  11. ' Usage  :                                                                    *
  12. '                                                                             *
  13. '                                                                             *
  14. ' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan    *
  15. ' Date Modified:          -            :          -       :                   *
  16. '-----------------------------------------------------------------------------*
  17. ' NOTE:                                                                       *
  18. '******************************************************************************
  19. '                                                                             *
  20. '     SUB PROGRAM NAME          (PARAMETERS)                 STATIC/RECURSIVE *
  21. '-----------------------------------------------------------------------------*
  22. '                                                                             *
  23. SUB    POPDIR(SEARCH$,SHOWITEMS%,FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,NUMFILES%,SELECTFILE$,RETURN.CODE%) STATIC
  24.  
  25.        DEFINT A-Z                             'make all short interger by default
  26.  
  27.        RETURN.CODE%=0
  28.        DIR.RETURN.CODE=0
  29. '
  30. ' not sure that FILES$ will be a FAR array, as it is a var. length string
  31. '
  32.  
  33. REM    $DYNAMIC                               'allocate array off far heap
  34.        DIM FILES$(1)                          'allocate an array of only 1 element
  35. REM    $STATIC                                'default arrays back to Basic data segment
  36.  
  37.        FILES.MIN%=UBOUND(FILES$)              'this set LBOUND to OPTION BASE 1 also
  38.  
  39.        DIM SIZE.OF.FILE AS STRING * 10
  40.  
  41. POPDIR.START:
  42. '      ATTR=&H00FF
  43.        ATTR=NUMFILES%
  44.  
  45.        ATTR=ATTR AND &H00FF
  46.  
  47.        COUNT=&HFF00 OR ATTR                   'Get number of filenames that match SEARCH$
  48.  
  49.        I=INT(VARPTR(FILES$(FILES.MIN%)))      'get pointer to start of array to hold filenames found
  50.  
  51.        CALL DIR(SEARCH$,I,COUNT,DIR.RETURN.CODE)  'see how many files match our filename spec.
  52.  
  53.        IF (COUNT=-1) OR (COUNT = 0) THEN      'were any matching filenames found?
  54.             NUMFILES%=0                        'NO
  55.             SELECTFILE$=""
  56.             RETURN.CODE%=-2
  57.           GOTO POPDIR.DONE
  58.        END IF
  59.  
  60.        NUMFILES%=COUNT
  61.  
  62.        IF COUNT > 0 THEN                     'allocate the filename array big
  63.            REDIM FILES$(FILES.MIN% TO FILES.MIN%+COUNT)  'enough to hold all the filenames
  64.        END IF
  65.  
  66.        HEADER$=SEARCH$                        'this was the filename spec used for serach
  67.  
  68.        FOR I=FILES.MIN% TO FILES.MIN%+COUNT   'make each entry big enough to hold a filename
  69.            FILES$(I)=SPACE$(22)
  70.        NEXT
  71.  
  72. '
  73.        COUNT=ATTR
  74.  
  75.        I=INT(VARPTR(FILES$(FILES.MIN%)))
  76.  
  77.        CALL DIR(SEARCH$,I,COUNT,DIR.RETURN.CODE)
  78.  
  79.        FOR I=FILES.MIN% TO FILES.MIN%+COUNT
  80.            SELECTFILE$=FILES$(I)
  81.            GOSUB EXPAND.FILES
  82.            FILES$(I)=SELECTFILE$
  83.        NEXT
  84.  
  85.        MAXITEMS=COUNT                         'this many file names can be displayed
  86.        SHOWFILES=SHOWITEMS%                   'but only display this many at a time
  87.  
  88.        SELECT.%=FILES.MIN%
  89.  
  90.        CALL POPLIST(HEADER$,SHOWFILES,MAXITEMS,FILES$(),FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,SELECT.%,RETURN.CODE%)
  91.  
  92.        IF RETURN.CODE%<0 THEN                   'was a filename selected
  93.            SELECT.%=0
  94.            SELECTFILE$=""
  95.        ELSE
  96.            SELECTFILE$=FILES$(SELECT.%)         'return the filename selected
  97.        END IF
  98.  
  99.        GOTO POPDIR.DONE
  100.  
  101. '
  102. EXPAND.FILES:
  103.        FILENAME$=LEFT$(SELECTFILE$,13)
  104.        ASCIIZ=INSTR(FILENAME$,CHR$(0))
  105.        IF ASCIIZ>0 THEN
  106.            FILENAME$=LEFT$(FILENAME$,ASCIIZ-1)
  107.        END IF
  108.  
  109.        FILENAME$=FILENAME$+SPACE$(80)
  110.  
  111.        FILE.ATTR$=MID$(SELECTFILE$,14,1)
  112.        FILE.ATTR=ASC(FILE.ATTR$)
  113.  
  114.        FILESIZE$=""
  115.        FILEATTR$=""
  116.  
  117.        IF (FILE.ATTR AND &H10)<>0 THEN
  118.            FILESIZE$="  <DIR>   "
  119.        END IF
  120.  
  121.        IF (FILE.ATTR AND &H08)<>0 THEN
  122.            FILEATTR$=FILEATTR$+"+ LABEL  "
  123.        END IF
  124.  
  125.        IF (FILE.ATTR AND &H02)<>0 THEN
  126.            FILEATTR$=FILEATTR$+"+ HIDDEN "
  127.        END IF
  128.  
  129.        IF (FILE.ATTR AND &H04)<>0 THEN
  130.            FILEATTR$=FILEATTR$+"+ SYSTEM "
  131.        END IF
  132.  
  133.        IF (FILE.ATTR AND &H01)<>0 THEN
  134.            FILENATTR$="+READONLY"
  135.        END IF
  136.  
  137.        IF (FILE.ATTR AND &H20)<>0 THEN
  138.            FILEATTR$=FILEATTR$+"+ ARCHIVE"
  139.        END IF
  140.  
  141.        MONTH$=MID$(SELECTFILE$,17,1)
  142.        MONTH=ASC(MONTH$) AND &HE0
  143.        MONTH=MONTH/32
  144.  
  145.        MONTH$=MID$(SELECTFILE$,18,1)
  146.        MONTH.TEMP=ASC(MONTH$) AND &H01
  147.        MONTH.TEMP=MONTH.TEMP*8
  148.  
  149.        MONTH=MONTH+MONTH.TEMP
  150.  
  151.        DAY$=MID$(SELECTFILE$,17,1)
  152.        DAY=ASC(DAY$) AND &H1F
  153.  
  154.        YEAR$=MID$(SELECTFILE$,18,1)
  155.        YEAR=ASC(YEAR$) AND &HFE
  156.        YEAR=YEAR/2
  157.        YEAR=1980+YEAR
  158.  
  159. '
  160.        HOURS$=MID$(SELECTFILE$,16,1)
  161.        HOURS=ASC(HOURS$) AND &HF8
  162.        HOURS=HOURS/8
  163.  
  164.        MINUTES$=MID$(SELECTFILE$,16,1)
  165.        MINUTES=ASC(MINUTES$) AND &H03
  166.        MINUTES=MINUTES*8
  167.  
  168.        MINUTES$=MID$(SELECTFILE$,15,1)
  169.        MINUTES.TEMP=ASC(MINUTES$) AND &HE0
  170.        MINUTES.TEMP=MINUTES.TEMP/32
  171.        MINUTES=MINUTES+MINUTES.TEMP
  172.  
  173.        SECONDS$=MID$(SELECTFILE$,15,1)
  174.        SECONDS=ASC(SECONDS$) AND &H1F
  175.        SECONDS=SECONDS*2
  176.  
  177.        FILESIZE.ADDR=VARPTR(FILESIZE&)
  178.        POKE FILESIZE.ADDR,ASC(MID$(SELECTFILE$,19,1))
  179.  
  180.        FILESIZE.ADDR=VARPTR(FILESIZE&)
  181.        POKE FILESIZE.ADDR+1,ASC(MID$(SELECTFILE$,20,1))
  182.  
  183.        FILESIZE.ADDR=VARPTR(FILESIZE&)
  184.        POKE FILESIZE.ADDR+2,ASC(MID$(SELECTFILE$,21,1))
  185.  
  186.        FILESIZE.ADDR=VARPTR(FILESIZE&)
  187.        POKE FILESIZE.ADDR+3,ASC(MID$(SELECTFILE$,22,1))
  188.  
  189.        IF FILESIZE$="" THEN
  190.            FILESIZE$=STR$(FILESIZE&)
  191.            SIZE.OF.FILE=SPACE$(10)
  192.            RSET SIZE.OF.FILE=FILESIZE$
  193.            FILESIZE$=SIZE.OF.FILE
  194.        END IF
  195.  
  196.        FILEDATE$=RIGHT$(STR$(MONTH),2)+"-"+RIGHT$(STR$(DAY),2)+"-"+RIGHT$(STR$(YEAR),2)
  197.  
  198.        INSTR.POS=INSTR(2,FILEDATE$," ")
  199.  
  200.        IF INSTR.POS>1 THEN
  201.            MID$(FILEDATE$,INSTR.POS,1)="0"
  202.        END IF
  203.  
  204.        FILETIME$=RIGHT$(STR$(HOURS),2)+":"+RIGHT$(STR$(MINUTES),2)
  205.  
  206.        INSTR.POS=INSTR(2,FILETIME$," ")
  207.  
  208.        IF INSTR.POS>1 THEN
  209.            MID$(FILETIME$,INSTR.POS,1)="0"
  210.        END IF
  211.  
  212.        MID$(FILENAME$,13)=FILESIZE$
  213.        MID$(FILENAME$,24)=FILEDATE$
  214.        MID$(FILENAME$,34)=FILETIME$
  215. '      MID$(FILENAME$,40)=FILEATTR$
  216.  
  217.        FILENAME$=RTRIM$(FILENAME$)
  218.  
  219.        SELECTFILE$=FILENAME$
  220.  
  221.        RETURN
  222.  
  223. '
  224. POPDIR.DONE:
  225.        ERASE FILES$                            'free memory allocated to array
  226.        HEADER$=""
  227.        FILENAME$=""
  228.        FILESIZE$=""
  229.        FILEATTR$=""
  230.        FILETIME$=""
  231.        FILEDATE$=""
  232.        MONTH$=""
  233.        DAY$="
  234.        YEAR$=""
  235.        HOURS$=""
  236.        MINUTES$=""
  237.        SECONDS$=""
  238.  
  239. END SUB
  240.