ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/BBS/RBBS_PC/MFIDX12.ZIP/MAKEFIDX.BAS

BASIC Source File | 1990-11-20 | 12.9 KB | 386 lines

DECLARE SUB TRIM (TRIM.PARM$)
DECLARE SUB BRKFNAME (FILENAME$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING%)
DECLARE SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$)
DECLARE SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND%, NUM.FINDS%)
DEFINT A-Z
DIM FileSpec$(999)
DIM FileDir$(255)
DIM LocationIndex$(999)
TRUE = -1
FALSE = 0
WriteMode$ = "REPLACE"
NameFile$ = "FIDX.DEF"
LocationFile$ = "LIDX.DEF"
DirString$ = "DIRECTORY OF"                                          ' 0216
SHARING = FALSE
NumLocations = 0
NumFileSpecs = 0
NumFileDirs = 0
StartCol = 1                                                         ' 0224
ConfigFile$ = "MAKEFIDX.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
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$,11) = "/WRITEMODE=" THEN
         WriteMode$ = MID$(A$,12)
         CALL TRIM (WriteMode$)
      END IF
      IF LEFT$(A$, 10) = "/NAMEFILE=" THEN
         NameFile$ = MID$(A$, 11)
         CALL TRIM(NameFile$)
      END IF
      IF LEFT$(A$, 14) = "/LOCATIONFILE=" THEN
         LocationFile$ = MID$(A$, 15)
         CALL TRIM(LocationFile$)
      END IF
      IF LEFT$(A$, 10) = "/FILESPEC=" THEN
         X$ = MID$(A$, 11)
         CALL TRIM(X$)
         NumFileSpecs = NumFileSpecs + 1
         FileSpec$(NumFileSpecs) = X$
      END IF
      IF LEFT$(A$, 9) = "/FILEDIR=" THEN
         X$ = MID$(A$, 10)
         CALL TRIM(X$)
         NumFileDirs = NumFileDirs + 1
         FileDir$(NumFileDirs) = X$
      END IF
      IF LEFT$(A$,11) = "/DIRSTRING=" THEN                           ' 0216
         X$ = MID$(A$,12)                                            ' 0216
         CALL TRIM (X$)                                              ' 0216
         DirString$ = X$                                             ' 0216
         DirString$ = UCASE$(DirString$)                             ' 0220
      END IF                                                         ' 0216
   END IF
WEND
CLOSE 1

Replacing = (LEFT$(WriteMode$, 1) = "R")

PRINT "MAKEFIDX version 1.2 Nov 20, 1990 copyright (c) 1990 by Ken Goosens"
PRINT "an RBBS utility to make files for fast directory searches"
PRINT
PRINT "On this run"
IF Replacing THEN
   PRINT "Overwriting data files"
ELSE
   PRINT "Adding to data files"
END IF
PRINT "Configuration file used ....... ";ConfigFile$
PRINT "Name of list of files ......... "; NameFile$
PRINT "Name of list of locations ..... "; LocationFile$
PRINT "# of DOS directories to process"; NumFileSpecs
PRINT "# of file lists to process ...."; NumFileDirs
PRINT
IF NOT RunBatch THEN
   INPUT "A to abort, anything else runs"; ANS$
   ANS$ = UCASE$(ANS$)
   IF ANS$ = "A" THEN END
END IF

'NumFileSpecs = 2
'FileSpec$(1) = "C:\TEMP\"
'FileSpec$(2) = "C:\UTILS\"
IF Replacing THEN
   ON ERROR GOTO 40100
   KILL NameFile$
   KILL LocationFile$
   ON ERROR GOTO 0
ELSE
   IF SHARING THEN
      OPEN LocationFile$ FOR INPUT SHARED AS #1
   ELSE
      OPEN LocationFile$ FOR INPUT AS #1
   END IF
   PRINT "Loading existing locations..."
   WHILE NOT EOF(1)
      LINE INPUT #1, A$
      CALL TRIM(A$)
      NumLocations = NumLocations + 1
      LocationIndex$(NumLocations) = A$
   WEND
   CLOSE 1
   PRINT STR$(NumLocations); " locations loaded"
END IF

IF SHARING THEN
   OPEN NameFile$ FOR RANDOM SHARED AS #2 LEN = 18
   OPEN LocationFile$ FOR RANDOM SHARED AS #3 LEN = 66
ELSE
   OPEN NameFile$ FOR RANDOM AS #2 LEN = 18
   OPEN LocationFile$ FOR RANDOM AS #3 LEN = 66
END IF
FIELD 2, 18 AS NameRec$
FIELD 3, 66 AS LocationRec$
MID$(NameRec$, 17, 2) = CHR$(13) + CHR$(10)
MID$(LocationRec$, 64, 3) = "." + CHR$(13) + CHR$(10)
NumRecsNameFile = LOF(2) / 18
NumRecsLocationFile = LOF(3) / 66

InFile$ = "IDX.$$$"
FOR ix = 1 TO NumFileSpecs
   PRINT "Processing filespec "; FileSpec$(ix) ;                     ' 112090
'  SHELL "DIR " + FileSpec$(ix) + " > IDX.$$$"
'  GOSUB ProcessFile
   GOSUB ProcessDir                                                  ' 112090
NEXT

FOR ix = 1 TO NumFileDirs
   InFile$ = FileDir$(ix)
   PRINT "Processing file list "; FileDir$(ix) ;                     ' 112090
   GOSUB ProcessFile
NEXT

END

ProcessDir:                                                          ' 112090

   CALL BRKFNAME (FileSpec$(ix),CurrentDrivePath$,Prefix$,Extension$,TRUE)
   CALL FindFirstF(FileSpec$(ix)+CHR$(0),0,RtnCode)
   IF RtnCode <> 0 THEN
      PRINT
      PRINT "   No files found"
      RETURN
   END IF
   GOSUB SetLocIndex
   RecCt = 0
   PrtCol = POS(0) + 1                                               ' 112090
   WHILE RtnCode = 0
      RecCt = RecCt + 1                                              ' 112090
      LOCATE ,PrtCol                                                 ' 112090
      PRINT RecCt ;                                                  ' 112090
      FileName$ = SPACE$(12)
      CALL GetNameF (FileName$,FLen)
      FileName$ = LEFT$(FileName$,FLen)
      GOSUB AddFileName
      CALL FindNextF (RtnCode)
   WEND

   PRINT

RETURN

ProcessFile:

   ON ERROR GOTO 40200                                               ' 111990
   IF SHARING THEN
      OPEN InFile$ FOR INPUT SHARED AS #1
   ELSE
      OPEN InFile$ FOR INPUT AS #1
   END IF
   ON ERROR GOTO 0                                                   ' 111990
   RecCt = 0                                                         ' 112090
   PrtCol = POS(0) + 1                                               ' 112090
   WHILE NOT EOF(1)
      LINE INPUT #1, A$
      RecCt = RecCt + 1                                              ' 112090
      LOCATE ,PrtCol                                                 ' 112090
      PRINT RecCt ;                                                  ' 112090
      X$ = UCASE$(A$)
      X = INSTR(X$, DirString$)                                      ' 0216
      IF X > 0 THEN                                                  ' 0224
         IF LEFT$(X$,X-1) = SPACE$(X-1) THEN                         ' 0224
            DrivePath$ = MID$(A$, X + LEN(DirString$))               ' 0216
            CALL TRIM(DrivePath$)
            IF LEFT$(DrivePath$,3) <> "M! " THEN                     ' 0217
               IF INSTR(DrivePath$,"*") > 0 OR INSTR(DrivePath$,"?") > 0 THEN  ' 0216
                  CALL BRKFNAME (DrivePath$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0216
                  DrivePath$ = RtnDrivePath$                         ' 0216
               END IF
               IF INSTR(DrivePath$, "\") > 0 THEN
                  IF RIGHT$(DrivePath$, 1) <> "\" THEN
                     DrivePath$ = DrivePath$ + "\"
                  END IF
               END IF
            END IF                                                   ' 0217
            CurrentDrivePath$ = DrivePath$
            GOSUB SetLocIndex
            GOTO DoneEntry
         END IF                                                      ' 0224
      END IF
      IF INSTR(" .", LEFT$(A$, 1)) > 0 THEN
         GOTO DoneEntry
      END IF
      IF LEN(A$) < StartCol THEN                                     ' 0224
         GOTO DoneEntry                                              ' 0224
      END IF                                                         ' 0224
      IF StartCol > 1 THEN                                           ' 0224
         A$ = MID$(A$,StartCol)                                      ' 0224
      END IF                                                         ' 0224
      X = INSTR(A$, " ")
      IF X = 0 THEN                                                  ' 0217
         X = LEN(A$) + 1                                             ' 0217
      ELSE
         IF X < 13 THEN
            FileName$ = LEFT$(A$, 12)
            IF INSTR(FileName$, ".") = 0 AND MID$(FileName$, 9, 1) = " " AND MID$(FileName$, 10, 1) <> " " THEN
               MID$(FileName$, X) = "." + MID$(FileName$, 10) + SPACE$(9 - X)
            ELSE
               FileName$ = LEFT$(A$, X - 1)
            END IF
            GOSUB AddFileName
            GOTO DoneEntry
         END IF
      END IF                                                         ' 0217
      FileName$ = LEFT$(A$, X - 1)
      CALL BRKFNAME (FileName$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0217
      IF RtnDrivePath$ <> "" THEN                                    ' 0217
         DrivePath$ = RtnDrivePath$                                  ' 0217
         FileName$ = RtnPrefix$ + RtnExt$                            ' 0217
      END IF                                                         ' 0217
      GOSUB AddFileName
DoneEntry:
   WEND
QuitEntry:                                                           ' 111990
   ON ERROR GOTO 0                                                   ' 111990
   CLOSE 1
   PRINT                                                             ' 111990
RETURN

SetPathName:

   CALL BRKFNAME(FileName$, FileDrivePath$, FilePrefix$, FileExt$, TRUE)
   IF FileDrivePath$ <> "" THEN
      CurrentDrivePath$ = FileDrivePath$
      GOSUB SetLocIndex
      FileName$ = FilePrefix$ + FileExt$
   ELSE
      CurrentDrivePath$ = DrivePath$
   END IF

RETURN

AddFileName:

   GOSUB SetPathName
   MID$(NameRec$, 1, 16) = SPACE$(16)
   MID$(NameRec$, 1, 12) = FileName$
   X$ = MID$(STR$(Location), 2)
   X$ = SPACE$(4 - LEN(X$)) + X$
   MID$(NameRec$, 13, 4) = X$
   NumRecsNameFile = NumRecsNameFile + 1
   PUT 2, NumRecsNameFile

RETURN

SetLocIndex:

   IF CurrentDrivePath$ = LocationIndex$(Location) THEN RETURN
   LocationIndex$(NumRecsLocationFile + 1) = CurrentDrivePath$
   Location = 1
   WHILE CurrentDrivePath$ <> LocationIndex$(Location)
      Location = Location + 1
   WEND
   IF Location > NumRecsLocationFile THEN
      NumRecsLocationFile = Location
      MID$(LocationRec$, 1, 63) = SPACE$(63)
      MID$(LocationRec$, 1, 63) = CurrentDrivePath$
      PUT 3, NumRecsLocationFile
   END IF

RETURN

40000 PRINT "Missing configuration file "; ConfigFile$
      END

40100 RESUME NEXT
40200 PRINT:PRINT "   ";InFile$;" not found.  Skipping";             ' 111990
      RESUME QuitEntry                                               ' 111990

      SUB BRKFNAME (FileName$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING) STATIC
      FileName$ = UCASE$(FileName$)
      DRVPATH$ = ""
      PREFIX$ = ""
      EXTENSION$ = ""
      CALL TRIMTRAIL(FileName$, "\")
      L = LEN(FileName$)
      IF L < 1 THEN EXIT SUB
      CALL FINDLAST(FileName$, "\", X, Y)
      IF X < 1 THEN
         IF MID$(FileName$, 2, 1) = ":" THEN
            DRVPATH$ = LEFT$(FileName$, 1)
            S = 3
         ELSE
            S = 1
         END IF
      ELSE
         DRVPATH$ = LEFT$(FileName$, X - 1)
         S = X + 1
         IF Y = 1 THEN
            DRVPATH$ =  DRVPATH$ + "\"
         END IF
      END IF
      X = INSTR(FileName$ + ".", ".")
      IF X < L THEN
         EXTENSION$ = MID$(FileName$, X + 1, 3)
      END IF
      IF S <= L THEN
         IF X >= S THEN
            PREFIX$ = MID$(FileName$, S, X - S)
         END IF
      END IF
      IF NOT FOR.JOINING THEN EXIT SUB
      IF LEN(DRVPATH$) = 1 THEN
         IF DRVPATH$ <> "\" THEN
            DRVPATH$ = DRVPATH$ + ":"
         END IF
      END IF
      IF INSTR(DRVPATH$, "\") > 0 AND RIGHT$(DRVPATH$, 1) <> "\" THEN DRVPATH$ = DRVPATH$ + "\"
      IF LEN(EXTENSION$) > 0 THEN EXTENSION$ = "." + EXTENSION$
      END SUB

      SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND, NUM.FINDS) STATIC
      WHERE.FOUND = INSTR(LOOK.IN$, LOOK.FOR$)
      NUM.FINDS = -(WHERE.FOUND > 0)
      NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
      WHILE NEXT.FOUND > 0
         NUM.FINDS = NUM.FINDS + 1
         WHERE.FOUND = NEXT.FOUND
         NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
      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
      J = LEN(TRIM.PARM$) - 1
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)
      END SUB