'===========================================================================
' Subject: FILE SORT                         Date: 12-23-96 (14:37)       
' Author:  Egbert Zijlema                    Code: PB                     
' Origin:  E.Zijlema@uni4nn.iaf.nl         Packet: PB.ABC
'===========================================================================
' FILESORT.BAS - PB routine to sort files in current directory
'                either alphabetically or by date/time (LiFo)
' Author       : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)
' (up)Date     : 24 December 1996
' Language     : Power Basic (3.2)
' (C) status   : Public Domain

' ARRAY SORT is a piece of cake in Power Basic, since it's a built-in
' routine. Why this sample code for such a simple matter?  To demonstrate
' how to sort the contents of a directory by date/time (last in, first out).

DEFINT A - Z                               ' all vars integer unless tagged
%NO = 0 : %YES = NOT %NO                   ' Boolean true/false
%F1 = 59 * 256                             ' funkey to change dir
%F2 = 60 * 256                             ' funkey to toggle sort method
%ALTX = 45 * 256                           ' exit program
%UP = 72 * 256 : %DOWN = 80 * 256          ' scroll keys

TYPE FLAGS
  stamp AS INTEGER                         ' sort by date/time
  recs AS INTEGER                          ' number of records in array
  first AS INTEGER                         ' first file on screen
END TYPE
DIM flg AS SHARED FLAGS

DIM FileName(1 : 512) AS SHARED STRING     ' array for filenames
DIM DateTime(1 : 512) AS SHARED STRING     ' array for date/time stamps
DIM FileDir AS SHARED STRING

flg.stamp = %YES                           ' sort by date = default
FileDir = CURDIR$                          ' current dir = default

FUNCTION GetKey AS INTEGER
  DO
  LOOP UNTIL INSTAT
  FUNCTION = CVI(INKEY$ + CHR$(0))
END FUNCTION

SUB MakeArrays
  flg.recs = 0
  flg.first = 1
  number = FREEFILE
  FileFound$ = DIR$(FileDir + "\*.*")
  DO WHILE LEN(FileFound$)
    OPEN FileDir + "\" + FileFound$ FOR BINARY AS #number
    dos = FILEATTR(number, 2)                ' DOS-handle
    REG 1, &H5700                            ' load function &H5700 in AX
    REG 2, dos                               ' load DOS-handle in BX
    CALL INTERRUPT &H21                      ' interrupt call
    carry = REG (0) AND 1                    ' carry flag
    CLOSE #number
    INCR flg.recs
    FileName(flg.recs) = LEFT$(FileFound$ + SPACE$(12), 12)
    IF carry THEN                            ' error
      DateTime(flg.recs) = "33"              ' 1 January 1980
    ELSE
      DateTime(flg.recs) = LTRIM$(RTRIM$(STR$(REG(4)))) + _    ' date stamp
                           LTRIM$(RTRIM$(STR$(REG(3))))        ' time stamp
    END IF
    IF flg.recs = UBOUND(FileName) THEN EXIT DO                ' full array
    FileFound$ = DIR$
  LOOP
  SortArrays
END SUB

SUB SortArrays
  IF flg.stamp THEN
    ARRAY SORT DateTime() FOR flg.recs, TAGARRAY FileName(), DESCEND
  ELSE
    ARRAY SORT FileName() FOR flg.recs, TAGARRAY DateTime(), ASCEND
  END IF
END SUB

SUB DisplayArray
  row = 1
  FOR count = flg.first TO flg.first + 19     ' display 20 files
    LOCATE row, 2
    IF count > flg.recs THEN                  ' no more files
      PRINT SPACE$(12)                        ' clear unused rows
    ELSE
      PRINT FileName(count)
    END IF
    INCR row
  NEXT
END SUB

SUB Menu
  DO
    KeyIn = GetKey
    SELECT CASE KeyIn
      CASE %F1
        DO
          LOCATE 23, 13 : PRINT SPACE$(66);
          LOCATE 23, 13
          LINE INPUT ""; text$
        LOOP UNTIL LEN(DIR$(text$, 16))   ' until valid dir name
        LOCATE 23, 13 : PRINT UCASE$(text$)
        FileDir = text$
        MakeArrays
        DisplayArray
      CASE %F2
        LOCATE 24, 9
        IF flg.stamp THEN
          flg.stamp = %NO
          PRINT "alphabetically";
        ELSE
          flg.stamp = %YES
          PRINT "by date (LiFo)" ;
        END IF
        SortArrays
        DisplayArray
      CASE %DOWN
        IF flg.recs < 21 OR flg.first + 19 = flg.recs THEN EXIT SELECT
        INCR flg.first
        DisplayArray
      CASE %UP
        IF flg.first > 1 THEN
          DECR flg.first
          DisplayArray
        END IF
      CASE %ALTX
        CLS
        SYSTEM
    END SELECT
  LOOP
END SUB

' main
CLS
  LOCATE 23, 2 : PRINT "Directory: "; UCASE$(FileDir)
  LOCATE 24, 2 : PRINT "Sorted ";
  IF flg.stamp THEN
    PRINT "by date (LiFo)"
  ELSE
    PRINT "alphabetically"
  END IF
  LOCATE 25, 2 : PRINT "F1 = directory; F2 = sort order; Alt-x = quit; ";
                 PRINT "Arrow Up/Down = scroll";
  MakeArrays
  DisplayArray
  Menu
END