5748401 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n remline.bas
   1: '
   2: '   Microsoft RemLine - Line Number Removal Utility
   3: '   Copyright (C) Microsoft Corporation 1985-1990
   4: '
   5: '   REMLINE.BAS is a program to remove line numbers from Microsoft Basic
   6: '   Programs. It removes only those line numbers that are not the object
   7: '   of one of the following statements: GOSUB, RETURN, GOTO, THEN, ELSE,
   8: '   RESUME, RESTORE, or RUN.
   9: '
  10: '   When REMLINE is run, it will ask for the name of the file to be
  11: '   processed and the name of the file or device to receive the
  12: '   reformatted output. If no extension is given, .BAS is assumed (except
  13: '   for output devices). If filenames are not given, REMLINE prompts for
  14: '   file names. If both filenames are the same, REMLINE saves the original
  15: '   file with the extension .BAK.
  16: '
  17: '   REMLINE makes several assumptions about the program:
  18: '
  19: '     1. It must be correct syntactically, and must run in BASICA or
  20: '        GW-BASIC interpreter.
  21: '     2. There is a 400 line limit. To process larger files, change
  22: '        MaxLines constant.
  23: '     3. The first number encountered on a line is considered a line
  24: '        number; thus some continuation lines (in a compiler-specific
  25: '        construction) may not be handled correctly.
  26: '     4. REMLINE can handle simple statements that test the ERL function
  27: '        using  relational operators such as =, <, and >. For example,
  28: '        the following statement is handled correctly:
  29: '
  30: '             IF ERL = 100 THEN END
  31: '
  32: '        Line 100 is not removed from the source code. However, more
  33: '        complex expressions that contain the +, -, AND, OR, XOR, EQV,
  34: '        MOD, or IMP operators may not be handled correctly. For example,
  35: '        in the following statement REMLINE does not recognize line 105
  36: '        as a referenced line number and removes it from the source code:
  37: '
  38: '             IF ERL + 5 = 105 THEN END
  39: '
  40: '   If you do not like the way REMLINE formats its output, you can modify
  41: '   the output lines in SUB GenOutFile. An example is shown in comments.
  42: DEFINT A-Z
  43: 
  44: ' Function and Subprocedure declarations
  45: DECLARE FUNCTION GetToken$ (Search$, Delim$)
  46: DECLARE FUNCTION StrSpn% (InString$, Separator$)
  47: DECLARE FUNCTION StrBrk% (InString$, Separator$)
  48: DECLARE FUNCTION IsDigit% (Char$)
  49: DECLARE SUB GetFileNames ()
  50: DECLARE SUB BuildTable ()
  51: DECLARE SUB GenOutFile ()
  52: DECLARE SUB InitKeyTable ()
  53: 
  54: ' Global and constant data
  55: CONST TRUE = -1
  56: CONST false = 0
  57: CONST MaxLines = 400
  58: 
  59: DIM SHARED LineTable!(MaxLines)
  60: DIM SHARED LineCount
  61: DIM SHARED Seps$, InputFile$, OutputFile$, TmpFile$
  62: 
  63: ' Keyword search data
  64: CONST KeyWordCount = 9
  65: DIM SHARED KeyWordTable$(KeyWordCount)
  66: 
  67: KeyData:
  68:    DATA THEN, ELSE, GOSUB, GOTO, RESUME, RETURN, RESTORE, RUN, ERL, ""
  69: 
  70: ' Start of module-level program code
  71:    Seps$ = " ,:=<>()" + CHR$(9)
  72:    InitKeyTable
  73:    GetFileNames
  74:    ON ERROR GOTO FileErr1
  75:    OPEN InputFile$ FOR INPUT AS 1
  76:    ON ERROR GOTO 0
  77:    COLOR 7: PRINT "Working"; : COLOR 23: PRINT " . . .": COLOR 7: PRINT
  78:    BuildTable
  79:    CLOSE #1
  80:    OPEN InputFile$ FOR INPUT AS 1
  81:    ON ERROR GOTO FileErr2
  82:    OPEN OutputFile$ FOR OUTPUT AS 2
  83:    ON ERROR GOTO 0
  84:    GenOutFile
  85:    CLOSE #1, #2
  86:    IF OutputFile$ <> "CON" THEN CLS
  87: 
  88: END
  89: 
  90: FileErr1:
  91:    CLS
  92:    PRINT "      Invalid file name": PRINT
  93:    INPUT "      New input file name (ENTER to terminate): ", InputFile$
  94:    IF InputFile$ = "" THEN END
  95: FileErr2:
  96:    INPUT "      Output file name (ENTER to print to screen) :", OutputFile$
  97:    PRINT
  98:    IF (OutputFile$ = "") THEN OutputFile$ = "CON"
  99:    IF TmpFile$ = "" THEN
 100:       RESUME
 101:    ELSE
 102:       TmpFile$ = ""
 103:       RESUME NEXT
 104:    END IF
 105: 
 106: '
 107: ' BuildTable:
 108: '   Examines the entire text file looking for line numbers that are
 109: '   the object of GOTO, GOSUB, etc. As each is found, it is entered
 110: '   into a table of line numbers. The table is used during a second
 111: '   pass (see GenOutFile), when all line numbers not in the list
 112: '   are removed.
 113: ' Input:
 114: '   Uses globals KeyWordTable$, KeyWordCount, and Seps$
 115: ' Output:
 116: '   Modifies LineTable! and LineCount
 117: '
 118: SUB BuildTable STATIC
 119: 
 120:    DO WHILE NOT EOF(1)
 121:       ' Get line and first token
 122:       LINE INPUT #1, InLin$
 123:       Token$ = GetToken$(InLin$, Seps$)
 124:       DO WHILE (Token$ <> "")
 125:          FOR KeyIndex = 1 TO KeyWordCount
 126:             ' See if token is keyword
 127:             IF (KeyWordTable$(KeyIndex) = UCASE$(Token$)) THEN
 128:                ' Get possible line number after keyword
 129:                Token$ = GetToken$("", Seps$)
 130:                ' Check each token to see if it is a line number
 131:                ' (the LOOP is necessary for the multiple numbers
 132:                ' of ON GOSUB or ON GOTO). A non-numeric token will
 133:                ' terminate search.
 134:                DO WHILE (IsDigit(LEFT$(Token$, 1)))
 135:                   LineCount = LineCount + 1
 136:                   LineTable!(LineCount) = VAL(Token$)
 137:                   Token$ = GetToken$("", Seps$)
 138:                   IF Token$ <> "" THEN KeyIndex = 0
 139:                LOOP
 140:             END IF
 141:          NEXT KeyIndex
 142:          ' Get next token
 143:          Token$ = GetToken$("", Seps$)
 144:       LOOP
 145:    LOOP
 146: 
 147: END SUB
 148: 
 149: '
 150: ' GenOutFile:
 151: '  Generates an output file with unreferenced line numbers removed.
 152: ' Input:
 153: '  Uses globals LineTable!, LineCount, and Seps$
 154: ' Output:
 155: '  Processed file
 156: '
 157: SUB GenOutFile STATIC
 158: 
 159:    ' Speed up by eliminating comma and colon (can't separate first token)
 160:    Sep$ = " " + CHR$(9)
 161:    DO WHILE NOT EOF(1)
 162:       LINE INPUT #1, InLin$
 163:       IF (InLin$ <> "") THEN
 164:          ' Get first token and process if it is a line number
 165:          Token$ = GetToken$(InLin$, Sep$)
 166:          IF IsDigit(LEFT$(Token$, 1)) THEN
 167:             LineNumber! = VAL(Token$)
 168:             FoundNumber = false
 169:             ' See if line number is in table of referenced line numbers
 170:             FOR index = 1 TO LineCount
 171:                IF (LineNumber! = LineTable!(index)) THEN
 172:                   FoundNumber = TRUE
 173:                END IF
 174:             NEXT index
 175:             ' Modify line strings
 176:             IF (NOT FoundNumber) THEN
 177:                Token$ = SPACE$(LEN(Token$))
 178:                MID$(InLin$, StrSpn(InLin$, Sep$), LEN(Token$)) = Token$
 179:             END IF
 180:               
 181:             ' You can replace the previous lines with your own
 182:             ' code to reformat output. For example, try these lines:
 183:                
 184:             'TmpPos1 = StrSpn(InLin$, Sep$) + LEN(Token$)
 185:             'TmpPos2 = TmpPos1 + StrSpn(MID$(InLin$, TmpPos1), Sep$)
 186:             '
 187:             'IF FoundNumber THEN
 188:             '   InLin$ = LEFT$(InLin$, TmpPos1 - 1) + CHR$(9) + MID$(InLin$, TmpPos2)
 189:             'ELSE
 190:             '   InLin$ = CHR$(9) + MID$(InLin$, TmpPos2)
 191:             'END IF
 192: 
 193:          END IF
 194:       END IF
 195:       ' Print line to file or console (PRINT is faster than console device)
 196:       IF OutputFile$ = "CON" THEN
 197:          PRINT InLin$
 198:       ELSE
 199:          PRINT #2, InLin$
 200:       END IF
 201:    LOOP
 202: 
 203: END SUB
 204: 
 205: '
 206: ' GetFileNames:
 207: '  Gets a file name by prompting the user.
 208: ' Input:
 209: '  User input
 210: ' Output:
 211: '  Defines InputFiles$ and OutputFiles$
 212: '
 213: SUB GetFileNames STATIC
 214: 
 215:     CLS
 216:     PRINT " Microsoft RemLine: Line Number Removal Utility"
 217:     PRINT "       (.BAS assumed if no extension given)"
 218:     PRINT
 219:     INPUT "      Input file name (ENTER to terminate): ", InputFile$
 220:     IF InputFile$ = "" THEN END
 221:     INPUT "      Output file name (ENTER to print to screen): ", OutputFile$
 222:     PRINT
 223:     IF (OutputFile$ = "") THEN OutputFile$ = "CON"
 224: 
 225:    IF INSTR(InputFile$, ".") = 0 THEN
 226:       InputFile$ = InputFile$ + ".BAS"
 227:    END IF
 228: 
 229:    IF INSTR(OutputFile$, ".") = 0 THEN
 230:       SELECT CASE OutputFile$
 231:          CASE "CON", "SCRN", "PRN", "COM1", "COM2", "LPT1", "LPT2", "LPT3"
 232:             EXIT SUB
 233:          CASE ELSE
 234:             OutputFile$ = OutputFile$ + ".BAS"
 235:       END SELECT
 236:    END IF
 237: 
 238:    DO WHILE InputFile$ = OutputFile$
 239:       TmpFile$ = LEFT$(InputFile$, INSTR(InputFile$, ".")) + "BAK"
 240:       ON ERROR GOTO FileErr1
 241:       NAME InputFile$ AS TmpFile$
 242:       ON ERROR GOTO 0
 243:       IF TmpFile$ <> "" THEN InputFile$ = TmpFile$
 244:    LOOP
 245: 
 246: END SUB
 247: 
 248: '
 249: ' GetToken$:
 250: '  Extracts tokens from a string. A token is a word that is surrounded
 251: '  by separators, such as spaces or commas. Tokens are extracted and
 252: '  analyzed when parsing sentences or commands. To use the GetToken$
 253: '  function, pass the string to be parsed on the first call, then pass
 254: '  a null string on subsequent calls until the function returns a null
 255: '  to indicate that the entire string has been parsed.
 256: ' Input:
 257: '  Search$ = string to search
 258: '  Delim$  = String of separators
 259: ' Output:
 260: '  GetToken$ = next token
 261: '
 262: FUNCTION GetToken$ (Search$, Delim$) STATIC
 263: 
 264:    ' Note that SaveStr$ and BegPos must be static from call to call
 265:    ' (other variables are only static for efficiency).
 266:    ' If first call, make a copy of the string
 267:    IF (Search$ <> "") THEN
 268:       BegPos = 1
 269:       SaveStr$ = Search$
 270:    END IF
 271:   
 272:    ' Find the start of the next token
 273:    NewPos = StrSpn(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)
 274:    IF NewPos THEN
 275:       ' Set position to start of token
 276:       BegPos = NewPos + BegPos - 1
 277:    ELSE
 278:       ' If no new token, quit and return null
 279:       GetToken$ = ""
 280:       EXIT FUNCTION
 281:    END IF
 282: 
 283:    ' Find end of token
 284:    NewPos = StrBrk(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)
 285:    IF NewPos THEN
 286:       ' Set position to end of token
 287:       NewPos = BegPos + NewPos - 1
 288:    ELSE
 289:       ' If no end of token, return set to end a value
 290:       NewPos = LEN(SaveStr$) + 1
 291:    END IF
 292:    ' Cut token out of search string
 293:    GetToken$ = MID$(SaveStr$, BegPos, NewPos - BegPos)
 294:    ' Set new starting position
 295:    BegPos = NewPos
 296: 
 297: END FUNCTION
 298: 
 299: '
 300: ' InitKeyTable:
 301: '  Initializes a keyword table. Keywords must be recognized so that
 302: '  line numbers can be distinguished from numeric constants.
 303: ' Input:
 304: '  Uses KeyData
 305: ' Output:
 306: '  Modifies global array KeyWordTable$
 307: '
 308: SUB InitKeyTable STATIC
 309: 
 310:    RESTORE KeyData
 311:    FOR Count = 1 TO KeyWordCount
 312:       READ KeyWord$
 313:       KeyWordTable$(Count) = KeyWord$
 314:    NEXT
 315: 
 316: END SUB
 317: 
 318: '
 319: ' IsDigit:
 320: '  Returns true if character passed is a decimal digit. Since any
 321: '  Basic token starting with a digit is a number, the function only
 322: '  needs to check the first digit. Doesn't check for negative numbers,
 323: '  but that's not needed here.
 324: ' Input:
 325: '  Char$ - initial character of string to check
 326: ' Output:
 327: '  IsDigit - true if within 0 - 9
 328: '
 329: FUNCTION IsDigit (Char$) STATIC
 330: 
 331:    IF (Char$ = "") THEN
 332:       IsDigit = false
 333:    ELSE
 334:       CharAsc = ASC(Char$)
 335:       IsDigit = (CharAsc >= ASC("0")) AND (CharAsc <= ASC("9"))
 336:    END IF
 337: 
 338: END FUNCTION
 339: 
 340: '
 341: ' StrBrk:
 342: '  Searches InString$ to find the first character from among those in
 343: '  Separator$. Returns the index of that character. This function can
 344: '  be used to find the end of a token.
 345: ' Input:
 346: '  InString$ = string to search
 347: '  Separator$ = characters to search for
 348: ' Output:
 349: '  StrBrk = index to first match in InString$ or 0 if none match
 350: '
 351: FUNCTION StrBrk (InString$, Separator$) STATIC
 352: 
 353:    Ln = LEN(InString$)
 354:    BegPos = 1
 355:    ' Look for end of token (first character that is a delimiter).
 356:    DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1)) = 0
 357:       IF BegPos > Ln THEN
 358:          StrBrk = 0
 359:          EXIT FUNCTION
 360:       ELSE
 361:          BegPos = BegPos + 1
 362:       END IF
 363:    LOOP
 364:    StrBrk = BegPos
 365:   
 366: END FUNCTION
 367: 
 368: '
 369: ' StrSpn:
 370: '  Searches InString$ to find the first character that is not one of
 371: '  those in Separator$. Returns the index of that character. This
 372: '  function can be used to find the start of a token.
 373: ' Input:
 374: '  InString$ = string to search
 375: '  Separator$ = characters to search for
 376: ' Output:
 377: '  StrSpn = index to first nonmatch in InString$ or 0 if all match
 378: '
 379: FUNCTION StrSpn% (InString$, Separator$) STATIC
 380: 
 381:    Ln = LEN(InString$)
 382:    BegPos = 1
 383:    ' Look for start of a token (character that isn't a delimiter).
 384:    DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1))
 385:       IF BegPos > Ln THEN
 386:          StrSpn = 0
 387:          EXIT FUNCTION
 388:       ELSE
 389:          BegPos = BegPos + 1
 390:       END IF
 391:    LOOP
 392:    StrSpn = BegPos
 393: 
 394: END FUNCTION
 395: 
5748402 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:08:38