home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / BBS_UTIL / BM0406_A.ZIP / MAKEFIDX.ZIP / MAKEFIDX.BAS next >
BASIC Source File  |  1994-04-06  |  15KB  |  394 lines
  1. DECLARE SUB TRIM (TRIM.PARM$)
  2. DECLARE SUB BRKFNAME (FILENAME$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING%)
  3. DECLARE SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$)
  4. DECLARE SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND%, NUM.FINDS%)
  5. DEFINT A-Z
  6. DIM FileSpec$(999)
  7. DIM FileDir$(255)
  8. DIM LocationIndex$(999)
  9. TRUE = -1
  10. FALSE = 0
  11. WriteMode$ = "REPLACE"
  12. NameFile$ = "FIDX.DEF"
  13. LocationFile$ = "LIDX.DEF"
  14. DirString$ = "DIRECTORY OF"                                          ' 0216
  15. SHARING = FALSE
  16. NumLocations& = 0                                                    ' LRGE174/YB102001
  17. NumFileSpecs& = 0                                                    ' LRGE174/YB102001
  18. NumFileDirs = 0
  19. StartCol = 1                                                         ' 0224
  20. ConfigFile$ = "MAKEFIDX.CFG"
  21. PassedArguments$ = COMMAND$
  22. PassedArguments$ = UCASE$(PassedArguments$) 
  23. X = INSTR(PassedArguments$,"/B")
  24. RunBatch = (X > 0)
  25. IF RunBatch THEN 
  26.    PassedArguments$ = LEFT$(PassedArguments$, X-1) + RIGHT$(PassedArguments$,Len(PassedArguments$)-X-1)
  27. END IF
  28. IF PassedArguments$ <> "" THEN
  29.    ConfigFile$ = PassedArguments$
  30. END IF
  31.  
  32. CALL CKSHARE(Min)                                                    ' RM04029401
  33. IF Min > 0 THEN _                                                    ' RM04029401
  34.    PRINT "SHARE detected!" : _                                       ' RM04029401
  35.    SHARING = True                                                    ' RM04029401
  36.  
  37. ON ERROR GOTO 40000
  38. IF SHARING THEN
  39.    OPEN ConfigFile$ FOR INPUT SHARED AS #1
  40. ELSE
  41.    OPEN ConfigFile$ FOR INPUT AS #1
  42. END IF
  43. ON ERROR GOTO 0
  44. WHILE NOT EOF(1)
  45.    LINE INPUT #1, A$
  46.    X$ = LEFT$(A$, 1)
  47.    IF X$ <> "" AND X$ <> "*" THEN
  48.       A$ = UCASE$(A$) 
  49.       IF LEFT$(A$,11) = "/WRITEMODE=" THEN
  50.          WriteMode$ = MID$(A$,12)
  51.          CALL TRIM (WriteMode$)
  52.       END IF
  53.       IF LEFT$(A$, 10) = "/NAMEFILE=" THEN
  54.          NameFile$ = MID$(A$, 11)
  55.          CALL TRIM(NameFile$)
  56.       END IF
  57.       IF LEFT$(A$, 14) = "/LOCATIONFILE=" THEN
  58.          LocationFile$ = MID$(A$, 15)
  59.          CALL TRIM(LocationFile$)
  60.       END IF
  61.       IF LEFT$(A$, 10) = "/FILESPEC=" THEN
  62.          X$ = MID$(A$, 11)
  63.          CALL TRIM(X$)
  64.          NumFileSpecs& = NumFileSpecs& + 1                           ' LRGE174/YB102001
  65.          FileSpec$(NumFileSpecs&) = X$                               ' LRGE174/YB102001
  66.       END IF
  67.       IF LEFT$(A$, 9) = "/FILEDIR=" THEN
  68.          X$ = MID$(A$, 10)
  69.          CALL TRIM(X$)
  70.          NumFileDirs = NumFileDirs + 1
  71.          FileDir$(NumFileDirs) = X$
  72.       END IF
  73.       IF LEFT$(A$,11) = "/DIRSTRING=" THEN                           ' 0216
  74.          X$ = MID$(A$,12)                                            ' 0216
  75.          CALL TRIM (X$)                                              ' 0216
  76.          DirString$ = X$                                             ' 0216
  77.          DirString$ = UCASE$(DirString$)                             ' 0220
  78.       END IF                                                         ' 0216
  79.    END IF
  80. WEND
  81. CLOSE 1
  82.  
  83. Replacing = (LEFT$(WriteMode$, 1) = "R")
  84.  
  85. PRINT "MAKEFIDX version 1.2 Nov 20, 1990 copyright (c) 1990 by Ken Goosens"
  86. PRINT "an RBBS utility to make files for fast directory searches"
  87. PRINT
  88. PRINT "Modified by Yaser Behbehani on October 20, 1992"              ' LRGE174/YB102001
  89. PRINT "for large FIDX/LIDX files"                                    ' LRGE174/YB102001
  90. PRINT
  91. PRINT "Modified by Richie Molinelli on April 2, 1994"
  92. PRINT "for use with PDS v7.1"
  93. PRINT                                                                ' LRGE174/YB102001
  94. PRINT "On this run"
  95. IF Replacing THEN
  96.    PRINT "Overwriting data files"
  97. ELSE
  98.    PRINT "Adding to data files"
  99. END IF
  100. PRINT "Configuration file used ....... ";ConfigFile$
  101. PRINT "Name of list of files ......... "; NameFile$
  102. PRINT "Name of list of locations ..... "; LocationFile$
  103. PRINT "# of DOS directories to process"; NumFileSpecs&
  104. PRINT "# of file lists to process ...."; NumFileDirs
  105. PRINT
  106. IF NOT RunBatch THEN
  107.    INPUT "A to abort, anything else runs"; ANS$
  108.    ANS$ = UCASE$(ANS$)
  109.    IF ANS$ = "A" THEN END
  110. END IF
  111.  
  112. IF Replacing THEN
  113.    ON ERROR GOTO 40100
  114.    KILL NameFile$
  115.    KILL LocationFile$
  116.    ON ERROR GOTO 0
  117. ELSE
  118.    IF SHARING THEN
  119.       OPEN LocationFile$ FOR INPUT SHARED AS #1
  120.    ELSE
  121.       OPEN LocationFile$ FOR INPUT AS #1
  122.    END IF
  123.    PRINT "Loading existing locations..."
  124.    WHILE NOT EOF(1)
  125.       LINE INPUT #1, A$
  126.       CALL TRIM(A$)
  127.       NumLocations& = NumLocations& + 1                              ' LRGE174/YB102001
  128.       LocationIndex$(NumLocations&) = A$                             ' LRGE174/YB102001
  129.    WEND
  130.    CLOSE 1
  131.    PRINT STR$(NumLocations&); " locations loaded"                    ' LRGE174/YB102001
  132. END IF
  133.  
  134. IF SHARING THEN
  135.    OPEN NameFile$ FOR RANDOM SHARED AS #2 LEN = 18
  136.    OPEN LocationFile$ FOR RANDOM SHARED AS #3 LEN = 66
  137. ELSE
  138.    OPEN NameFile$ FOR RANDOM AS #2 LEN = 18
  139.    OPEN LocationFile$ FOR RANDOM AS #3 LEN = 66
  140. END IF
  141. FIELD 2, 18 AS NameRec$
  142. FIELD 3, 66 AS LocationRec$
  143. MID$(NameRec$, 17, 2) = CHR$(13) + CHR$(10)
  144. MID$(LocationRec$, 64, 3) = "." + CHR$(13) + CHR$(10)
  145. NumRecsNameFile& = LOF(2) / 18                                       ' LRGE174/YB102001
  146. NumRecsLocationFile& = LOF(3) / 66                                   ' LRGE174/YB102001
  147.  
  148. InFile$ = "IDX.$$$"
  149. FOR ix = 1 TO NumFileSpecs&                                          ' LRGE174/YB102001
  150.    PRINT "Processing filespec "; FileSpec$(ix) ;                     ' 112090
  151.    GOSUB ProcessDir                                                  ' 112090
  152. NEXT
  153.  
  154. FOR ix = 1 TO NumFileDirs
  155.    InFile$ = FileDir$(ix)
  156.    PRINT "Processing file list "; FileDir$(ix) ;                     ' 112090
  157.    GOSUB ProcessFile
  158. NEXT
  159.  
  160. END
  161.  
  162. ProcessDir:                                                          ' 112090
  163.  
  164.  
  165.    FileSpec$(ix) = LTRIM$(RTRIM$(FileSpec$(ix)))                     ' RM04029401
  166.    FilName$ = DIR$(FileSpec$(ix))                                    ' RM04029401
  167.    IF FilName$ = "" THEN                                             ' RM04029401
  168.       PRINT
  169.       PRINT "   No files found"
  170.       RETURN
  171.    END IF
  172.    GOSUB SetLocIndex
  173.    RecCt = 0
  174.    PrtCol = POS(0) + 1                                               ' 112090
  175.    WHILE FilName$ <> ""                                              ' RM04029401
  176.       FileName$ = MID$(FileSpec$(ix),1,INSTR(FileSpec$(ix),"*.*") - 1) + FilName$ ' RM04029401
  177.       GOSUB AddFileName
  178.       RecCt = RecCt + 1                                              ' 112090
  179.       LOCATE ,PrtCol                                                 ' 112090
  180.       PRINT RecCt ;                                                  ' 112090
  181.       FilName$ = DIR$                                                ' RM04029401
  182.    WEND
  183.  
  184.    PRINT
  185.  
  186. RETURN
  187.  
  188. ProcessFile:
  189.  
  190.    ON ERROR GOTO 40200                                               ' 111990
  191.    IF SHARING THEN
  192.       OPEN InFile$ FOR INPUT SHARED AS #1
  193.    ELSE
  194.       OPEN InFile$ FOR INPUT AS #1
  195.    END IF
  196.    ON ERROR GOTO 0                                                   ' 111990
  197.    RecCt = 0                                                         ' 112090
  198.    PrtCol = POS(0) + 1                                               ' 112090
  199.    WHILE NOT EOF(1)
  200.       LINE INPUT #1, A$
  201.       RecCt = RecCt + 1                                              ' 112090
  202.       LOCATE ,PrtCol                                                 ' 112090
  203.       PRINT RecCt ;                                                  ' 112090
  204.       X$ = UCASE$(A$)
  205.       X = INSTR(X$, DirString$)                                      ' 0216
  206.       IF X > 0 THEN                                                  ' 0224
  207.          IF LEFT$(X$,X-1) = SPACE$(X-1) THEN                         ' 0224
  208.             DrivePath$ = MID$(A$, X + LEN(DirString$))               ' 0216
  209.             CALL TRIM(DrivePath$)
  210.             IF LEFT$(DrivePath$,3) <> "M! " THEN                     ' 0217
  211.                IF INSTR(DrivePath$,"*") > 0 OR INSTR(DrivePath$,"?") > 0 THEN  ' 0216
  212.                   CALL BRKFNAME (DrivePath$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0216
  213.                   DrivePath$ = RtnDrivePath$                         ' 0216
  214.                END IF
  215.                IF INSTR(DrivePath$, "\") > 0 THEN
  216.                   IF RIGHT$(DrivePath$, 1) <> "\" THEN
  217.                      DrivePath$ = DrivePath$ + "\"
  218.                   END IF
  219.                END IF
  220.             END IF                                                   ' 0217
  221.             CurrentDrivePath$ = DrivePath$
  222.             GOSUB SetLocIndex
  223.             GOTO DoneEntry
  224.          END IF                                                      ' 0224
  225.       END IF
  226.       IF INSTR(" .", LEFT$(A$, 1)) > 0 THEN
  227.          GOTO DoneEntry
  228.       END IF
  229.       IF LEN(A$) < StartCol THEN                                     ' 0224
  230.          GOTO DoneEntry                                              ' 0224
  231.       END IF                                                         ' 0224
  232.       IF StartCol > 1 THEN                                           ' 0224
  233.          A$ = MID$(A$,StartCol)                                      ' 0224
  234.       END IF                                                         ' 0224
  235.       X = INSTR(A$, " ")
  236.       IF X = 0 THEN                                                  ' 0217
  237.          X = LEN(A$) + 1                                             ' 0217
  238.       ELSE
  239.          IF X < 13 THEN
  240.             FileName$ = LEFT$(A$, 12)
  241.             IF INSTR(FileName$, ".") = 0 AND MID$(FileName$, 9, 1) = " " AND MID$(FileName$, 10, 1) <> " " THEN
  242.                MID$(FileName$, X) = "." + MID$(FileName$, 10) + SPACE$(9 - X)
  243.             ELSE
  244.                FileName$ = LEFT$(A$, X - 1)
  245.             END IF
  246.             GOSUB AddFileName
  247.             GOTO DoneEntry
  248.          END IF
  249.       END IF                                                         ' 0217
  250.       FileName$ = LEFT$(A$, X - 1)
  251.       CALL BRKFNAME (FileName$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0217
  252.       IF RtnDrivePath$ <> "" THEN                                    ' 0217
  253.          DrivePath$ = RtnDrivePath$                                  ' 0217
  254.          FileName$ = RtnPrefix$ + RtnExt$                            ' 0217
  255.       END IF                                                         ' 0217
  256.       GOSUB AddFileName
  257. DoneEntry:
  258.    WEND
  259. QuitEntry:                                                           ' 111990
  260.    ON ERROR GOTO 0                                                   ' 111990
  261.    CLOSE 1
  262.    PRINT                                                             ' 111990
  263. RETURN
  264.  
  265. SetPathName:
  266.  
  267.    CALL BRKFNAME(FileName$, FileDrivePath$, FilePrefix$, FileExt$, TRUE)
  268.    IF FileDrivePath$ <> "" THEN
  269.       CurrentDrivePath$ = FileDrivePath$
  270.       GOSUB SetLocIndex
  271.       FileName$ = FilePrefix$ + FileExt$
  272.    ELSE
  273.       CurrentDrivePath$ = DrivePath$
  274.    END IF
  275.  
  276. RETURN
  277.  
  278. AddFileName:
  279.  
  280.    IF LEFT$(FileName$,1) = "." OR LEFT$(FileName$,1) = "" THEN _     ' RM112001
  281.       RecCt = RecCt - 1 : _                                          ' RM111201
  282.       RETURN                                                         ' RM112001
  283.    GOSUB SetPathName
  284.    MID$(NameRec$, 1, 16) = SPACE$(16)
  285.    MID$(NameRec$, 1, 12) = FileName$
  286.    X$ = MID$(STR$(Location&), 2)                                     ' LRGE174/YB102001
  287.    X$ = SPACE$(4 - LEN(X$)) + X$
  288.    MID$(NameRec$, 13, 4) = X$
  289.    NumRecsNameFile& = NumRecsNameFile& + 1                           ' LRGE174/YB102001
  290.    PUT 2, NumRecsNameFile&                                           ' LRGE174/YB102001
  291.  
  292. RETURN
  293.  
  294. SetLocIndex:
  295.  
  296.    IF CurrentDrivePath$ = LocationIndex$(Location&) THEN RETURN      ' LRGE174/YB102001
  297.    LocationIndex$(NumRecsLocationFile& + 1) = CurrentDrivePath$      ' LRGE174/YB102001
  298.    Location& = 1                                                     ' LRGE174/YB102001
  299.    WHILE CurrentDrivePath$ <> LocationIndex$(Location&)              ' LRGE174/YB102001
  300.       Location& = Location& + 1                                      ' LRGE174/YB102001
  301.    WEND
  302.    IF Location& > NumRecsLocationFile& THEN                          ' LRGE174/YB102001
  303.       NumRecsLocationFile& = Location&                               ' LRGE174/YB102001
  304.       MID$(LocationRec$, 1, 63) = SPACE$(63)
  305.       MID$(LocationRec$, 1, 63) = CurrentDrivePath$
  306.       PUT 3, NumRecsLocationFile&                                    ' LRGE174/YB102001
  307.    END IF
  308.  
  309. RETURN
  310.  
  311. 40000 PRINT "Missing configuration file "; ConfigFile$
  312.       END
  313.  
  314. 40100 RESUME NEXT
  315. 40200 PRINT:PRINT "   ";InFile$;" not found.  Skipping";             ' 111990
  316.       RESUME QuitEntry                                               ' 111990
  317.  
  318.       SUB BRKFNAME (FileName$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING) STATIC
  319.       FileName$ = UCASE$(FileName$)
  320.       DRVPATH$ = ""
  321.       PREFIX$ = ""
  322.       EXTENSION$ = ""
  323.       CALL TRIMTRAIL(FileName$, "\")
  324.       L = LEN(FileName$)
  325.       IF L < 1 THEN EXIT SUB
  326.       CALL FINDLAST(FileName$, "\", X, Y)
  327.       IF X < 1 THEN
  328.          IF MID$(FileName$, 2, 1) = ":" THEN
  329.             DRVPATH$ = LEFT$(FileName$, 1)
  330.             S = 3
  331.          ELSE
  332.             S = 1
  333.          END IF
  334.       ELSE
  335.          DRVPATH$ = LEFT$(FileName$, X - 1)
  336.          S = X + 1
  337.          IF Y = 1 THEN
  338.             DRVPATH$ =  DRVPATH$ + "\"
  339.          END IF
  340.       END IF
  341.       X = INSTR(FileName$ + ".", ".")
  342.       IF X < L THEN
  343.          EXTENSION$ = MID$(FileName$, X + 1, 3)
  344.       END IF
  345.       IF S <= L THEN
  346.          IF X >= S THEN
  347.             PREFIX$ = MID$(FileName$, S, X - S)
  348.          END IF
  349.       END IF
  350.       IF NOT FOR.JOINING THEN EXIT SUB
  351.       IF LEN(DRVPATH$) = 1 THEN
  352.          IF DRVPATH$ <> "\" THEN
  353.             DRVPATH$ = DRVPATH$ + ":"
  354.          END IF
  355.       END IF
  356.       IF INSTR(DRVPATH$, "\") > 0 AND RIGHT$(DRVPATH$, 1) <> "\" THEN DRVPATH$ = DRVPATH$ + "\"
  357.       IF LEN(EXTENSION$) > 0 THEN EXTENSION$ = "." + EXTENSION$
  358.       END SUB
  359.  
  360.       SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND, NUM.FINDS) STATIC
  361.       WHERE.FOUND = INSTR(LOOK.IN$, LOOK.FOR$)
  362.       NUM.FINDS = -(WHERE.FOUND > 0)
  363.       NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
  364.       WHILE NEXT.FOUND > 0
  365.          NUM.FINDS = NUM.FINDS + 1
  366.          WHERE.FOUND = NEXT.FOUND
  367.          NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
  368.       WEND
  369.       END SUB
  370.  
  371.       SUB TRIM (TRIM.PARM$) STATIC
  372.       L = INSTR(TRIM.PARM$, " ")
  373.       IF L < 1 THEN EXIT SUB
  374.       IF L = 1 THEN
  375.          WHILE LEFT$(TRIM.PARM$, 1) = " "
  376.             TRIM.PARM$ = RIGHT$(TRIM.PARM$, LEN(TRIM.PARM$) - 1)
  377.          WEND
  378.       END IF
  379.       CALL TRIMTRAIL(TRIM.PARM$, " ")
  380.       END SUB
  381.  
  382.       SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$) STATIC
  383.       IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN EXIT SUB
  384.       J = LEN(TRIM.PARM$) - 1
  385. 40208 IF J > 0 THEN                                                  ' LRGE174/YB102001
  386.          IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN
  387.             J = J - 1
  388.             GOTO 40208                                               ' LRGE174/YB102001
  389.          END IF
  390.       END IF
  391.       TRIM.PARM$ = LEFT$(TRIM.PARM$, J)
  392.       END SUB
  393.  
  394.