Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/msdos/bbs/cmpbbs10.arc/CMPBBS.BAS

BASIC Source File | 1990-02-26 | 14KB | 341 lines

DECLARE SUB BreakFileName (FileSpec$, DrvPath$, Prefix$, Extension$, ForJoining%)
DECLARE SUB FindLast (LookIn$, LookFor$, WhereFound%, NumFinds%)
DECLARE SUB TRIM (TRIM.PARM$)
DECLARE SUB TrimTrail (TRIM.PARM$, TRIM.THIS$)
DEFINT A-Z
DIM BBSList$(200), Headers$(200), DirStartCol(200)                   ' 022490
TRUE = -1
FALSE = 0
FOR I = 1 TO 200                                                     ' 022490
   DirStartCol(I) = 1                                                ' 022490
NEXT                                                                 ' 022490
MasterStartCol = 1                                                   ' 022490
MasterList$ = "UPLOADS.DIR"
OutFile$ = "NEWFILES.DIR"
NumNewLists = 0
ConfigFile$ = "CMPBBS.CFG"

PassedArguments$ = COMMAND$
PassedArguments$ = UCASE$(PassedArguments$)
X = INSTR(PassedArguments$, "/B")
RunBatch = (X > 0)
IF RunBatch THEN
   PassedArguments$ = LEFT$(PassedArguments$, X - 1) + RIGHT$(PassedArguments$, LEN(PassedArguments$) - X - 1)
END IF
X = INSTR(PassedArguments$, "/SHARE")
SHARING = (X > 0)
IF SHARING THEN
   PassedArguments$ = LEFT$(PassedArguments$, X - 1) + RIGHT$(PassedArguments$, LEN(PassedArguments$) - X - 1)
END IF
IF PassedArguments$ <> "" THEN
   ConfigFile$ = PassedArguments$
END IF

ON ERROR GOTO 40000
IF SHARING THEN
   OPEN ConfigFile$ FOR INPUT SHARED AS #1
ELSE
   OPEN ConfigFile$ FOR INPUT AS #1
END IF
ON ERROR GOTO 0
WHILE NOT EOF(1)
   LINE INPUT #1, A$
   X$ = LEFT$(A$, 1)
   IF X$ <> "" AND X$ <> "*" THEN
      A$ = UCASE$(A$)
      IF LEFT$(A$, 12) = "/MASTERLIST=" THEN
         MasterList$ = MID$(A$, 13)
         CALL TRIM(MasterList$)
      END IF
      IF LEFT$(A$, 9) = "/ADDLIST=" THEN
         NewList$ = MID$(A$, 10)
         CALL TRIM(NewList$)
         NumNewLists = NumNewLists + 1
         BBSList$(NumNewLists) = NewList$
      END IF
      IF LEFT$(A$, 8) = "/HEADER=" THEN
         Headers$(NumNewLists) = MID$(A$, 9)
         CALL TRIM(Headers$(NumNewLists))
      END IF
      IF LEFT$(A$, 9) = "/OUTFILE=" THEN
         OutFile$ = MID$(A$, 10)
         CALL TRIM(OutFile$)
      END IF
      IF LEFT$(A$, 6) = "/SHARE" THEN
         SHARING = TRUE
      END IF
      IF LEFT$(A$, 13) = "/DIRSTARTCOL=" THEN                        ' 022490
         X$ = MID$(A$, 14)                                           ' 022490
         CALL TRIM(X$)                                               ' 022490
         DirStartCol(NumNewLists) = VAL(X$)                          ' 022490
      END IF                                                         ' 022490
      IF LEFT$(A$, 16) = "/MASTERSTARTPOS=" THEN                     ' 022490
         X$ = MID$(A$, 15)                                           ' 022490
         CALL TRIM(X$)                                               ' 022490
         MasterStartCol = VAL(X$)                                    ' 022490
      END IF                                                         ' 022490
      IF LEFT$(A$, 10) = "/OUTCATAT=" THEN                           ' 022690
         X$ = MID$(A$, 11)                                           ' 022690
         CALL TRIM(X$)                                               ' 022690
         OutCatAt = VAL(X$)                                          ' 022690
      END IF                                                         ' 022690
   END IF
WEND
CLOSE 1

PRINT "CMPBBS version 1.0 Feb 26, 1990 copyright (c) 1990 by Ken Goosens"
PRINT "A SysOp utility to compare BBS file lists"
PRINT
PRINT "On this run"
PRINT "Configuration file used ....... "; ConfigFile$
PRINT "Name of master list of files... "; MasterList$
PRINT "File names begin in column....."; MasterStartCol              ' 022490
PRINT "# of file lists to process ...."; NumNewLists
PRINT "Writing list of new files to... "; OutFile$
PRINT "Adding category code at column.";                             ' 022690
IF OutCatAt > 0 THEN                                                 ' 022690
   PRINT OutCatAt                                                    ' 022690
ELSE                                                                 ' 022690
   PRINT " <none>"                                                   ' 022690
END IF                                                               ' 022690
PRINT
IF NOT RunBatch THEN
   INPUT "A to abort, anything else runs"; ANS$
   ANS$ = UCASE$(ANS$)
   IF ANS$ = "A" THEN
      END
   END IF
END IF

ON ERROR GOTO 40010
FileIn$ = MasterList$
IF SHARING THEN
   OPEN MasterList$ FOR INPUT SHARED AS #1
ELSE
   OPEN MasterList$ FOR INPUT AS #1
END IF
ON ERROR GOTO 0

GOSUB BuildCRC

OPEN OutFile$ FOR OUTPUT AS #2

AddToNew = TRUE
NumFilesAdded = 0
FOR ix = 1 TO NumNewLists
   PRINT "Processing BBS list "; BBSList$(ix);
   ON ERROR GOTO 40100
   FileIn$ = BBSList$(ix)
   StartCol = DirStartCol(ix)                                        ' 022490
   IF SHARING THEN
      OPEN BBSList$(ix) FOR INPUT SHARED AS #1
   ELSE
      OPEN BBSList$(ix) FOR INPUT SHARED AS #1
   END IF
   ON ERROR GOTO 0
   IF ERC > 0 THEN
      ERC = 0
      PRINT " not found - skipping"
   ELSE
      CatCode$ = ""                                                  ' 022690
      IF Headers$(ix) <> "" THEN                                     ' 022690
         PRINT #2, " "; Headers$(ix)                                 ' 022690
         IF OutCatAt > 0 THEN                                        ' 022690
            X = INSTR(Headers$(ix), "M! ")                           ' 022690
            IF X > 0 THEN                                            ' 022690
               X$ = MID$(Headers$(ix), X + 3)                        ' 022690
               CALL BreakFileName(X$, DrvPath$, CatCode$, Ext$, 0)   ' 022690
               CatCode$ = LEFT$(CatCode$, 3)                         ' 022690
               IF LEN(CatCode$) < 3 THEN                             ' 022690
                  CatCode$ = CatCode$ + SPACE$(3 - LEN(CatCode$))    ' 022690
               END IF                                                ' 022690
            END IF                                                   ' 022690
         END IF                                                      ' 022690
      END IF                                                         ' 022690
      GOSUB ProcessList
   END IF
NEXT

END

BuildCRC:

   WorkName$ = SPACE$(12)
   WorkComp$ = WorkName$                                             ' 022490
   CRCMaster$ = ""
   FileCRC$ = MKI$(0)
   AddToNew = FALSE
   PRINT
   PRINT "Indexing "; MasterList$;
   StartCol = MasterStartCol                                         ' 022490
   GOSUB ProcessList

RETURN

ProcessList:

   AddedAtStart = NumFilesAdded
   NumRead = 0
   AddCat = (CatCode$ <> "")
   CutOffCat = OutCatAt + LEN(CatCode$) - 1
   PrintAt = POS(0) + 1
   ON ERROR GOTO 40020
   WHILE NOT EOF(1)
4     LINE INPUT #1, A$
      NumRead = NumRead + 1
      LOCATE , PrintAt
      PRINT NumRead;
      IF LEN(A$) < StartCol THEN                                     ' 022490
         GOTO NotAFile                                               ' 022490
      END IF                                                         ' 022490
      IF StartCol > 1 THEN                                           ' 022490
         A$ = MID$(A$, StartCol)                                     ' 022490
      END IF                                                         ' 022490
      IF INSTR("/[]|<>+=;, ?*", LEFT$(A$, 1)) > 0 THEN
         GOTO NotAFile
      END IF
      Y = INSTR(A$ + " ", " ")
      IF Y > 13 THEN                                                 ' 022690
         GOTO NotAFile                                               ' 022490
      END IF                                                         ' 022490
      LSET WorkName$ = A$
      X = LEN(A$)
      IF X < 12 THEN
         MID$(WorkName$, X + 1) = "            "
      END IF
      Y = INSTR(WorkName$, " ")
      Z = INSTR(WorkName$, ".")                                      ' 022490
      IF Z = 0 THEN                                                  ' 022490
         IF Y = 0 OR Y > 9 THEN                                      ' 022490
            GOTO NotAFile                                            ' 022490
         END IF                                                      ' 022490
      END IF                                                         ' 022490
      IF Y > 0 THEN
         IF Y < 10 THEN
            MID$(WorkName$, Y) = "." + MID$(WorkName$, 10) + SPACE$(9 - Y)
         END IF
      ELSE                                                           ' 022490
         IF Z = 0 OR Z > 9 THEN                                      ' 022490
            GOTO NotAFile                                            ' 022490
         END IF                                                      ' 022490
      END IF
      LSET WorkComp$ = WorkName$                                     ' 022490
      WorkName$ = UCASE$(WorkName$)                                  ' 022490
      IF WorkComp$ <> WorkName$ THEN                                 ' 022490
         GOTO NotAFile                                               ' 022490
      END IF                                                         ' 022490
      CALL Xmodem(WorkName$, XmodemChecksum, CRCValue, CRCHigh, CRCLow)
      LSET FileCRC$ = MKI$(CRCValue)
      Z = 1
SearchAgain:
      HitCRC = INSTR(Z, CRCMaster$, FileCRC$)
      IF HitCRC > 0 THEN
         Y = HitCRC MOD 2
         IF Y = 0 THEN
            Z = HitCRC + 1
            GOTO SearchAgain
         END IF
      END IF

      IF HitCRC = 0 THEN
         CRCMaster$ = CRCMaster$ + FileCRC$
         IF AddToNew THEN
            NumFilesAdded = NumFilesAdded + 1
            IF AddCat THEN                                           ' 022690
               X = LEN(A$)                                           ' 022690
               IF X > CutOffCat THEN                                 ' 022690
                  A$ = LEFT$(A$, CutOffCat)                          ' 022690
               ELSE                                                  ' 022690
                  IF X < CutOffCat THEN                              ' 022690
                     A$ = A$ + SPACE$(CutOffCat - X)                 ' 022690
                  END IF                                             ' 022690
               END IF                                                ' 022690
               MID$(A$, OutCatAt) = CatCode$                         ' 022690
            END IF                                                   ' 022690
5           PRINT #2, A$
         END IF
      END IF
NotAFile:
   WEND
   ON ERROR GOTO 0
   CLOSE 1
   IF AddToNew THEN
      PRINT "  # new"; NumFilesAdded - AddedAtStart
   ELSE
      PRINT
   END IF

RETURN


40000 PRINT "Missing configuration file "; ConfigFile$
      END
40010 PRINT "Missing master file list "; MasterList$
      END
40020 IF ERL = 4 THEN
         PRINT "Error "; ERR; " while reading "; FileIn$
      ELSE
         PRINT "Error "; ERR; " while writing "; OutFile$
      END IF
      PRINT "Aborting..."
      END


40100 ERC = ERR
      RESUME NEXT

      SUB BreakFileName (FileSpec$, DrvPath$, Prefix$, Extension$, ForJoining) STATIC
      FileSpec$ = UCASE$(FileSpec$)
      DrvPath$ = ""
      Prefix$ = ""
      Extension$ = ""
      CALL TrimTrail(FileSpec$, "\")
      WasL = LEN(FileSpec$)
      IF WasL < 1 THEN EXIT SUB
      CALL FindLast(FileSpec$, "\", WasX, WasY)
      IF WasX < 1 THEN IF MID$(FileSpec$, 2, 1) = ":" THEN DrvPath$ = LEFT$(FileSpec$, 1):                                ZWasS = 3 ELSE ZWasS = 1 ELSE DrvPath$ = LEFT$(FileSpec$, WasX - 1):                         ZWasS = WasX + 1:             IF  _
WasY = 1 THEN DrvPath$ = DrvPath$ + "\"
      WasX = INSTR(FileSpec$ + ".", ".")
      IF WasX < WasL THEN Extension$ = MID$(FileSpec$, WasX + 1)
      IF ZWasS <= WasL THEN IF WasX >= ZWasS THEN Prefix$ = MID$(FileSpec$, ZWasS, WasX - ZWasS)
      IF NOT ForJoining THEN EXIT SUB
      IF LEN(DrvPath$) = 1 THEN IF DrvPath$ <> "\" THEN DrvPath$ = DrvPath$ + ":"
      IF INSTR(DrvPath$, "\") > 0 AND RIGHT$(DrvPath$, 1) <> "\" THEN DrvPath$ = DrvPath$ + "\"
      IF LEN(Extension$) > 0 THEN Extension$ = "." + Extension$
      END SUB

      SUB FindLast (LookIn$, LookFor$, WhereFound, NumFinds) STATIC
      WhereFound = INSTR(LookIn$, LookFor$)
      NumFinds = -(WhereFound > 0)
      NextFound = INSTR(WhereFound + 1, LookIn$, LookFor$)
      WHILE NextFound > 0
         NumFinds = NumFinds + 1
         WhereFound = NextFound
         NextFound = INSTR(WhereFound + 1, LookIn$, LookFor$)
      WEND
      END SUB

      SUB TRIM (TRIM.PARM$) STATIC
      L = INSTR(TRIM.PARM$, " ")
      IF L < 1 THEN EXIT SUB
      IF L = 1 THEN
         WHILE LEFT$(TRIM.PARM$, 1) = " "
            TRIM.PARM$ = RIGHT$(TRIM.PARM$, LEN(TRIM.PARM$) - 1)
         WEND
      END IF
      CALL TrimTrail(TRIM.PARM$, " ")
      END SUB

      SUB TrimTrail (TRIM.PARM$, TRIM.THIS$) STATIC
      IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN EXIT SUB                                                             ' KG081003
      J = LEN(TRIM.PARM$) - 1                                        ' KG081003
108   IF J > 0 THEN
         IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN
            J = J - 1
            GOTO 108
         END IF
      END IF
      TRIM.PARM$ = LEFT$(TRIM.PARM$, J)                              ' KG081003
      END SUB