Category : Communication (modem) tools and utilities
Archive   : PCPSRTNO.ZIP
Filename : PCPSRTNO.BAS

' PCPSRTNO.BAS for QuickBASIC 4.0 PROCOMM+ Directory Sort by Number V1.0
' by Ed Galle, 02/11/88 mods by JIR 4/9/88 for sort by number
'----------------------------------------------------------------------------

'Subroutine Declarations
DECLARE FUNCTION DirFile$ ()
DECLARE SUB SortDirEntries (Astart AS INTEGER, Aend AS INTEGER)

OPTION BASE 1 'first array subscript is 1, not 0

'Structure of PROCOMM+ Dialing Directory Entry, total 74 bytes:
' 24-char name + 0, followed by 20-char number + 0, then other stuff
' When erased, these fields are 20h (space) chars.

TYPE DirRecord
DirName AS STRING * 25
Number AS STRING * 21
Junk AS STRING * 28 ' Junk is never referred to again
END TYPE

DIM DFile AS STRING ' Command line (.DIR path & name)
DIM K AS STRING * 1 ' Y/N keystroke
DIM Header AS STRING * 250 ' 250-byte header common to all .DIR files
DIM I AS INTEGER ' Array Index
DIM SHARED DirEntry(200) AS DirRecord '200 Entries in a .DIR file

ON ERROR GOTO ErrorHandle 'File error handler

Restart: 'error restart point
DFile = DirFile$ 'Get .DIR file name from command line
IF (DFile <> "") THEN GOTO Main 'There is a command line, sort the .DIR

CLS
COLOR 0, 7 '70h is attrib for reverse video
PRINT
PRINT "ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß"
PRINT " PROCOMM+ Dialing Directory Sort by Number "
PRINT "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
PRINT " Hit ENTER to sort PCPLUS.DIR "
PRINT " "
PRINT " Hit SPACE to enter another .DIR name "
PRINT " "
PRINT " Run PCPSRTNO [d:][path\]directoryname.DIR "
PRINT " to avoid this screen "
PRINT "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"; ""
PRINT " Hit ESC to exit "
PRINT "ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ"
COLOR 7, 0 'normal video for manual entry

AwaitInput:
DO 'wait for key press
ZZ$ = INKEY$
LOOP WHILE ZZ$ = ""

'a key has been hit, see if it's ESC or ENTER
SELECT CASE ZZ$
CASE CHR$(27)
END

CASE CHR$(13)
DFile = "PCPLUS.DIR" ' default Directory name
GOTO Main

CASE ELSE
'****nfg LEFT$(DFile, 1) = ZZ$

END SELECT

PRINT
INPUT "Enter [d:][path\]dirname.DIR: ", DFile

'Main code:
Main:
'Open files in binary mode:
OPEN DFile FOR BINARY ACCESS READ AS #1 'Input file
OPEN "TEMP$$$$.$$$" FOR BINARY AS #2 'Workfile

COLOR 0, 7 'inverse video
PRINT
PRINT " Sorting "; DFile; " ........ ";

'Transfer header
GET #1, , Header
PUT #2, , Header

'Read directory entries into array, marking blank records
' so that they end up at bottom of sorted list
FOR I = 1 TO 200
GET #1, , DirEntry(I)
'check name field for blank
IF (LEFT$(DirEntry(I).DirName, 1) = " ") THEN
'returns 1 leftmost char in string
'but must mark Number field with highest possible character
MID$(DirEntry(I).Number, 1, 1) = CHR$(255)
'ALSO returns 1 1st char - why diffo ??
END IF
NEXT

'Delete any existing .OLD file with the same name
ON ERROR GOTO NoSweat
KILL (LEFT$(DFile, INSTR(DFile, ".") - 1) + ".OLD")
NoSweat:
ON ERROR GOTO ErrorHandle

'Close the old file and rename it .OLD, don't need it anymore:
CLOSE #1
NAME DFile AS LEFT$(DFile, INSTR(DFile, ".") - 1) + ".OLD"

'This subroutine sorts the directory using Quicksort:
SortDirEntries 1, 200 ' 1 & 200 are Astart & Aend

'Write sorted table to workfile, unmarking blank records as we go:
FOR I = 1 TO 200
IF (LEFT$(DirEntry(I).Number, 1) = CHR$(255)) THEN
MID$(DirEntry(I).Number, 1, 1) = " "
END IF
PUT #2, , DirEntry(I)
NEXT

'Close workfile and rename it as original input file:
CLOSE #2
NAME "TEMP$$$$.$$$" AS DFile
PRINT " Done. "
COLOR 7, 0 'normal video
END 'All done

'Error handler code:
ErrorHandle:
COLOR 7, 0 'normal video for error messages
PRINT
PRINT
SELECT CASE ERR

CASE 52, 64:
PRINT "Phooey - Invalid file name"
GOTO AwaitInput

CASE 71, 70, 61:
PRINT "Drive not ready or Disk write protected or full"
GOTO UserOptions

CASE 53, 76:
PRINT "Nuts - File or path not found"
GOTO AwaitInput

CASE 57:
PRINT "Device I/O Error (the drive can't read/write this disk)"
GOTO UserOptions

CASE ELSE: ' Unforeseen error
' Disable error trapping and print standard system message
ON ERROR GOTO 0
END SELECT

UserOptions:
PRINT "A)bort, R)etry, I)gnore ?"
DO
Char$ = UCASE$(INPUT$(1))
IF Char$ = "I" THEN
RESUME ' Resume where you left off

ELSEIF Char$ = "R" THEN
GOTO Restart ' Resume at beginning

ELSEIF Char$ = "A" THEN
CLOSE
ON ERROR GOTO HellWithIt
KILL "TEMP$$$$.$$$"
HellWithIt:
END
END IF
LOOP

FUNCTION DirFile$
'get the Dialing Directory filename from command line:

DIM C AS STRING, Lc AS INTEGER, I AS INTEGER, M AS STRING * 1

C = COMMAND$
Lc = LEN(C)

IF (Lc) THEN
FOR I = 1 TO Lc
M = MID$(C, I, 1)
IF ((M = " ") OR (M = CHR$(9))) THEN EXIT FOR
NEXT
DirFile$ = LEFT$(C, I - 1)
END IF

END FUNCTION

SUB SortDirEntries (Astart AS INTEGER, Aend AS INTEGER)
'Quicksort the directory entries, called only once as SortDirEntries 1, 200

DIM Pivot AS STRING * 21 'length of sorted field
DIM Low AS INTEGER, High AS INTEGER

Low = Astart ' = 1
High = Aend ' = 200
Pivot = DirEntry((High + Low) \ 2).Number 'mean of highest & lowest vals

DO WHILE (Low <= High)
DO WHILE (DirEntry(Low).Number < Pivot)
Low = Low + 1
LOOP
' now Low points to the entry just >= the mean
DO WHILE (DirEntry(High).Number > Pivot)
High = High - 1
LOOP
' now High points to the entry just <= the mean
IF (Low < High) THEN
SWAP DirEntry(Low), DirEntry(High)
Low = Low + 1
High = High - 1
ELSEIF (Low = High) THEN
Low = Low + 1
END IF
LOOP
IF (Astart < High) THEN SortDirEntries Astart, High
IF (Low < Aend) THEN SortDirEntries Low, Aend

END SUB