home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
bbs
/
cmpbbs10.arc
/
CMPBBS.BAS
next >
Wrap
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
