Category : BASIC Source Code
Archive   : QB_CODE.ZIP
Filename : TESTBIN.BAS
DECLARE FUNCTION NIL% ()
DECLARE SUB INITIALIZE (Root.Item$, Nodes%, Bin.Tree$(),_
LPtr%(), RPtr%())
DECLARE SUB INSERT (Info$, Nodes%, Bin.Tree$(), LPtr%(), RPtr%())
DECLARE SUB GET.SORTED.LIST (Nodes%, Bin.Tree$(), LPtr%(),_
RPtr%(), Tree.Ptr%())
DECLARE SUB Center.Message (Msg$, Line.Num%)
DECLARE SUB Blank.Lines (M%)
DECLARE FUNCTION YesNo$ (Msg$)
' Program that uses library BINTree.BAS to sort a text file
' for QuickBASIC version 4.0
' Copyright (c) 1988 Namir Clement Shammas
'
' Modules Required:
' BINTree.BAS
' TOOLBOX0.BAS
OPTION BASE 1
REM $DYNAMIC
DIM Tree.Ptr%(10), Bin.Tree$(10)
DIM LPtr%(10), RPtr%(10)
DO
CLS
CALL Center.Message("TEXTFILE SORTING UTILITY", 1)
CALL Center.Message("------------------------", 2)
CALL Blank.Lines(3)
' Obtain input file
DO
ON ERROR GOTO Handle.Input
INPUT "Enter input text filename "; F$
OPEN "I", 1, F$
EXIT DO
Handle.Input:
' Error handler
PRINT "Error: Cannot access file "; F$
INPUT "Enter input text filename "; F$: PRINT
RESUME
LOOP
ON ERROR GOTO 0 ' disable error handling
PRINT "Reading and sorting ..."
PRINT : PRINT
' Count text lines in the file
NData% = 0
DO UNTIL EOF(1)
LINE INPUT #1, L$
NData% = NData% + 1
LOOP
CLOSE #1
' Calculate the size of the smallest "complete" tree
Log.Tree! = LOG(NData%) / LOG(2)
IF (Log.Tree! - INT(Log.Tree!)) > 1E-08 THEN Offset% = 1_
ELSE Offset% = 0
Tree.Size% = 2 ^ (Offset% + INT(Log.Tree!)) - 1
' redimension arrays
ERASE Tree.Ptr%, Bin.Tree$, LPtr%, RPtr%
DIM Tree.Ptr%(Tree.Size%), Bin.Tree$(Tree.Size%)
DIM LPtr%(Tree.Size%), RPtr%(Tree.Size%)
OPEN "I", 1, F$
LINE INPUT #1, Text.Line$
' Initialize the binary tree with the firt text line
CALL INITIALIZE(Text.Line$,Nodes%,Bin.Tree$(),LPtr%(),RPtr%())
FOR I% = 2 TO NData%
LINE INPUT #1, Text.Line$
CALL INSERT(Text.Line$,Nodes%,Bin.Tree$(),LPtr%(),RPtr%())
NEXT I%
CLOSE #1
' Obtain pointers for the sorted tree
CALL GET.SORTED.LIST(Nodes%, Bin.Tree$(), LPtr%(), _
RPtr%(), Tree.Ptr%())
' Obtain output file
DO
ON ERROR GOTO Handle.Output
INPUT "Enter output text filename "; F$
OPEN "O", 1, F$
EXIT DO
Handle.Output:
' Error handler
PRINT "Error: Cannot open file "; F$
INPUT "Enter output text filename "; F$: PRINT
RESUME
LOOP
ON ERROR GOTO 0 ' disable error handling
' Loop to write sorted text file
FOR I% = 1 TO Tree.Size%
IF Tree.Ptr%(I%) <> NIL% THEN_
PRINT #1, Bin.Tree$(Tree.Ptr%(I%))
NEXT I%
CLOSE #1
PRINT "text saved in file "; F$
CALL Blank.Lines(4)
OK$ = YesNo$("Sort another file")
LOOP UNTIL OK$ = "N"
END
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/