home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / 173_UTL.ZIP / MAKETABS.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-10-25  |  3.0 KB  |  121 lines
  1. DEFINT A-Z
  2. PassedArguments$ = COMMAND$ + " "
  3. X = INSTR(" H h ? ", PassedArguments$)
  4. IF X > 0 THEN
  5.    CLS
  6.    PRINT "MAKETABS version 1.0 Copyright (c) 1989 by Ken Goosens"
  7.    PRINT "an RBBS utility to make an index tab for sorted file list"
  8.    PRINT
  9.    PRINT "Format:      MAKETABS <options>    where options are:"
  10.    PRINT
  11.    PRINT "/IN=<input file>                       Default:  FIDX.DEF"
  12.    PRINT "/OUT=<output file>                     Default:  LIDX.DEF"
  13.    PRINT "/B  (run batch)                        Default:  (no)"
  14.    PRINT "/INDEXPOS=<column position to index>   Default:  1"
  15.    IF X > 1 THEN END
  16. END IF
  17.  
  18. ' Initialize
  19.  
  20. InFile$ = "FIDX.DEF"
  21. OutFile$ = "FIDXT.DEF"
  22. IndexPos = 1
  23. TRUE = -1
  24. FALSE = 0
  25. RunBatch = FALSE
  26.  
  27. ' Process Command Line
  28.  
  29. PassedArguments$ = UCASE$(PassedArguments$)
  30. X = INSTR(PassedArguments$, "/INDEXPOS=")
  31. IF X > 0 THEN
  32.    IndexPos = VAL(MID$(PassedArguments$, X + 10))
  33. END IF
  34. X = INSTR(PassedArguments$, "/IN=")
  35. IF X > 0 THEN
  36.    Y = INSTR(X, PassedArguments$, " ")
  37.    InFile$ = MID$(PassedArguments$, X + 4, Y - X - 4)
  38. END IF
  39. X = INSTR(PassedArguments$, "/OUT=")
  40. IF X > 0 THEN
  41.    Y = INSTR(X, PassedArguments$, " ")
  42.    OutFile$ = MID$(PassedArguments$, X + 5, Y - X - 5)
  43. END IF
  44. RunBatch = (INSTR(PassedArguments$, "/B ") > 0)
  45.  
  46. PRINT
  47. PRINT "File to Create Tabs for .. "; InFile$
  48. PRINT "TAB file to make ......... "; OutFile$
  49. PRINT "Position to index ........ "; IndexPos
  50. PRINT
  51. IF NOT RunBatch THEN
  52.    INPUT "A to abort, anything else runs"; ANS$
  53.    ANS$ = UCASE$(ANS$)
  54.    IF ANS$ = "A" THEN END
  55. END IF
  56.  
  57. DIM StartPos(36)
  58. CharsCounted$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  59. OPEN InFile$ FOR INPUT AS #1
  60. FOR i = 1 TO 36
  61.    StartPos(i) = 0
  62. NEXT
  63. LinesRead = 0
  64. PRINT "Processing file "; InFile$; " ";
  65. ColPos = POS(0)
  66. WHILE NOT EOF(1)
  67.    LINE INPUT #1, A$
  68.    LinesRead = LinesRead + 1
  69.    LOCATE , ColPos
  70.    PRINT LinesRead;
  71.    IndexChar$ = MID$(A$, IndexPos, 1)
  72.    Position = INSTR(CharsCounted$, IndexChar$)
  73.    IF Position > 0 THEN
  74.       IF StartPos(Position) = 0 THEN
  75.          StartPos(Position) = LinesRead
  76.       END IF
  77.    END IF
  78. WEND
  79. CLOSE 1
  80.  
  81. OPEN OutFile$ FOR RANDOM AS #1 LEN = 72
  82. FIELD #1, 72 AS OutRec$
  83. PrevValue = 0
  84. ' put 1 in for leading 0's
  85. i = 1
  86. WHILE i < 37 AND StartPos (i) = 0
  87.    StartPos (i) = 1
  88.    i = i + 1
  89. WEND
  90. ' find last non-zero value
  91. i = 36
  92. WHILE i > 0 AND StartPos(i) = 0
  93.    i = i - 1
  94. WEND
  95. StartPos(36) = StartPos(i)
  96. ' propagate high values to left over 0's
  97. FOR i = 36 TO 1 STEP -1
  98.    IF StartPos(i) = 0 THEN
  99.       CurrentValue = 1
  100.       IF PrevValue > CurrentValue THEN
  101.          CurrentValue = PrevValue
  102.       END IF
  103.    ELSE
  104.       CurrentValue = StartPos(i)
  105.    END IF
  106.    StartPos(i) = CurrentValue
  107.    PrevValue = CurrentValue
  108. NEXT
  109. FOR i = 1 TO 36
  110.    MID$(OutRec$, 1 + 2 * (i - 1), 2) = MKI$(StartPos(i))
  111. NEXT
  112. PUT 1, 1
  113. CLOSE 1
  114. PRINT
  115. PRINT "Created TAB file "; OutFile$
  116. 'FOR i = 1 TO 36
  117. '   PRINT MID$(CharsCounted$, i, 1); StartPos(i); ". ";
  118. 'NEXT
  119. END
  120.  
  121.