'===========================================================================
' Subject: CATALOG BASIC FILES                Date: 05-23-93 (00:00)       
'  Author: John Gallas                        Code: QB, PDS                
'  Origin: harryst@castel.nl                Packet: MISC.ABC
'===========================================================================
' CATALOG.BAS   -   By John Gallas   -   Completed on 5/23/1993
'
' You can do whatever you want with this program, but please remember who
' really wrote it.
'
' Its a directory catalogger!  I use it for keeping track of all my
' QB/PDS/PB/etc source code.  I have a directory devoted to source,
' and whenever I get a new file, I just zip it up and copy it into the
' directory.  Then once in awhile, I go into the program and [S]can
' for new files, and it locates all the files that aren't in the database
' that are in the directory, I type in descriptions, and they're added.
' Then I S[o]rt the database using an extremely fast shell sort.  I can
' easily go through all my files and search for certian ones that I want,
' and I can change any of the descriptions with the touch of a button.
' This could be a nice basis for a file system for a BBS if anyone wanted
' to expand on it.

DEFINT A-Z

DECLARE SUB Scroll (Direction%, Top%, Left%, Bottom%, Right%, Lines%, Attr%)
DECLARE SUB RemoveRecords ()
DECLARE SUB FastSortI (Inarray() AS ANY, Lower AS INTEGER, Upper AS INTEGER)
DECLARE SUB FindFiles ()
DECLARE SUB ScanForNew ()
DECLARE SUB ScrollDN ()
DECLARE SUB ScrollUP ()
DECLARE SUB ExtractFile ()
DECLARE SUB Sort ()
DECLARE SUB SpecifyNewRecords ()
DECLARE SUB UpdateRecords ()

DECLARE FUNCTION AllFiles$ ()
DECLARE FUNCTION EditString$ (Text$, MaxX%)
DECLARE FUNCTION TruncateFile% (Handle%, NewLength&)
DECLARE FUNCTION Choice$ (Choices$)
DECLARE FUNCTION DIR$ (Path$)
DECLARE FUNCTION GetSize& (file$)
DECLARE FUNCTION Match% (Filename$, WildCard$)
DECLARE FUNCTION YesNo$ ()

'-----  Some constants that DIR$ uses
CONST DOS = &H21
CONST SetDTA = &H1A00, FindFirst = &H4E00, FindNext = &H4F00

'used for the scrolling routines
CONST sUP = &H600, sDOWN = &H700

CONST True = -1, False = 0

' Don't forget to load QB.QLB/QBX.QLB!
' $INCLUDE: '\QB45\QB.BI'

TYPE CatalogType
   Filename   AS STRING * 12
   FileSize   AS LONG
   Description  AS STRING * 60
END TYPE

DIM SHARED Filename$  'the catalog file name
DIM SHARED Cat AS CatalogType

CLS

IF COMMAND$ = "" THEN
   PRINT "Data file: ";
   Filename$ = ""
   Filename$ = EditString$(Filename$, 40)
   IF Filename$ = "" THEN END
ELSE
   Filename$ = COMMAND$
END IF

OPEN Filename$ FOR RANDOM AS #1 LEN = LEN(Cat)

'turn off the blinking cursor
LOCATE , , 0, 12, 13

'prepare the screen
CLS
LOCATE 4, 1
PRINT STRING$(80, 196);
LOCATE 25, 1
PRINT STRING$(80, 196);

GOSUB PrintHelp

Total = LOF(1) \ LEN(Cat)

Down = 5

StartLine = 1
GOSUB PrintPage

Selected = 1
Down = 5

LOCATE , , 0

DO

   x$ = "[" + LTRIM$(STR$(Selected)) + "/" + LTRIM$(STR$(Total)) + "]"
   LOCATE 3, 75 - LEN(x$)
   PRINT SPACE$(5) + x$;
   LOCATE Down, 13
   PRINT CHR$(17);

   DO
      x$ = INKEY$
   LOOP UNTIL LEN(x$)

   LOCATE Down, 13
   PRINT " ";

   SELECT CASE x$
   CASE CHR$(0) + CHR$(72) 'up key
      IF Selected > 1 THEN
         Selected = Selected - 1
         Down = Down - 1
         IF Down = 4 THEN
            ScrollDN
            Down = 5
            GET #1, Selected, Cat
            LOCATE Down, 1
            GOSUB PrintLine
         END IF
      END IF
   CASE CHR$(0) + CHR$(80) 'down key
      IF Selected < Total THEN
         Selected = Selected + 1
         Down = Down + 1
         IF Down = 25 THEN
            ScrollUP
            Down = 24
            GET #1, Selected, Cat
            LOCATE Down, 1
            GOSUB PrintLine
         END IF
      END IF
   CASE CHR$(0) + CHR$(73)  'page up
      IF Selected - 20 < Down - 4 THEN
         Selected = Down - 4
      ELSE
         Selected = Selected - 20
      END IF
      'find out which record # is at the top of the screen
      StartLine = Selected - (Down - 5)
      GOSUB PrintPage
   CASE CHR$(0) + CHR$(81)  'page down
      StartLine = Selected - (Down - 5)
      'if we're not on the last page then..
      IF Total - StartLine > 19 THEN
         Selected = Selected + 20
         IF Selected > Total THEN
            Down = Down - (Selected - Total)
            Selected = Total
         END IF
         StartLine = Selected - (Down - 5)
         GOSUB PrintPage
      END IF
   CASE CHR$(0) + CHR$(71)  'home
      Selected = 1
      Down = 5
      StartLine = Selected - (Down - 5)
      GOSUB PrintPage
   CASE CHR$(0) + CHR$(79)  'end
      IF Total < 20 THEN
         Selected = Total
         Down = 5 + Selected
         StartLine = 1
      ELSE
         StartLine = Total - 19
         Selected = Total
         Down = 24
      END IF
      GOSUB PrintPage
   CASE CHR$(13)  'return, edit the description field
      GET #1, Selected, Cat
      Temp$ = RTRIM$(Cat.Description)
      LOCATE Down, 20
      PRINT ">";
      Temp$ = EditString$(Temp$, 60) '60 is the maximum length allowed.
      'Now fill in what they wrote.  If they wrote something different from
      'the origional, but then aborted it, editstring$ will return the
      'unchanged string.
      LOCATE Down, 20, 0
      PRINT " ";
      Cat.Description = Temp$
      PUT #1, Selected, Cat
      LOCATE Down, 1
      GOSUB PrintLine
      Temp$ = ""
   CASE CHR$(27), "Q", "q"
      EXIT DO
   CASE "R", "r" 'remove files
      RemoveRecords
      GOSUB PrintHelp
      Total = LOF(1) \ LEN(Cat)
      IF Selected > Total THEN
         Selected = Selected - 1
         Down = Down - 1
         IF Down = 4 THEN
            ScrollDN
            Down = 5
            GET #1, Selected, Cat
            LOCATE Down, 1
            GOSUB PrintLine
         END IF
      END IF
      StartLine = Selected - (Down - 5)
      GOSUB PrintPage
   CASE "S", "s" 'scan for new files in the directory
      ScanForNew
      LOCATE , , 0
      StartLine = Selected - (Down - 5)
      GOSUB PrintPage
      GOSUB PrintHelp
   CASE "F", "f", "\" 'look for files, the \ is for LIST users .. :-)
      FindFiles
      LOCATE , , 0
      StartLine = Selected - (Down - 5)
      GOSUB PrintPage
      GOSUB PrintHelp
   CASE "O", "o" 'sort records
      Sort
      GOSUB PrintPage
      GOSUB PrintHelp
   CASE "U", "u"  'update records
      UpdateRecords
      GOSUB PrintPage
      GOSUB PrintHelp

   END SELECT

LOOP

LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 24, 1

END


PrintLine:
PRINT USING "\          \ ###### \                                                          \"; Cat.Filename; Cat.FileSize; Cat.Description;
RETURN

PrintPage:
Dn = 5
FOR x = StartLine TO Total
   GET #1, x, Cat
   LOCATE Dn, 1
   PRINT USING "\          \ ###### \                                                          \"; Cat.Filename; Cat.FileSize; Cat.Description;
   Dn = Dn + 1
   IF Dn = 25 THEN EXIT FOR
NEXT x
IF Dn < 25 THEN 'fill the rest with blanks
   FOR x = Dn TO 24
      LOCATE x, 1
      PRINT SPACE$(80);
   NEXT x
END IF
RETURN

PrintHelp:
LOCATE 1, 1
PRINT "[Catalog 1.0  By John Gallas]     [S]can for new files  [F]ind file(s)         "
PRINT "                                  [R]emove files        [U]pdate records       "
PRINT "  Filename    Size  Description   S[o]rt database       [Q]uit                 "
RETURN

FUNCTION AllFiles$
' Returns a string of all the files in our database, seperated by plus's.
' This is used with INSTR to check for new files.

Temp$ = ""
x = LOF(1) \ LEN(Cat)  'find the total # of records
FOR I = 1 TO x
   GET #1, I, Cat
   Temp$ = Temp$ + "+" + RTRIM$(Cat.Filename)
NEXT I
IF LEN(Temp$) THEN Temp$ = Temp$ + "+"
AllFiles$ = Temp$

END FUNCTION

FUNCTION Choice$ (Choices$)

DO
   B$ = INKEY$
   B$ = LCASE$(B$)
   IF LEN(B$) THEN
      IF INSTR(LCASE$(Choices$), B$) THEN EXIT DO
   END IF
LOOP
Choice$ = B$

END FUNCTION

FUNCTION DIR$ (FileSpec$) STATIC
' this function was written by Dave Cleary

DIM DTA AS STRING * 44, Regs AS RegTypeX
Null$ = CHR$(0)

'-----  Set up our own DTA so we don't destroy COMMAND$
Regs.ax = SetDTA                    'Set DTA function
Regs.dx = VARPTR(DTA)               'DS:DX points to our DTA
Regs.ds = -1                        'Use current value for DS
INTERRUPTX DOS, Regs, Regs          'Do the interrupt

'-----  Check to see if this is First or Next
IF LEN(FileSpec$) THEN              'FileSpec$ isn't null, so
   'FindFirst
   FileSpecZ$ = FileSpec$ + Null$   'Make FileSpec$ into an ASCIIZ
   'string
   Regs.ax = FindFirst              'Perform a FindFirst
   Regs.cx = 0                      'Only look for normal files
   Regs.dx = SADD(FileSpecZ$)       'DS:DX points to ASCIIZ file
   Regs.ds = -1                     'Use current DS
ELSE                                'We have a null FileSpec$,
   Regs.ax = FindNext               'so FindNext
END IF

INTERRUPTX DOS, Regs, Regs          'Do the interrupt

'-----  Return file name or null
IF Regs.flags AND 1 THEN            'No files found
   DIR$ = ""                        'Return null string
ELSE
   Null = INSTR(31, DTA, Null$)     'Get the filename found
   DIR$ = MID$(DTA, 31, Null - 30)  'It's an ASCIIZ string starting
END IF                              'at offset 30 of the DTA

END FUNCTION

FUNCTION EditString$ (Text$, MaxX)

' heres my cheap little string editor

OldText$ = Text$ 'incase they want to abort later
Down = CSRLIN
across = POS(0)
OrgAc = across
in = LEN(Text$) + 1
IF in > 1 THEN across = across + in - 1
FT = True  ' first time through flag

DO
   LOCATE Down, OrgAc
   PRINT Text$ + STRING$(MaxX - LEN(Text$), 32);
   IF InsOn THEN
      IF across <= 80 THEN
         LOCATE Down, across, 1, 1, 30
      ELSE
         LOCATE Down, 80, 1, 1, 30
      END IF
   ELSE
      IF across <= 80 THEN
         LOCATE Down, across, 1, 12, 30
      ELSE
         LOCATE Down, 80, 1, 12, 30
      END IF
   END IF
   DO
      x$ = INKEY$
      IF LEN(x$) THEN
         IF ASC(x$) < 32 THEN
            IF x$ <> CHR$(8) AND x$ <> CHR$(9) AND x$ <> CHR$(13) AND x$ <> CHR$(27) AND LEN(x$) = 1 THEN x$ = ""
         END IF
      END IF
   LOOP UNTIL LEN(x$)

   IF LEN(x$) = 2 THEN
      SELECT CASE x$
      CASE CHR$(0) + CHR$(77)  'right
         FT = False
         IF in < MaxX AND in <= LEN(Text$) THEN
            across = across + 1
            in = in + 1
         END IF
      CASE CHR$(0) + CHR$(75) 'left
         FT = False
         IF in > 1 THEN
            in = in - 1
            across = across - 1
         END IF
      CASE CHR$(0) + CHR$(83)  'del
         Text$ = LEFT$(Text$, in - 1) + MID$(Text$, in + 1)
         FT = False
      CASE CHR$(0) + CHR$(82)  'insrt
         FT = False
         InsOn = (InsOn = False)
      CASE CHR$(0) + CHR$(71)  'home
         FT = False
         in = 1
         across = OrgAc
      CASE CHR$(0) + CHR$(79) 'end
         FT = False
         n = LEN(Text$) + 1
         d = n - in
         in = n
         across = across + d
      CASE ELSE
      END SELECT
   ELSE
      SELECT CASE x$
      CASE CHR$(8)
         IF in > 1 THEN
            FT = False
            Text$ = LEFT$(Text$, in - 2) + MID$(Text$, in)
            across = across - 1
            in = in - 1
         END IF
      CASE CHR$(27)
         EditString$ = OldText$  'restore it
         EXIT FUNCTION
      CASE CHR$(13)
         LOCATE , , 1, 12, 13
         EditString$ = Text$
         EXIT FUNCTION
      CASE ELSE
         IF FT = True THEN
            Text$ = ""
            across = OrgAc
            in = 1
            FT = False
         END IF
         IF in <= MaxX THEN
            IF FT = True THEN Text$ = ""
            IF LEN(Text$) < in THEN Text$ = Text$ + SPACE$(in - LEN(Text$))
            IF InsOn THEN
               IF LEN(Text$) < MaxX THEN
                  Text$ = LEFT$(Text$, in - 1) + x$ + MID$(Text$, in)
                  in = in + 1
                  across = across + 1
               END IF
            ELSE
               MID$(Text$, in) = x$
               in = in + 1
               across = across + 1
            END IF
         END IF
      END SELECT
   END IF
LOOP

END FUNCTION

SUB FastSortI (Inarray() AS CatalogType, Lower AS INTEGER, Upper AS INTEGER)

' This routine was writen by Ryan Wellman.
' Copyright 1992, Ryan Wellman, all rights reserved.
' Released as Freeware October 22, 1992.
' You may freely use, copy & modify this code as you see
' fit.  Under the condition that I am given credit for
' the original sort routine, and partial credit for modifided
' versions of the routine.

' vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
'
' Ok, heres your partial credit Ryan.  I changed it to
' specifically sort my Catalog array by Filename.
'
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Increment = (Upper + Lower)
L2 = Lower - 1

DO
   ' The Increment variable is used to check how far apart the
   ' program will check.  Also cut the size of increment in half
   ' to decrese Increment which makes the sorted array more
   ' accurate.

   Increment = Increment \ 2
   I2 = Increment + L2

   ' Step through the array 1 element at a time and compare the
   ' elements 'Increment' entries away.

   FOR Index = Lower TO Upper - Increment
      IF Inarray(Index).Filename > Inarray(Index + Increment).Filename THEN
         SWAP Inarray(Index), Inarray(Index + Increment)

         ' If the the current pointer for Index is greater
         ' than Increment then step back by increment - 1
         ' so that the variable can be put as close as it
         ' can get to it's final point.

         IF Index > I2 THEN

            ' Store a pointer to the curent position so
            ' that it can be restored when this entry is
            ' in it's place.  Causes it to run over 10
            ' times faster on large random arrays.  If
            ' CutPoint has a value then set a new one.

            CutPoint = Index
            StopNow = 0
            DO
               Index = Index - Increment
               IF Inarray(Index).Filename > Inarray(Index + Increment).Filename THEN

                  SWAP Inarray(Index), Inarray(Index + Increment)
                  ' Reduce the array pointer so that you can slide
                  ' the current number almost to it's finished
                  ' position.

               ELSE
                  StopNow = -1
                  Index = CutPoint
               END IF
            LOOP UNTIL StopNow

            ' Reduce the array pointer so that you can slide
            ' the current number almost to it's finished
            ' position.

         END IF
      END IF

   NEXT Index

LOOP UNTIL Increment <= 1

END SUB

SUB FindFiles

' Used in searching for a certian file

SHARED Selected, Down, Total
SHARED DescPattern$, WildCard$

FOR x = 1 TO 3
   LOCATE x, 1
   PRINT SPACE$(80);
NEXT x

LOCATE 1, 1, 1, 12, 13
PRINT "Search for Filename or Description? ";
x$ = Choice$("FDQ" + CHR$(27))

IF x$ = "q" OR x$ = CHR$(27) THEN EXIT SUB

LOCATE 1, 1

PRINT SPACE$(80)

IF x$ = "f" THEN GOTO FilenameSearch

LOCATE 1, 1
PRINT "[Description Search]"
PRINT "Search pattern: ";
x$ = DescPattern$
DescPattern$ = EditString$(DescPattern$, 60)
IF LEN(DescPattern$) = 0 THEN EXIT SUB

PRINT
PRINT "Searching..";

FOR x = Selected + 1 TO Total
   GET #1, x, Cat
   IF INSTR(RTRIM$(UCASE$(Cat.Description)), UCASE$(DescPattern$)) THEN
      'found it
      Selected = x
      Down = 5
      LOCATE , , 0
      EXIT SUB
   END IF
NEXT x

LOCATE 3, 1
PRINT SPACE$(80);
LOCATE 3, 1
PRINT "Not found.  Press a key..";
x$ = INPUT$(1)
EXIT SUB



FilenameSearch:

LOCATE 1, 1
PRINT "[Filename Search]"
PRINT "Enter filename to search for (WildCards are allowed)"
PRINT ":";

WildCard$ = EditString$(WildCard$, 12)
IF WildCard$ = "" THEN EXIT SUB
WildCard$ = UCASE$(WildCard$)

'look for it from this point

LOCATE 2, 1: PRINT SPACE$(160);
LOCATE 2, 1
PRINT "Searching for: " + WildCard$

FOR x = Selected + 1 TO Total
   GET #1, x, Cat
   Temp$ = RTRIM$(Cat.Filename)
   IF Match(Temp$, WildCard$) THEN
      'found a match
      Selected = x
      Down = 5
      EXIT SUB
   END IF
NEXT x

'didn't find any
LOCATE 2, 1
PRINT "File not found." + SPACE$(12)
PRINT "Press a key..";
x$ = INPUT$(1)

END SUB

FUNCTION GetSize& (file$)
'returns the size of a file

OPEN file$ FOR BINARY AS #2
GetSize& = LOF(2)
CLOSE #2

END FUNCTION

FUNCTION Match% (Filename$, WildCard$)

'checks to see if Filename$ matches Wildcard$

'first seperate the first part and extention in filename$
x = INSTR(Filename$, ".")

IF x THEN
   Ext$ = MID$(Filename$, x + 1)
   First$ = LEFT$(Filename$, x - 1)
ELSE
   Ext$ = "   "
   First$ = Filename$
END IF

IF LEN(First$) < 8 THEN First$ = First$ + STRING$(8 - LEN(First$), "?")
IF LEN(Ext$) < 3 THEN Ext$ = Ext$ + STRING$(3 - LEN(Ext$), "?")

'put them back together with ?'s added where there are blanks
FiName$ = First$ + "." + Ext$

'now change wildcard from (for instance) "TE*.*" to "TE??????.???"

IF INSTR(WildCard$, ".") = 0 THEN
   WildCard$ = WildCard$ + ".*"
END IF
IF RIGHT$(WildCard$, 1) = "." THEN WildCard$ = WildCard$ + "*"
IF LEFT$(WildCard$, 1) = "." THEN WildCard$ = "*" + WildCard$

Temp$ = UCASE$(WildCard$)
Temp2$ = ""
InExt = 0

'go through Temp$ (wildcard$) byte by byte, and when we come upon a *, add
'the appropriate amount of ?'s
FOR x = 1 TO LEN(Temp$)
   t$ = MID$(Temp$, x, 1)
   IF t$ <> "*" THEN 'assume that its good
      IF t$ = "." THEN
         Dot = x
         IF LEN(Temp2$) < 8 THEN Temp2$ = Temp2$ + STRING$(8 - LEN(Temp2$), "?")
      END IF
      Temp2$ = Temp2$ + t$
   ELSE
      'fill it with ?'s
      'if we're in the filename part, add 8-len(temp$) ?'s
      IF LEN(Temp2$) < 8 THEN
         Temp2$ = Temp2$ + STRING$(8 - LEN(Temp2$), "?")
      ELSE
         'otherwise add 3-len(temp$)
         Temp2$ = Temp2$ + STRING$(3 - LEN(MID$(Temp$, Dot + 1)), "?")
      END IF
      'and continue on..
   END IF
NEXT x

'trim off any extra ?'s we might've added accidentally if they put in more
'than 1 * on the same half of the period.
IF LEN(Temp2$) > 12 THEN Temp2$ = LEFT$(Temp2$, 12)

Temp$ = Temp2$: Temp2$ = ""

'now compare Temp$ (the fixed up wildcard) and Filename$
FOR x = 1 TO LEN(Temp$)

   a$ = MID$(Temp$, x, 1)
   B$ = MID$(FiName$, x, 1)
   IF a$ <> B$ THEN
      IF a$ <> "?" THEN
         'No match
         Match = 0
         EXIT FUNCTION
      END IF
   END IF

NEXT x

'found a match!
Match = -1

END FUNCTION

SUB RemoveRecords

SHARED Selected, Total

GET #1, Selected, Cat

'clear the top
FOR x = 1 TO 3
   LOCATE x, 1
   PRINT SPACE$(80);
NEXT x

LOCATE 1, 1
PRINT "[Remove " + RTRIM$(Cat.Filename) + "]  ";
PRINT "[File is ";
IF DIR$(RTRIM$(Cat.Filename)) = "" THEN
   PRINT "not ";
END IF
PRINT "on disk]";

LOCATE 3, 1
LOCATE , , 1, 12, 13
PRINT "Are you sure you want to remove this record? ";
x$ = YesNo$
LOCATE , , 0

GET #1, Selected, Cat
Temp$ = RTRIM$(Cat.Filename)

' this part is really neat!  It grabs all the records in front of the one
' you're about to delete, and it pulls them all forward.. then (heres the
' REALLY neato party) it chops the length of the file using an interrupt,
' so the record is actually physically removed from the file!!
IF x$ = "Y" THEN
   'bring all the files in front of it down 1..
   FOR I = Selected TO Total - 1
      GET #1, I + 1, Cat
      PUT #1, I, Cat
   NEXT I
   Handle = FILEATTR(1, 2)
   x = TruncateFile(Handle, LOF(1) - LEN(Cat)) 'subtract 1 record

   IF DIR$(RTRIM$(Temp$)) <> "" THEN
      LOCATE 3, 1
      LOCATE , , 1, 12, 13
      PRINT SPACE$(80);
      LOCATE 3, 1
      PRINT "Delete file too? ";
      x$ = YesNo$
      LOCATE , , 0
      IF x$ = "Y" THEN
         KILL RTRIM$(Temp$)
      END IF
   END IF

END IF

END SUB

SUB ScanForNew
'Scans for new files in the directory that aren't in the database

SHARED Total

'clear the top
LOCATE 1, 1
PRINT SPACE$(240);

LOCATE 1, 1, 1, 12, 13
PRINT "[Scanning for new files]"

'get a list of all the files on record
FileList$ = AllFiles$

'get each file
x$ = DIR$("*.*")
DO WHILE LEN(x$)
   TempFile$ = UCASE$(LEFT$(x$, LEN(x$) - 1))
   'search the database for it
   x = INSTR(FileList$, "+" + TempFile$ + "+")
   IF x = 0 AND TempFile$ <> UCASE$(RTRIM$(Filename$)) THEN 'new file

      'found one!
      LOCATE 2, 1
      PRINT "Found file: " + TempFile$
      PRINT "Add to database? ";
      DO
         x$ = UCASE$(INKEY$)
         IF LEN(x$) THEN
            IF INSTR("YN" + CHR$(27), x$) THEN EXIT DO
         END IF
      LOOP
      IF x$ = CHR$(27) THEN LOCATE , , 0: EXIT SUB
      PRINT x$
      x$ = UCASE$(x$)
      IF x$ = "Y" THEN
         LOCATE 3, 1
         PRINT "Description: [" + SPACE$(60) + "]";
         LOCATE , 15
         De$ = EditString$("", 60)
         Cat.Description = De$ + SPACE$(60)  'fill the rest with spaces
         'get the size
         Cat.FileSize = GetSize&(TempFile$)
         Cat.Filename = TempFile$ + SPACE$(12)
         'save the record
         Total = Total + 1
         PUT #1, Total, Cat
      ELSE
         LOCATE 3, 1
         PRINT SPACE$(80);
         LOCATE 3, 1
         PRINT "Do you want me to delete it? ";
         x$ = YesNo$
         IF x$ = "Y" THEN
            KILL TempFile$
         END IF
      END IF
      'clear the top
      FOR x = 1 TO 3
         LOCATE x, 1
         PRINT SPACE$(80);
      NEXT x
      LOCATE 1, 1
      PRINT "[Scanning for new files]"
   END IF

   x$ = DIR$("")

LOOP

END SUB

SUB Scroll (Direction%, Top%, Left%, Bottom%, Right%, Lines%, Attr%)

DIM Reg AS RegType  'need $include qb.bi
Top% = Top% - 1
Left% = Left% - 1
Bottom% = Bottom% - 1
Right% = Right% - 1
Reg.ax = Direction% + Lines%     'zero lines will clear viewport
Reg.bx = Attr% * 256             'attribute for blank area
Reg.cx = Top% * 256 + Left%      'Top Left Coords
Reg.dx = Bottom% * 256 + Right%  'Bottom Right Coords
INTERRUPT &H10, Reg, Reg

END SUB

SUB ScrollDN

Scroll sDOWN, 5, 1, 24, 80, 1, 0

END SUB

SUB ScrollUP

Scroll sUP, 5, 1, 24, 80, 1, 0

END SUB

SUB Sort

LOCATE 1, 1: PRINT SPACE$(240);

LOCATE 1, 1
PRINT "[Sorting Records]"

x = LOF(1) \ LEN(Cat)

DIM Temp(1 TO x) AS CatalogType

PRINT "Reading...";

FOR I = 1 TO x

   GET #1, I, Temp(I)

NEXT I

PRINT "Sorting...";

FastSortI Temp(), 1, x

PRINT "Writing...";

FOR I = 1 TO x

   PUT #1, I, Temp(I)

NEXT I

ERASE Temp

END SUB

FUNCTION TruncateFile% (Handle%, NewLength&)
'Edits the length of a file

'Handle% = FILEATTR(1, 2)  'filenumber, 2

DIM Reg AS RegTypeX

'First, position the file read/write pointer to the place where the
'truncation should take place. We can't trust BASIC's SEEK statement
'because the movement is sometimes held until the next read/write.

Reg.ax = &H4200             'DOS "Set file pointer" function
Reg.bx = Handle%

'We go through these steps to prevent "overflow" errors when
'NewLength& > 32767. The high word of the file position goes in CX
'and the low word goes in DX. Since BASIC treats integers and longs
'"signed" variables, we need to take to extra steps to prevent
'an overflow error as we break the long integer down.

DEF SEG
Addr% = VARPTR(NewLength&)
Reg.cx = CVI(CHR$(PEEK(Addr% + 2)) + CHR$(PEEK(Addr% + 3)))
Reg.dx = CVI(CHR$(PEEK(Addr%)) + CHR$(PEEK(Addr% + 1)))
CALL INTERRUPTX(&H21, Reg, Reg)
IF Reg.flags AND 1 THEN
   Status% = Reg.ax
   GOTO TruncateExit
END IF

'Now, write 0 bytes.
Reg.ax = &H4000                 'Dos "Write file or device"
Reg.bx = Handle%
Reg.cx = 0                      'Write 0 bytes
Reg.dx = 0                      'These are not needed, but make
Reg.ds = 0                      ' sure they're zero, just in case
CALL INTERRUPTX(&H21, Reg, Reg)
IF Reg.flags AND 1 THEN
   Status% = Reg.ax
END IF

TruncateExit:
TruncateFile% = Status%

END FUNCTION

SUB UpdateRecords
'Goes through all the records and makes sure their sizes are correct and that
'the file is still there.

SHARED Total

Removed = 0

LOCATE 1, 1: PRINT SPACE$(240);
LOCATE 1, 1

PRINT "[Update Records]"
PRINT "Scanning: ";

FOR x = 1 TO Total

   LOCATE 2, 11
   GET #1, x, Cat
   PRINT Cat.Filename + SPACE$(2);
   x$ = DIR$(RTRIM$(Cat.Filename))
   IF LEN(x$) = 0 THEN
      PRINT " [File not on disk] ";
      LOCATE , , 1, 12, 13
      d = CSRLIN: a = POS(0)
      LOCATE 3, 1
      PRINT "Description: "; Cat.Description
      LOCATE d, a
      PRINT "Remove? ";
      x$ = YesNo$
      IF x$ = "Y" THEN  'remove this record
         FOR x2 = x + 1 TO Total
            GET #1, x2, Cat
            PUT #1, x2 - 1, Cat
         NEXT x2
         Removed = Removed + 1
      END IF
      LOCATE , , 0
      LOCATE 3, 1: PRINT SPACE$(80);
      GOTO SkipToEnd
   END IF
   PRINT "Size: ";
   x2& = GetSize&(RTRIM$(Cat.Filename))
   PRINT x2&;
   PRINT SPACE$(6 - LEN(STR$(x2&)));
   Cat.FileSize = x2&
   PUT #1, x, Cat

SkipToEnd:

NEXT x

Handle = FILEATTR(1, 2)
x = TruncateFile(Handle, LOF(1) - (Removed * LEN(Cat))) 'erase removed
'records
Total = Total - Removed

END SUB

FUNCTION YesNo$

DO
   x$ = UCASE$(INKEY$)
   IF LEN(x$) THEN IF INSTR("YN", x$) THEN YesNo$ = x$: EXIT FUNCTION
LOOP

END FUNCTION
