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

 
Output of file : PCPLUSRT.BAS contained in archive : PCPLUSRT.ZIP
'QuickBASIC 4.0 SOURCE FILE: PCPLUSRT.BAS
'----------------------------------------------------------------------------
' PROCOMM+ Directory Sort Utility V1.0
' (c) 1988 Software Associates of Houston, Texas
' Written by: Ed Galle, 02/11/88
'----------------------------------------------------------------------------

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

OPTION BASE 1 'Let's use one as first array element

'Structure of PROCOMM+ Dialing Directory Entry:
TYPE DirRecord
DirName AS STRING * 25
Junk AS STRING * 49
END TYPE

DIM DFile AS STRING ' Directory file 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

'200 Entries in a .DIR file
DIM SHARED DirEntry(200) AS DirRecord

'Intro...
CLS
PRINT "PCPLUSRT - PROCOMM+ Dialing Directory Sort Utility"
PRINT "(c) 1988 Software Associates"
PRINT "This program will sort your PROCOMM+ Dialing Directory"
PRINT

'Get .DIR file name from command line...
DFile = DirFile

'Double-check user input...
PRINT "Directory chosen: "; DFile
PRINT
PRINT "Do you want to sort this directory (Y/N)?"
DO
K = UCASE$(INKEY$)
LOOP WHILE ((K <> "Y") AND (K <> "N"))

'File error handler...(not much!)
ON ERROR GOTO Errorhandle

'Main code:
IF (K = "Y") THEN 'Sort the file

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

'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)
IF (LEFT$(DirEntry(I).DirName, 1) = " ") THEN
MID$(DirEntry(I).DirName, 1, 1) = CHR$(255)
END IF
NEXT

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

'Now sort the directories using Quicksort:
SortDirEntries 1, 200

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

'Close workfile and rename it as original input file:
CLOSE #2
NAME "TEMP$$$$.$$$" AS DFile

'All done
PRINT
PRINT "Sort complete!"
END
ELSE 'User aborted
PRINT "Sort aborted..."
END
END IF

'Error handler code:
Errorhandle:
PRINT "File error occured...aborting"
CLOSE
KILL "TEMP$$$$.$$$"
END

'Function to get the directory filename from command line:

'Quicksort the directory entries:

FUNCTION DirFile$

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)
ELSE
PRINT
PRINT "Usage: PCPLUSRT "
PRINT
PRINT " = PROCOMM+ directory file name"
END
END IF

END FUNCTION

SUB SortDirEntries (Astart AS INTEGER, Aend AS INTEGER)

DIM Pivot AS STRING * 25
DIM Low AS INTEGER, High AS INTEGER

Low = Astart
High = Aend
Pivot = DirEntry((High + Low) \ 2).DirName

DO WHILE (Low <= High)
DO WHILE (DirEntry(Low).DirName < Pivot)
Low = Low + 1
LOOP
DO WHILE (DirEntry(High).DirName > Pivot)
High = High - 1
LOOP
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



  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : PCPLUSRT.ZIP
Filename : PCPLUSRT.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/