home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / 173_UTL.ZIP / MAKEFIDX.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-11-05  |  8.7 KB  |  314 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$(255)
  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. SHARING = FALSE
  15. NumLocations = 0
  16. NumFileSpecs = 0
  17. NumFileDirs = 0
  18. ConfigFile$ = "MAKEFIDX.CFG"
  19. PassedArguments$ = COMMAND$
  20. PassedArguments$ = UCASE$(PassedArguments$) 
  21. X = INSTR(PassedArguments$,"/B")
  22. RunBatch = (X > 0)
  23. IF RunBatch THEN 
  24.    PassedArguments$ = LEFT$(PassedArguments$, X-1) + RIGHT$(PassedArguments$,Len(PassedArguments$)-X-1)
  25. END IF
  26. IF PassedArguments$ <> "" THEN
  27.    ConfigFile$ = PassedArguments$
  28. END IF
  29.  
  30. ON ERROR GOTO 40000
  31. IF SHARING THEN
  32.    OPEN ConfigFile$ FOR INPUT SHARED AS #1
  33. ELSE
  34.    OPEN ConfigFile$ FOR INPUT AS #1
  35. END IF
  36. ON ERROR GOTO 0
  37. WHILE NOT EOF(1)
  38.    LINE INPUT #1, A$
  39.    X$ = LEFT$(A$, 1)
  40.    IF X$ <> "" AND X$ <> "*" THEN
  41.       A$ = UCASE$(A$) 
  42.       IF LEFT$(A$,11) = "/WRITEMODE=" THEN
  43.          WriteMode$ = MID$(A$,12)
  44.          CALL TRIM (WriteMode$)
  45.       END IF
  46.       IF LEFT$(A$, 10) = "/NAMEFILE=" THEN
  47.          NameFile$ = MID$(A$, 11)
  48.          CALL TRIM(NameFile$)
  49.       END IF
  50.       IF LEFT$(A$, 14) = "/LOCATIONFILE=" THEN
  51.          LocationFile$ = MID$(A$, 15)
  52.          CALL TRIM(LocationFile$)
  53.       END IF
  54.       IF LEFT$(A$, 10) = "/FILESPEC=" THEN
  55.          X$ = MID$(A$, 11)
  56.          CALL TRIM(X$)
  57.          NumFileSpecs = NumFileSpecs + 1
  58.          FileSpec$(NumFileSpecs) = X$
  59.       END IF
  60.       IF LEFT$(A$, 9) = "/FILEDIR=" THEN
  61.          X$ = MID$(A$, 10)
  62.          CALL TRIM(X$)
  63.          NumFileDirs = NumFileDirs + 1
  64.          FileDir$(NumFileDirs) = X$
  65.       END IF
  66.    END IF
  67. WEND
  68. CLOSE 1
  69.  
  70. Replacing = (LEFT$(WriteMode$, 1) = "R")
  71.  
  72. PRINT "MAKEFIDX version 1.0 copyright (c) 1989 by Ken Goosens"
  73. PRINT "an RBBS utility to make files for fast directory searches"
  74. PRINT
  75. PRINT "On this run"
  76. IF Replacing THEN
  77.    PRINT "Overwriting data files"
  78. ELSE
  79.    PRINT "Adding to data files"
  80. END IF
  81. PRINT "Configuration file used ....... ";ConfigFile$
  82. PRINT "Name of list of files ......... "; NameFile$
  83. PRINT "Name of list of locations ..... "; LocationFile$
  84. PRINT "# of DOS directories to process"; NumFileSpecs
  85. PRINT "# of file lists to process ...."; NumFileDirs
  86. PRINT
  87. IF NOT RunBatch THEN
  88.    INPUT "A to abort, anything else runs"; ANS$
  89.    ANS$ = UCASE$(ANS$)
  90.    IF ANS$ = "A" THEN END
  91. END IF
  92.  
  93. 'NumFileSpecs = 2
  94. 'FileSpec$(1) = "C:\TEMP\"
  95. 'FileSpec$(2) = "C:\UTILS\"
  96. IF Replacing THEN
  97.    ON ERROR GOTO 40100
  98.    KILL NameFile$
  99.    KILL LocationFile$
  100.    ON ERROR GOTO 0
  101. ELSE
  102.    IF SHARING THEN
  103.       OPEN LocationFile$ FOR INPUT SHARED AS #1
  104.    ELSE
  105.       OPEN LocationFile$ FOR INPUT AS #1
  106.    END IF
  107.    PRINT "Loading existing locations..."
  108.    WHILE NOT EOF(1)
  109.       LINE INPUT #1, A$
  110.       CALL TRIM(A$)
  111.       NumLocations = NumLocations + 1
  112.       LocationIndex$(NumLocations) = A$
  113.    WEND
  114.    CLOSE 1
  115.    PRINT STR$(NumLocations); " locations loaded"
  116. END IF
  117.  
  118. IF SHARING THEN
  119.    OPEN NameFile$ FOR RANDOM SHARED AS #2 LEN = 18
  120.    OPEN LocationFile$ FOR RANDOM SHARED AS #3 LEN = 66
  121. ELSE
  122.    OPEN NameFile$ FOR RANDOM AS #2 LEN = 18
  123.    OPEN LocationFile$ FOR RANDOM AS #3 LEN = 66
  124. END IF
  125. FIELD 2, 18 AS NameRec$
  126. FIELD 3, 66 AS LocationRec$
  127. MID$(NameRec$, 17, 2) = CHR$(13) + CHR$(10)
  128. MID$(LocationRec$, 64, 3) = "." + CHR$(13) + CHR$(10)
  129. NumRecsNameFile = LOF(2) / 18
  130. NumRecsLocationFile = LOF(3) / 66
  131.  
  132. InFile$ = "IDX.$$$"
  133. FOR ix = 1 TO NumFileSpecs
  134.    SHELL "DIR " + FileSpec$(ix) + " > IDX.$$$"
  135.    PRINT "Processing filespec "; FileSpec$(ix)
  136.    GOSUB ProcessFile
  137. NEXT
  138.  
  139. FOR ix = 1 TO NumFileDirs
  140.    InFile$ = FileDir$(ix)
  141.    PRINT "Processing file list "; FileDir$(ix)
  142.    GOSUB ProcessFile
  143. NEXT
  144.  
  145. END
  146.  
  147. ProcessFile:
  148.  
  149.    IF SHARING THEN
  150.       OPEN InFile$ FOR INPUT SHARED AS #1
  151.    ELSE
  152.       OPEN InFile$ FOR INPUT AS #1
  153.    END IF
  154.    WHILE NOT EOF(1)
  155.       LINE INPUT #1, A$
  156.       X = INSTR(A$, "Directory of ")
  157.       IF X > 0 THEN
  158.          DrivePath$ = MID$(A$, X + 12)
  159.          CALL TRIM(DrivePath$)
  160.          IF INSTR(DrivePath$, "\") > 0 THEN
  161.             IF RIGHT$(DrivePath$, 1) <> "\" THEN
  162.                DrivePath$ = DrivePath$ + "\"
  163.             END IF
  164.          END IF
  165.          CurrentDrivePath$ = DrivePath$
  166.          GOSUB SetLocIndex
  167.          GOTO DoneEntry
  168.       END IF
  169.       IF INSTR(" .", LEFT$(A$, 1)) > 0 THEN
  170.          GOTO DoneEntry
  171.       END IF
  172.       X = INSTR(A$, " ")
  173.       IF X < 13 THEN
  174.          FILENAME$ = LEFT$(A$, 12)
  175.          IF INSTR(FILENAME$, ".") = 0 AND MID$(FILENAME$, 9, 1) = " " AND MID$(FILENAME$, 10, 1) <> " " THEN
  176.             MID$(FILENAME$, X) = "." + MID$(FILENAME$, 10) + SPACE$(9 - X)
  177.          ELSE
  178.             FILENAME$ = LEFT$(A$, X - 1)
  179.          END IF
  180.          GOSUB AddFileName
  181.          GOTO DoneEntry
  182.       END IF
  183.       FILENAME$ = LEFT$(A$, X - 1)
  184.       GOSUB AddFileName
  185. DoneEntry:
  186.    WEND
  187.    CLOSE 1
  188. RETURN
  189.  
  190. SetPathName:
  191.  
  192.    CALL BRKFNAME(FILENAME$, FileDrivePath$, FilePrefix$, FileExt$, TRUE)
  193.    IF FileDrivePath$ <> "" THEN
  194.       CurrentDrivePath$ = FileDrivePath$
  195.       GOSUB SetLocIndex
  196.       FILENAME$ = FilePrefix$ + FileExt$
  197.    ELSE
  198.       CurrentDrivePath$ = DrivePath$
  199.    END IF
  200.  
  201. RETURN
  202.  
  203. AddFileName:
  204.  
  205.    GOSUB SetPathName
  206.    MID$(NameRec$, 1, 16) = SPACE$(16)
  207.    MID$(NameRec$, 1, 12) = FILENAME$
  208.    X$ = MID$(STR$(Location), 2)
  209.    X$ = SPACE$(4 - LEN(X$)) + X$
  210.    MID$(NameRec$, 13, 4) = X$
  211.    NumRecsNameFile = NumRecsNameFile + 1
  212.    PUT 2, NumRecsNameFile
  213.  
  214. RETURN
  215.  
  216. SetLocIndex:
  217.  
  218.    IF CurrentDrivePath$ = LocationIndex$(Location) THEN RETURN
  219.    LocationIndex$(NumRecsLocationFile + 1) = CurrentDrivePath$
  220.    Location = 1
  221.    WHILE CurrentDrivePath$ <> LocationIndex$(Location)
  222.       Location = Location + 1
  223.    WEND
  224.    IF Location > NumRecsLocationFile THEN
  225.       NumRecsLocationFile = Location
  226.       MID$(LocationRec$, 1, 63) = SPACE$(63)
  227.       MID$(LocationRec$, 1, 63) = CurrentDrivePath$
  228.       PUT 3, NumRecsLocationFile
  229.    END IF
  230.  
  231. RETURN
  232.  
  233. 40000 PRINT "Missing configuration file "; ConfigFile$
  234.       END
  235.  
  236. 40100 RESUME NEXT
  237.  
  238.       SUB BRKFNAME (FILENAME$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING) STATIC
  239.       FILENAME$ = UCASE$(FILENAME$)
  240.       DRVPATH$ = ""
  241.       PREFIX$ = ""
  242.       EXTENSION$ = ""
  243.       CALL TRIMTRAIL(FILENAME$, "\")
  244.       L = LEN(FILENAME$)
  245.       IF L < 1 THEN EXIT SUB
  246.       CALL FINDLAST(FILENAME$, "\", X, Y)
  247.       IF X < 1 THEN
  248.          IF MID$(FILENAME$, 2, 1) = ":" THEN
  249.             DRVPATH$ = LEFT$(FILENAME$, 1)
  250.             S = 3
  251.          ELSE
  252.             S = 1
  253.          END IF
  254.       ELSE
  255.          DRVPATH$ = LEFT$(FILENAME$, X - 1)
  256.          S = X + 1
  257.          IF Y = 1 THEN
  258.             DRVPATH$ =  DRVPATH$ + "\"
  259.          END IF
  260.       END IF
  261.       X = INSTR(FILENAME$ + ".", ".")
  262.       IF X < L THEN
  263.          EXTENSION$ = MID$(FILENAME$, X + 1, 3)
  264.       END IF
  265.       IF S <= L THEN
  266.          IF X >= S THEN
  267.             PREFIX$ = MID$(FILENAME$, S, X - S)
  268.          END IF
  269.       END IF
  270.       IF NOT FOR.JOINING THEN EXIT SUB
  271.       IF LEN(DRVPATH$) = 1 THEN
  272.          IF DRVPATH$ <> "\" THEN
  273.             DRVPATH$ = DRVPATH$ + ":"
  274.          END IF
  275.       END IF
  276.       IF INSTR(DRVPATH$, "\") > 0 AND RIGHT$(DRVPATH$, 1) <> "\" THEN DRVPATH$ = DRVPATH$ + "\"
  277.       IF LEN(EXTENSION$) > 0 THEN EXTENSION$ = "." + EXTENSION$
  278.       END SUB
  279.  
  280.       SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND, NUM.FINDS) STATIC
  281.       WHERE.FOUND = INSTR(LOOK.IN$, LOOK.FOR$)
  282.       NUM.FINDS = -(WHERE.FOUND > 0)
  283.       NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
  284.       WHILE NEXT.FOUND > 0
  285.          NUM.FINDS = NUM.FINDS + 1
  286.          WHERE.FOUND = NEXT.FOUND
  287.          NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
  288.       WEND
  289.       END SUB
  290.  
  291.       SUB TRIM (TRIM.PARM$) STATIC
  292.       L = INSTR(TRIM.PARM$, " ")
  293.       IF L < 1 THEN EXIT SUB
  294.       IF L = 1 THEN
  295.          WHILE LEFT$(TRIM.PARM$, 1) = " "
  296.             TRIM.PARM$ = RIGHT$(TRIM.PARM$, LEN(TRIM.PARM$) - 1)
  297.          WEND
  298.       END IF
  299.       CALL TRIMTRAIL(TRIM.PARM$, " ")
  300.       END SUB
  301.  
  302.       SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$) STATIC
  303.       IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN EXIT SUB                                                             ' KG081003
  304.       J = LEN(TRIM.PARM$) - 1                                        ' KG081003
  305. 108   IF J > 0 THEN
  306.          IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN
  307.             J = J - 1
  308.             GOTO 108
  309.          END IF
  310.       END IF
  311.       TRIM.PARM$ = LEFT$(TRIM.PARM$, J)                              ' KG081003
  312.       END SUB
  313.  
  314.