Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/FMSFMT10.ZIP/FMSFMT.BAS

BASIC Source File | 1993-12-29 | 28.5 KB | 1,047 lines

DECLARE SUB Trim (TrimParm$)
DECLARE SUB SQOutBlanks (Strng$)
DECLARE SUB SubZero (Work$)
DECLARE SUB NameSizeDateDesc (InStrng$, IsOK%)
DECLARE SUB TrimTrail (TrimParm$, TrimThis$)
DECLARE SUB RemoveBlanks (Strng$)
DECLARE SUB IncludeParse (IncludeThis$, ParseThis$, Words$(), NumFound%)
' to do: support chaining
'        support chained target
DEFINT A-Z
COMMON SHARED StartNameAt, StartDateAt, StartSizeAt, StartDescAt, OutTemplate$, GotName, GotSize, GotDate, GotDesc, StartIsFMS, DIZUsed
DECLARE FUNCTION NameKey$ (X$)
DECLARE FUNCTION ParmValue$ (Rec$, ParmKey$, Default$)
DECLARE FUNCTION DateKey$ (X$)

DIM TargetHold$(23), MergeHold$(23)
ON ERROR GOTO 0
PRINT "FMSFMT ver 1.0 12-29-93  An RBBS Utility to Reformat/Merge Directories"
PRINT "Copyright (c) 1993 by Ken Goosens"
PRINT
FALSE = 0
TRUE = NOT FALSE
InvalidFileChars$ = "/\[]:|<>+=;,*?" + CHR$(34)
NumInvalid = 0
NewRow = 15
StartDir$ = "CDMASTER.DIR"
MergeTo$ = ""
NewDir$ = "MASTER.DIR"
AddCat$ = ""
SearchCats$ = ","
ReplaceCats$ = ","
NumSubs = 0
NumBad = 0
HoldCat$ = "   "
StartNameAt = 1
StartDateAt = 24
StartSizeAt = 15
StartDescAt = 34
ConvertFields = FALSE
CombineExtended = FALSE
TruncateDesc = TRUE
TargetSortedByDate = TRUE
LineFeed$ = CHR$(10)
CarriageReturn$ = CHR$(13)
EndofWord$ = " " + LineFeed$ + CarriageReturn$
WorkCmnd$ = COMMAND$ + " "
IF LEN(WorkCmnd$) > 1 THEN
   ConfigFile$ = LEFT$(WorkCmnd$, INSTR(WorkCmnd$, " ") - 1)
   CALL Trim(ConfigFile$)
END IF
IF ConfigFile$ = "" OR LEFT$(ConfigFile$, 1) = "/" THEN
   ConfigFile$ = "FMSFMT.CFG"
END IF
WorkIn$ = WorkCmnd$
GOSUB ParseCmnd

   ON ERROR GOTO 40200
   IF Sharing THEN
      OPEN ConfigFile$ FOR INPUT SHARED AS #4
   ELSE
      OPEN ConfigFile$ FOR INPUT AS #4
   END IF
   ON ERROR GOTO 0
   'ON ERROR GOTO 50000

RunAgain:  ' entry point when making multiple runs from config

IsOK = TRUE
GOSUB ReadConfig
IF NewLen > 0 AND NewLen < 76 THEN
   PRINT "/NewLen= in config must set at least 76 chars, not"; NewLen
   GOTO 50100
END IF
IF Title$ <> "" THEN
   PRINT Title$
END IF
'ON ERROR GOTO 40000
KeyLen = 13 + TargetSortedByDate * 7
HighValues$ = STRING$(KeyLen, 255)
LowValues$ = STRING$(KeyLen, 0)
KeyFrom$ = LowValues$
ON ERROR GOTO 40000
IF Sharing THEN
   OPEN StartDir$ FOR INPUT SHARED AS #1
ELSE
   OPEN StartDir$ FOR INPUT AS #1
END IF
ON ERROR GOTO 50000
IF MergeTo$ <> "" THEN KeyTo$ = LowValues$
GOSUB OpenTarget

ON ERROR GOTO 50050
OPEN NewDir$ FOR OUTPUT AS #3
ON ERROR GOTO 0
IF INSTR(ToHeader$, " NOSORT ") > 0 THEN TargetSortedByDate = FALSE
OutLen = LEN(ToRec$)
IF OutLen < 76 AND OutLen > 0 THEN
   PRINT "Target file "; MergeTo$; " NOT an FMS file"
   PRINT "First line must be at least 76 chars long, not"; OutLen
   GOTO 50100
END IF
IF NewLen > 75 THEN
   OutLen = NewLen
END IF
AddingCat = (AddCat$ <> "")
AddingDate = (AddDate$ <> "")
AddingDesc = (AddDesc$ <> "")
OutTemplate$ = SPACE$(OutLen)
StartCatCode = OutLen - 2
DoubleHV$ = STRING$(2,255)
IF KeyTo$ <> HighValues$ AND MergeTo$ <> "" THEN
   KeyTo$ = LowValues$
END IF
IF StartNameAt <> 1 OR StartDate <> 24 OR StartSizeAt <> 15 OR StartDescAt <> 35 THEN
      ConvertFields = TRUE
END IF
PRINT "Convert fields.. ";
IF ConvertFields THEN
   PRINT "Yes"
ELSE
   PRINT "No"
END IF
PRINT "Name begins col "; StartNameAt
PRINT "Size begins col "; StartSizeAt
PRINT "Date begins col "; StartDateAt
PRINT "Desc begins col "; StartDescAt
PRINT "Start dir format ";
IF StartIsFMS THEN
   PRINT "FMS"
ELSE
   PRINT "Non-FMS"
END IF
PRINT "Extended descriptions in start ";
IF NoExtended THEN
   PRINT "<none>"
ELSE
   IF ExtendedBeforeName THEN
      PRINT "Before name"
   ELSE
      PRINT "After name"
   END IF
END IF
PRINT "Use DIZ for desc ";
IF StartUseDIZ THEN
   PRINT "Yes"
ELSE
   PRINT "No"
END IF
PRINT "Adding cat code. ";
IF AddingCat THEN
   PRINT AddCat$
ELSE
   PRINT "<none>"
END IF
PRINT "Adding date .... ";
IF AddingDate THEN
   PRINT AddDate$
ELSE
   PRINT "<none>"
END IF
PRINT "Adding desc .... ";
IF AddingDesc THEN
   PRINT AddDesc$
ELSE
   PRINT "<none>"
END IF
PRINT "Sub cat codes... ";
IF LEN(ReplaceCats$) > 1 THEN
   PRINT "Yes"
  'print SearchCats$
  'print Replacecats$
  'end
ELSE
   PRINT "No"
END IF
PRINT "Files sorted by. ";
IF TargetSortedByDate THEN
   PRINT "Date"
ELSE
   PRINT "Name"
END IF
PRINT "Combine Extended ";
IF CombineExtended THEN
   PRINT "Yes"
ELSE
   PRINT "No"
END IF
PRINT "Starting dir.... "; StartDir$; "  ";
MergeCol = POS(0)
MaxCol = MergeCol
PRINT
PRINT "Merging into.... ";
IF MergeTo$ = "" THEN
   PRINT "<none>";
ELSE
   PRINT MergeTo$; "  ";
END IF
TargetCol = POS(0)
IF TargetCol > MaxCol THEN MaxCol = TargetCol
PRINT
PRINT "New dir......... "; NewDir$; "  ";
NewCol = POS(0)
PRINT
PRINT "Length new dir.."; OutLen
PRINT "Header.......... ";
IF Header$ = "" THEN
   PRINT "<none>"
ELSE
   PRINT Header$
END IF
PRINT : PRINT "A to abort, anything else runs";
IF RunBatch THEN
   PRINT " (run batch)"
ELSE
   INPUT ""; ANS$
   ANS$ = UCASE$(ANS$)
   IF ANS$ = "A" THEN END
END IF

IF NewCol > MaxCol THEN MaxCol = NewCol
MergeCol = MaxCol
TargetCol = MaxCol
NewCol = MaxCol
SubCol = MaxCol - 1
NewRow = CSRLIN - 4
TargetRow = NewRow - 1
MergeRow = TargetRow - 1
SubRow = MergeRow - 1
AddingCat = (AddCat$ <> "")
GotName = (StartNameAt > 0)
GotSize = (StartSizeAt > 0)
GotDate = (StartDateAt > 0)
GotDesc = (StartDescAt > 0)
GOSUB ReadMerge
IF KeyTo$ < HighValues$ THEN
   GOSUB ReadTarget
END IF
IF Header$ <> "" THEN
   LSET OutTemplate$ = SPACE$(OutLen)
   LSET OutTemplate$ = Header$
   MID$(OutTemplate$, StartCatCode) = "  ."
   GOSUB OutPutNew
END IF

WHILE KeyTo$ < HighValues$ OR KeyFrom$ < HighValues$

   WHILE KeyTo$ < KeyFrom$
      GOSUB OutPutTarget
      GOSUB ReadTarget
   WEND
   WHILE KeyFrom$ < KeyTo$
      GOSUB OutPutMerge
      GOSUB ReadMerge
   WEND
   WHILE KeyTo$ = KeyFrom$ AND KeyFrom$ <> HighValues$
      GOSUB OutPutMerge
      GOSUB ReadMerge
   WEND

WEND
GOSUB PositionDown
IF NumInvalid > 0 THEN
   PRINT NumInvalid; " lines excluded because of invalid chars in names"
END IF
IF NumBad > 0 THEN
   PRINT NumBad; " lines excluded because of invalid file size/extensions"
END IF
NumInvalid = 0
NumBad = 0
CLOSE 1,2,3
IF NOT EOF(4) THEN GOTO RunAgain  ' more runs in config?
CLOSE 4
END

'-------------------  GOSUBS --------------------

ParseCmnd:

   IF LEFT$(WorkCmnd$, 2) = "H " THEN
      GOSUB HelpScreen
   END IF
   X = INSTR(WorkCmnd$, "/BATCH")
   RunBatch = (X > 0) OR RunBatch
   X = INSTR(WorkCmnd$,"/TITLE=")
   IF X > 0 THEN
      Title$ = Title$ + RIGHT$(WorkIn$, LEN(WorkIn$) - 7) + CHR$(13)
   END IF
   X = INSTR(WorkCmnd$,"/HEADER=")
   IF X > 0 THEN
      Header$ = RIGHT$(WorkCmnd$, LEN(WorkCmnd$) - 8)
      CALL Trim (Header$)
   END IF
   X = INSTR (WorkCmnd$,"/ADDDESC=")
   IF X > 0 THEN
     AddDesc$ = RIGHT$(WorkIn$, LEN(WorkIn$) - 9)
     CALL Trim (AddDesc$)
   END IF
   CALL SQOutBlanks(WorkCmnd$)
   X = INSTR(WorkCmnd$,"/SHARING")
   Sharing = (X > 0 OR Sharing)
   StartDir$ = ParmValue$(WorkCmnd$, "/STARTDIR=", StartDir$)
   StartIsFMS = StartIsFMS OR (INSTR(WorkCmnd$, "/STARTISFMS") > 0)
   ConvertFields = ConvertFields OR (INSTR(WorkCmnd$, "/CONVERTFIELDS") > 0)
   CombineExtended = CombineExtended OR (INSTR(WorkCmnd$, "/COMBINEEXTENDED") > 0)
   TruncateDesc = TruncateDesc OR (INSTR(WorkCmnd$, "/TRUNCATEDESC") > 0)
   ExtendedBeforeName = ExtendedBeforeName OR (INSTR(WorkCmnd$,"/EXTENDEDBEFORENAME") > 0)
   IF INSTR(WorkCmnd$,"/EXTENDEDAFTERNAME") > 0 THEN ExtendedBeforeName = FALSE
   IF INSTR(WorkCmnd$,"/TARGETSORTEDBYDATE") > 0 THEN TargetSortedByDate = TRUE
   IF INSTR(WorkCmnd$,"/TARGETSORTEDBYNAME") > 0 THEN TargetSortedByDate = FALSE
   IF INSTR(WorkCmnd$,"/STARTUSEDIZ") > 0 THEN StartUseDIZ = TRUE
   IF INSTR(WorkCmnd$,"/TARGETUSEDIZ") > 0 THEN TargetUseDIZ = TRUE

   IF INSTR(WorkCmnd$,"/NOEXTENDED") > 0 THEN NoExtended = TRUE
   StartNameAt = VAL(ParmValue$(WorkCmnd$, "/STARTNAMEAT=", STR$(StartNameAt)))
   StartDateAt = VAL(ParmValue$(WorkCmnd$, "/STARTDATEAT=", STR$(StartDateAt)))
   StartSizeAt = VAL(ParmValue$(WorkCmnd$, "/STARTSIZEAT=", STR$(StartSizeAt)))
   StartDescAt = VAL(ParmValue$(WorkCmnd$, "/STARTDESCAT=", STR$(StartDescAt)))
   NewLen = VAL(ParmValue$(WorkCmnd$, "/NEWLEN=", STR$(NewLen)))
   MergeTo$ = ParmValue$(WorkCmnd$, "/MERGETO=", MergeTo$)
   NewDir$ = ParmValue$(WorkCmnd$, "/NEWDIR=", NewDir$)
   AddCat$ = ParmValue$(WorkCmnd$, "/ADDCAT=", AddCat$)
   AddDate$ = ParmValue$(WorkCmnd$, "/ADDDATE=", AddDate$)
   IF AddDate$ = "TODAY" THEN
      X$ = DATE$
      AddDate$ = LEFT$(X$, 6) + RIGHT$(X$, 2)
   END IF
   X$ = ParmValue$(WorkCmnd$, "/REPLACECAT=", "/")
   IF X$ <> "/" THEN
      IF LEN(X$) >= 6 THEN
         SearchCats$ = SearchCats$ + LEFT$(X$, 3) + ","
         ReplaceCats$ = ReplaceCats$ + RIGHT$(X$, 3) + ","
      ELSE
         DO WHILE LEFT$(X$, 3) <> "END" AND NOT EOF(4)
            LINE INPUT #4, X$
            NumCnfg = NumCnfg + 1
            LOCATE CnfgRow, CnfgCol
            PRINT NumCnfg;

            IF LEN(X$) >= 6 THEN
               SearchCats$ = SearchCats$ + LEFT$(X$, 3) + ","
               ReplaceCats$ = ReplaceCats$ + RIGHT$(X$, 3) + ","
            END IF
         LOOP
      END IF
   END IF

RETURN

HelpScreen:

RETURN

ReadConfig:

   PRINT "Config file..... "; ConfigFile$; " ";
   CnfgCol = POS(0)
   CnfgRow = CSRLIN
   NumCnfg = 0
   WorkCmnd$ = ""
   WHILE NOT EOF(4) AND LEFT$(WorkCmnd$,4) <> "/RUN"
      NumCnfg = NumCnfg + 1
      LOCATE CnfgRow, CnfgCol
      PRINT NumCnfg;
      LINE INPUT #4,WorkCmnd$
      IF LEFT$(WorkCmnd$, 1) <> "*" AND WorkCmnd$ <> "" THEN
         WorkIn$ = WorkCmnd$
         WorkCmnd$ = UCASE$(WorkCmnd$) + " "
         GOSUB ParseCmnd
      END IF
   WEND
ExitConfig:
   PRINT
RETURN

OpenTarget:

   IF MergeTo$ = "" THEN
      KeyTo$ = STRING$(KeyLen, 255)
      RETURN
   END IF
   ON ERROR GOTO 40100
   CLOSE 2
   IF Sharing THEN
      OPEN MergeTo$ FOR INPUT SHARED AS #2
   ELSE
      OPEN MergeTo$ FOR INPUT AS #2
   END IF
   ON ERROR GOTO 50000
   IF NOT EOF(2) THEN
      LINE INPUT #2, ToRec$
      ToHeader$ = ToRec$
      IF LEFT$(ToHeader$, 4) <> "\FMS" THEN
         ToHeader$ = ""
      END IF
   ELSE
      KeyTo$ = HighValues$
   END IF
   Temp = INSTR(ToHeader$, " CH(")
   IF Temp > 0 THEN
      EndPos = INSTR(Temp, ToHeader$, ")")
      IF EndPos > 0 THEN
         ChainTo$ = MID$(ToHeader$, Temp + 4, EndPos - Temp - 4)
      END IF
      ChainTo$ = "" 'temporary override to inactivate feature
   ELSE
      ChainTo$ = ""
   END IF
   TargetSortedByDate = (INSTR(ToHeader$, " NOSORT") = 0)
   'ON ERROR GOTO 40100
   CLOSE 2
   ON ERROR GOTO 40100
   IF Sharing THEN
      OPEN MergeTo$ FOR INPUT SHARED AS #2
   ELSE
      OPEN MergeTo$ FOR INPUT AS #2
   END IF
   ON ERROR GOTO 0

RETURN

ReadMerge:

   NewItem = FALSE
   DO
      IF EOF(1) AND FromHold$ = "" THEN
         KeyFrom$ = HighValues$
         NewItem = TRUE
         CLOSE 1
      ELSE
         IF FromHold$ <> "" THEN
            FromRec$ = FromHold$
            FromHold$ = ""
         ELSE
            LINE INPUT #1, FromRec$
         END IF
         X = INSTR(FromRec$, "Directory of ")
         IF X > 0 THEN
            FileLoc$ = MID$(FromRec$,X+12)
            CALL Trim (FileLoc$)
            X = INSTR(FileLoc$," ")
            IF X > 0 THEN
               FileLoc$ = LEFT$(FileLoc$,X-1)
            END IF
            IF RIGHT$(FileLoc$,1) <> "\" THEN FileLoc$ = FileLoc$ + "\"
         END IF
         TypeLine$ = LEFT$(FromRec$, 1)
         IF NoExtended AND TypeLine$ = " " THEN TypeLine$ = "?"
         SELECT CASE TypeLine$

         CASE " "
            IF NumMergeHold < 23 THEN
               NumMergeHold = NumMergeHold + 1
               MergeHold$(NumMergeHold) = FromRec$
            END IF
         CASE "*", "\"
            LSET OutTemplate$ = FromRec$
            GOSUB OutPutNew
         CASE ""
            ' skip empty lines
         CASE ELSE
                      ' get any extended desc after name
            IF (NOT NoExtended) AND NOT ExtendedBeforeName THEN
               IF NOT EOF(1) THEN
                  FromHold$ = FromRec$
                  LINE INPUT #1, FromRec$
                  WHILE LEFT$(FromRec$,1) = " "
                     IF NumMergeHold < 23 THEN
                        NumMergeHold = NumMergeHold + 1
                        MergeHold$(NumMergeHold) = FromRec$
                     END IF
                     IF NOT EOF(1) THEN
                        LINE INPUT #1, FromRec$
                     ELSE
                        FromRec$ = ""
                     END IF
                  WEND
                  SWAP FromHold$,FromRec$
               END IF
            END IF

            NewItem = TRUE
            IF TargetSortedByDate THEN
               IF AddingDate THEN
                  X$ = AddDate$
               ELSE
                  X$ = MID$(FromRec$, StartDateAt, 8)
               END IF
               LSET KeyFrom$ = MID$(X$, 7, 2) + MID$(X$, 1, 2) + MID$(X$, 4, 2)
               CALL SubZero(KeyFrom$)
            ELSE
               LSET KeyFrom$ = MID$(FromRec$, StartNameAt, 13)
            END IF
            LOCATE MergeRow, MergeCol
            PRINT KeyFrom$;
         END SELECT
      END IF
   LOOP UNTIL NewItem

RETURN

ReadTarget:

   NewItem = FALSE
   DO
      IF EOF(2) AND TargetHold$ = "" THEN
         IF ChainTo$ = "" THEN
            NewItem = TRUE
            KeyTo$ = HighValues$
            CLOSE 2
         ELSE
            MergeTo$ = ChainTo$
            GOSUB OpenTarget
         END IF
      ELSE
         IF TargetHold$ <> "" THEN
            ToRec$ = TargetHold$
            TargetHold$ = ""
         ELSE
            LINE INPUT #2, ToRec$
         END IF
         TypeLine$ = LEFT$(ToRec$, 1)
         SELECT CASE TypeLine$
         CASE " "
            IF NumTargetHold < 23 THEN
               NumTargetHold = NumTargetHold + 1
               TargetHold$(NumTargetHold) = ToRec$
            END IF
         CASE "*", "\"
            GOSUB OutPutTarget
         CASE ""
            ' skip blank lines
         CASE ELSE
            IF NOT TargetSortedByDate THEN ' Get extended after name
               IF NOT EOF(2) THEN
                  TargetHold$ = ToRec$
                  LINE INPUT #2, ToRec$
                  WHILE LEFT$(ToRec$,1) = " "
                     IF NumTargetHold < 23 THEN
                        NumTargetHold = NumTargetHold + 1
                        TargetHold$(NumTargetHold) = ToRec$
                     END IF
                     IF NOT EOF(2) THEN
                        LINE INPUT #2, ToRec$
                     ELSE
                        ToRec$ = ""
                     END IF
                  WEND
                  SWAP TargetHold$,ToRec$
               END IF
            END IF

            NewItem = TRUE
            IF TargetSortedByDate THEN
               LSET KeyTo$ = DateKey$(ToRec$)
            ELSE
               LSET KeyTo$ = NameKey$(ToRec$)
            END IF
            LOCATE TargetRow, TargetCol
            PRINT KeyTo$;
         END SELECT
      END IF
   LOOP UNTIL NewItem

RETURN

OutPutMerge:

   IF StartNameAt > LEN(FromRec$) THEN ' Check for valid file name
      Work$ = "*"
   ELSE
      Work$ = MID$(FromRec$,StartNameAt, 13) + "*"
   END IF
   I = 1
   DO UNTIL INSTR(InvalidFileChars$, MID$(Work$, I, 1)) > 0
      I = I + 1
   LOOP
   IF I < LEN(Work$) OR LEFT$(Work$, 1) = "." THEN
      NumMergeHold = 0    'invalid file name
      NumInvalid = NumInvalid + 1
      RETURN
   END IF
   DIZUsed = FALSE
   IF StartUseDIZ THEN
      CALL GetDIZ (FileLoc$+MID$(FromRec$,StartNameAt,13),DIZOK)
      IF NOT DIZOK THEN IF FileLoc$ <> "" THEN CALL GetDIZ (MID$(FromRec$,StartNameAt,13),DIZOK)
      IF DIZOK THEN CALL CheckExist ("FILE_ID.DIZ",DIZOK)
      IF DIZOK THEN  ' strategy:  substitute formated entry for input
         OPEN "FILE_ID.DIZ" FOR INPUT AS #5
         WorkRec$ = ""
              ' build the main FMS entry
         LSET OutTemplate$ = SPACE$(OutLen)
         IF ConvertFields THEN
            IsOK = TRUE
            CALL NameSizeDateDesc (FromRec$,IsOK)
         ELSE
            LSET OutTemplate$ = FromRec$
         END IF
              ' do the short main entry description
         LastToWrite = OutLen - 3
         PosToWrite = 34
         NumInHold = 0
         GOSUB FillLine
         IF PosToWrite > 34 THEN
            WorkRec$ = OutTemplate$
         END IF
         WHILE NextChar$ <> ""     ' now do any extended descriptions
            PosToWrite = 3
            LSET OutTemplate$ = SPACE$(OutLen)
            GOSUB FillLine
            IF PosToWrite > 3 THEN
               WorkRec$ = WorkRec$ + DoubleHV$ + OutTemplate$
            END IF
         WEND
         CLOSE 5
         DIZUsed = (WorkRec$ <> "")
         IF DIZUsed THEN
            FromRec$ = WorkRec$
         END IF
      END IF
   END IF
   GOSUB BurstExtended   ' break apart when extended aggregated
   IF NumMergeHold > 0 THEN
      GOSUB BuildOneLineExtended
      IF ExtendedBeforeName EQV TargetSortedByDate THEN
         Frst = 1
         Lst = NumMergeHold
         Inc = 1
      ELSE
         Frst = NumMergeHold
         Lst = 1
         Inc = -1
      END IF
      IF TargetSortedByDate THEN
         GOSUB MergeOutPutHold
      END IF
   END IF
   IF StartIsFMS THEN
      LSET HoldCat$ = RIGHT$(FromRec$, 3)
      MID$ (FromRec$, LEN(FromRec$) - 2, 3) = "   "
   ELSE
      LSET HoldCat$ = "UNC"
   END IF
   LSET OutTemplate$ = SPACE$ (OutLen)
   IF ConvertFields AND NOT DIZUsed THEN
      IsOK = TRUE
      CALL NameSizeDateDesc (FromRec$,IsOK)
   ELSE
      LSET OutTemplate$ = FromRec$
   END IF
   IF NOT IsOK THEN
      NumBad = NumBad + 1
      RETURN
   END IF
   MID$ (OutTemplate$, StartCatCode) = HoldCat$
   GOSUB SetConstants
   IF NumMergeHold > 0 THEN
      IF NOT TargetSortedByDate THEN
         GOSUB MergeOutPutHold
      END IF
   END IF
   OneLineExtended$ = ""

RETURN

FillLine:

   LastEnd = 0
   StartPos = PosToWrite
   DO
      GOSUB GetNextChar
      SELECT CASE NextChar$
         CASE LineFeed$,""
            ' skip
         CASE CarriageReturn$," "
            IF PosToWrite > StartPos THEN  ' don't put at begin of line
               MID$(OutTemplate$,PosToWrite) = " "
               LastEnd = PosToWrite
               PosToWrite = PosToWrite + 1
             END IF
         CASE ELSE
            MID$(OutTemplate$,PosToWrite) = NextChar$
            PosToWrite = PosToWrite + 1
      END SELECT
   LOOP UNTIL NextChar$ = "" OR PosToWrite > LastToWrite
   LastChar$ = NextChar$
   GOSUB GetNextChar
   WordContinues = (INSTR(EndofWord$,LastChar$) = 0) AND (INSTR(EndofWord$,NextChar$) = 0)
   IF WordContinues THEN
      IF LastEnd > 0 THEN
         HoldChars$ = MID$(OutTemplate$,LastEnd+1,LastToWrite-LastEnd) + NextChar$
         MID$(OutTemplate$,LastEnd+1) = SPACE$(LastToWrite - LastEnd)
         NextPos = 1
         NumInHold = LEN(HoldChars$)
      END IF
   ELSE
      HoldChars$ = NextChar$
      NextPos = 1
      NumInHold = 1
   END IF

RETURN

GetNextChar:

   IF NumInHold > 0 THEN
      NextChar$ = MID$(HoldChars$,NextPos,1)
      NextPos = NextPos + 1
      NumInHold = NumInHold - 1
   ELSE
      IF EOF(5) THEN
         NextChar$ = ""
      ELSE
         NextChar$ = INPUT$ (1,#5)
      END IF
   END IF

RETURN

BurstExtended:  ' breaks out extended off single line
                ' pretends read in name+extended

   I = INSTR(FromRec$,DoubleHV$)
   IF I = 0 THEN RETURN
   LenLine = I - 1
   NumMergeHold = (LEN(FromRec$) - I + 1) / (I + 1)
   IF ExtendedBeforeName THEN
      StartAt = LenLine - 1
      Inc = -I-1
   ELSE
      StartAt = I + 2
      Inc = I + 1
   END IF
   FOR I = 1 TO NumMergeHold
      MergeHold$ (I) = MID$(FromRec$,StartAt,LenLine)
      StartAt = StartAt + Inc
   NEXT
   FromRec$ = LEFT$(FromRec$,LenLine)

RETURN

BuildOneLineExtended:

   IF NumMergeHold = 0 OR NOT CombineExtended THEN RETURN
   FOR I = 1 TO NumMergeHold
      IF ExtendedBeforeName THEN
         OneLineExtended$ = DoubleHV$ + MergeHold$(I) + OneLineExtended$
      ELSE
         OneLineExtended$ = OneLineExtended$ + DoubleHV$ + MergeHold$(I)
      END IF
   NEXT
   NumMergeHold = 0
' print "Ole=\";onelineextended$;">":input xxx$
RETURN

MergeOutputHold:

   FOR I = Frst TO Lst STEP Inc    'output extended desc
      IF StartIsFMS THEN
         MID$(MergeHold$(I), LEN(MergeHold$ (I)) - 2, 3) = "   "
      END IF
      LSET OutTemplate$ = SPACE$(OutLen)
      LSET OutTemplate$ = MergeHold$(I)
      MID$(OutTemplate$, StartCatCode) = "  ."
      GOSUB OutPutNew
   NEXT
   NumMergeHold = 0

RETURN

SetConstants: ' formats & outputs the merge line

   IF AddingDate THEN
      MID$(OutTemplate$, 24, 8 ) = AddDate$
   END IF
   IF AddingDesc AND NOT DIZUsed THEN
      MID$(OutTemplate$, 34) = AddDesc$
   END IF
   IF AddingCat THEN
      MID$(OutTemplate$, StartCatCode) = AddCat$
   ELSE
      NewCatPos = INSTR(SearchCats$, ","+RIGHT$(OutTemplate$,3)+",") + 1
      IF NewCatPos > 1 THEN
         MID$(OutTemplate$, StartCatCode) = MID$(ReplaceCats$,NewCatPos,3)
         NumSubs = NumSubs + 1
         LOCATE SubRow,SubCol
         PRINT NumSubs;
      END IF
   END IF
   GOSUB OutPutNew

RETURN

OutPutTarget:

   IF TargetSortedByDate THEN
      GOSUB TargetOutputHold
   END IF
   LSET HoldCat$ = RIGHT$(ToRec$, 3)
   MID$(ToRec$, LEN(ToRec$) - 2, 3) = "   "
   LSET OutTemplate$ = ToRec$
   MID$(OutTemplate$, StartCatCode, 3) = HoldCat$
   GOSUB OutPutNew
   IF NOT TargetSortedByDate THEN
      GOSUB TargetOutputHold
   END IF

RETURN

TargetOutputHold:

   FOR I = 1 TO NumTargetHold     'extended desc
      LSET OutTemplate$ = SPACE$(OutLen)
      LSET HoldCat$ = RIGHT$(TargetHold$(I), 3)
      MID$(TargetHold$(I), LEN(TargetHold$(I)) - 2, 3) = "   "
      LSET OutTemplate$ = TargetHold$(I)
      MID$(OutTemplate$, StartCatCode, 3) = HoldCat$
      GOSUB OutPutNew
   NEXT
   NumTargetHold = 0

RETURN

OutPutNew:

   ' if chaining then ...
ON ERROR GOTO 50070
10 PRINT #3, OutTemplate$;OneLineExtended$
   LOCATE NewRow, NewCol
   PRINT LEFT$(OutTemplate$, 13);
ON ERROR GOTO 0
RETURN

PositionDown:
   LOCATE 22,1: PRINT SPACE$(79);
   LOCATE 23,1: PRINT SPACE$(79);
   LOCATE 22,1
RETURN

40000 GOSUB PositionDown
      PRINT "Error"; ERR
      PRINT " Unable to open StartDir file "; StartDir$
      GOTO 50100
40100 GOSUB PositionDown
      PRINT "Error"; ERR
      PRINT "Unable to open MergeTo file "; MergeTo$
      GOTO 50100
40200 PRINT
      PRINT "Missing Config File ";ConfigFile$
      GOTO 50100
50000 GOSUB PositionDown
50050 GOSUB PositionDown
      PRINT "Error";ERR
      PRINT "Unable to create NewDir file ";NewDir$
      GOTO 50100
50070 GOSUB PositionDown
      PRINT "Error";ERR
      PRINT "Unable to write to NewDir file ";NewDir$
      GOTO 50100

50090 PRINT "Unexpected Error"; ERR
50100 PRINT "Aborting..."
      END

FUNCTION DateKey$ (X$) STATIC
   DateKey$ = MID$(X$, 30, 2) + MID$(X$, 24, 2) + MID$(X$, 27, 2)
END FUNCTION

FUNCTION NameKey$ (X$) STATIC
  IF LEFT$(X$, 1) = "=" THEN
     NameKey$ = MID$(X$, 2, 13)
  ELSE
     NameKey$ = LEFT$(X$, 13)
  END IF
END FUNCTION

      SUB NameSizeDateDesc (InStrng$, IsOK) STATIC
      DIM Wrds$(25)
      LenIn = LEN(InStrng$)
      IF GotName AND StartNameAt <= LenIn THEN  ' Reformat Name
         Work$ = MID$(InStrng$, StartNameAt, 13)
         CALL Trim(Work$)
         BlankPos = INSTR(Work$, " ")
         DotPos = INSTR(Work$, ".")
         IF DotPos = 0 AND BlankPos > 0 THEN
            DotPos = BlankPos
            MID$(Work$, BlankPos, 1) = "."
         END IF
         CALL RemoveBlanks(Work$)
         MID$(OutTemplate$, 1, 13) = Work$
         IF Work$ = "" OR DotPos > 9 OR DotPos = 1 THEN IsOK = 0
      END IF
      IF GotSize AND StartSizeAt <= LenIn THEN  ' Reformat Size
         Work$ = MID$(InStrng$, StartSizeAt)
         CALL Trim(Work$)
         X = INSTR(Work$," ")
         IF X > 1 THEN
            IF X > 10 THEN X = 10
            Work$ = LEFT$(Work$,X-1)
         END IF
         L = LEN(Work$)
         CALL AnyBut (Work$,"0123456789,",NumOK)
         IF NumOK = 0 THEN IsOK = 0
         MID$(OutTemplate$, 22 - L, L) = Work$' Right Justify
      END IF
      IF GotDate AND StartDateAt <= LenIn - 8 THEN
         Work$ = MID$(InStrng$, StartDateAt)
         Wrds$(1) = ""
         Wrds$(2) = ""
         Wrds$(3) = ""
         CALL IncludeParse ("0123456789",Work$,Wrds$(),NumFound)
         MID$(OutTemplate$, 24, 8) = RIGHT$("00"+Wrds$(1),2) + "-" + _
                                     RIGHT$("00"+Wrds$(2),2) + "-" + _
                                     RIGHT$("00"+Wrds$(3),2)
      END IF
      IF GotDesc AND StartDesc <= LenIn THEN
         Work$ = MID$(InStrng$, StartDescAt)
         CALL Trim(Work$)
         MID$(OutTemplate$, 34) = Work$
      END IF
      'LOCATE 3,1
      'PRINT Instrng$;"->";
      'LOCATE 4,1
      'PRINT OutTemplate$;"<-";
      'x$ = input$(1)
      END SUB

FUNCTION ParmValue$ (Rec$, ParmKey$, Default$) STATIC
   X = INSTR(Rec$, ParmKey$)
   IF X = 0 THEN
      ParmValue$ = Default$
   ELSE
      X$ = MID$(Rec$, X + LEN(ParmKey$), INSTR(X + 1, Rec$, "/") - X - LEN(ParmKey$))
      CALL Trim(X$)
      ParmValue$ = X$
   END IF
END FUNCTION

      SUB RemoveBlanks (Strng$) STATIC
      EndPos = LEN(Strng$)
      BlankPos = INSTR(Strng$, " ")
      WHILE BlankPos < EndPos AND BlankPos > 0
         MID$(Strng$, BlankPos) = MID$(Strng$, BlankPos + 1)
         EndPos = EndPos - 1
         BlankPos = INSTR(Strng$, " ")
      WEND
      Strng$ = LEFT$(Strng$, EndPos + (BlankPos > 0))
      END SUB

      SUB SQOutBlanks (Strng$) STATIC
      EndPos = LEN(Strng$)
      BlankPos = INSTR(Strng$, " ")
      IF BlankPos < 1 THEN EXIT SUB
      WHILE BlankPos < EndPos
         MID$(Strng$, BlankPos) = MID$(Strng$, BlankPos + 1)
         EndPos = EndPos - 1
         BlankPos = INSTR(Strng$, " ")
      WEND
      MID$(Strng$, EndPos) = "/"
      Strng$ = LEFT$(Strng$, EndPos)
      END SUB

      SUB SubZero (Work$) STATIC
         X = INSTR(Work$, " ")
         WHILE X > 0          ' substitute 0 for blank
            MID$(Work$, X, 1) = "0"
            X = INSTR(Work$, " ")
         WEND
      END SUB

      SUB Trim (TrimParm$) STATIC
      WasL = INSTR(TrimParm$, " ")
      IF WasL < 1 THEN
         EXIT SUB
      END IF
      IF WasL = 1 THEN
         WHILE LEFT$(TrimParm$, 1) = " "
            TrimParm$ = RIGHT$(TrimParm$, LEN(TrimParm$) - 1)
         WEND
      END IF
      CALL TrimTrail(TrimParm$, " ")
      END SUB

      SUB TrimTrail (TrimParm$, TrimThis$) STATIC
      IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN
         EXIT SUB
      END IF
      WasJ = LEN(TrimParm$) - 1
108   IF WasJ > 0 THEN
         IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN
            WasJ = WasJ - 1
            GOTO 108
         END IF
      END IF
      TrimParm$ = LEFT$(TrimParm$, WasJ)
      END SUB

SUB IncludeParse (IncludeThis$, PassedParse$, Wrds$(), NumFound) STATIC
   NumFound = 0
   StartAt = 1
   ParseThis$ = PassedParse$ + CHR$(0)
   FOR I = 1 TO LEN(ParseThis$)
      IF INSTR(IncludeThis$, MID$(ParseThis$, I, 1)) = 0 THEN
         ParseLen = I - StartAt
         IF ParseLen > 0 THEN
            NumFound = NumFound + 1
            Wrds$(NumFound) = MID$(ParseThis$, StartAt, ParseLen)
         END IF
         StartAt = I + 1
      END IF
   NEXT
END SUB

SUB AnyBut (CheckThis$, ForThis$, IsOK) STATIC
   IsOK = -1
   FOR I = 1 TO LEN(CheckThis$)
      IF INSTR(ForThis$,MID$(CheckThis$,I,1)) = 0 THEN IsOK = 0
   NEXT
END SUB

SUB GetDIZ (Filname$,IsOK) STATIC
   IsOK = 0
   I = INSTR(Filname$," ")
   J = INSTR(Filname$,".")
   IF J = 0 OR (J > 0 AND I > 0 AND I < J) THEN J = I
   IF J < 1 THEN EXIT SUB
   EXT$ = MID$(Filname$,J+1)
   CALL Trim (Ext$)
   Ext$ = UCASE$(Ext$)
   IF Ext$ <> "ZIP" THEN EXIT SUB

   PREF$ = LEFT$(Filname$,J-1)
   CALL Trim (PREF$)
   PREF$ = UCASE$(PREF$)
   Filname$ = PREF$+".ZIP"
   CALL CheckExist (Filname$, IsOK)
   IF NOT IsOK THEN EXIT SUB
   IsOK = -1
   SHELL "GETDIZ.BAT "+Filname$
END SUB

SUB CheckExist (Filname$, IsOK) STATIC
   ON LOCAL ERROR RESUME NEXT
   OPEN Filname$ FOR INPUT AS #6
   IsOK = (ERR = 0)
   CLOSE 6
END SUB