home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / TEXT / UTILITY / DFUTIL2.ZIP / FASCII.ZIP / FASCII.BAS next >
Encoding:
BASIC Source File  |  1990-11-10  |  4.3 KB  |  166 lines
  1. 'FASCII replaces any ASCII code in a file with another, or deletes it
  2. '
  3. ' $INCLUDE: 'qb.bi'
  4.  
  5. DECLARE FUNCTION exists (filename$)
  6.  
  7. DIM SHARED inregs AS RegTypeX, outregs AS RegTypeX
  8. CONST YES = 1, NO = 0
  9.   
  10.     com$ = COMMAND$
  11.     DIM arg$(10)
  12.     FOR n = 1 TO 5: arg$(n) = "": NEXT
  13.     length = LEN(com$)
  14.     true = -1: false = 0: i = 1: num = 1: inword = true
  15.     WHILE i <= length
  16.         ch$ = MID$(com$, i, 1)
  17.         IF ch$ <> " " THEN
  18.             IF NOT inword THEN inword = true
  19.             arg$(num) = arg$(num) + ch$
  20.         ELSEIF inword THEN
  21.             num = num + 1
  22.             inword = false
  23.         END IF
  24.         i = i + 1
  25.     WEND
  26.     y = 1
  27.     IF NOT arg$(1) = "" THEN GOTO BEGINNING
  28. HELP:
  29.     PRINT " "
  30.     PRINT "FASCII replaces ASCII codes in a file. "
  31.     PRINT "(c) 1990 David A. Wesson"
  32.     PRINT " "
  33.     PRINT "Syntax: FASCII  [d:]filename  oldcode  newcode"
  34.     PRINT " where  filename = original file  [drive optional]      "
  35.     PRINT "        oldcode  = old ASCII code to be replaced"
  36.     PRINT "        newcode  = new ASCII code to be substituted"
  37.     PRINT "                   (Leave blank to delete oldcode)"
  38.     PRINT " "
  39.     PRINT "Type    FASCII C  to review ASCII code chart."
  40.     PRINT ""
  41.     PRINT "NOTE: Lines may not be longer than 132 characters."
  42.     PRINT "      This program makes a backup of the original file"
  43.     PRINT "      named filename.OLD "
  44.     END
  45. BEGINNING:
  46.     infile$ = UCASE$(arg$(1))
  47.     IF infile$ = "C" THEN GOSUB ASCII
  48.     IF exists(infile$) = NO THEN GOTO nofind
  49.         OPEN infile$ FOR INPUT AS #1
  50.     outfile$ = "temp"
  51.     OPEN outfile$ FOR OUTPUT AS #2
  52.     GOSUB filename
  53.     oldfile$ = UCASE$(file$) + ".OLD"
  54.     oldcode = VAL(arg$(2))
  55.     newcode = VAL(arg$(3))
  56.     IF oldcode = 0 THEN GOTO NOCODE
  57.     IF NOT newcode = 0 THEN newcode = VAL(arg$(3))
  58.     IF newcode = oldcode GOTO BADCODE
  59. ROUTINE:
  60.     a = oldcode
  61.     b = newcode
  62.     old$ = CHR$(a)
  63.     IF b = 0 THEN new$ = "NOTHING" ELSE new$ = CHR$(b)
  64.     COLOR 15: PRINT "FASCII "; : COLOR 7: PRINT "Fast ASCII code replacer "
  65.     PRINT "Replacing "; old$; " with "; new$; " in "; infile$; ", creating "; oldfile$
  66.     PRINT "Hit [Ctrl]+[Break] to terminate"
  67.     PRINT "Starting time: "; TIME$
  68.     PRINT "   Processing: ";
  69.     z = 0
  70. CYCLE:
  71.     IF EOF(1) THEN GOTO FINISH
  72.     LINE INPUT #1, l$
  73.     z = z + 1
  74.     strt = 1
  75.     LOCATE , 15: PRINT z;
  76. search:
  77.     lfpos = INSTR(strt, l$, CHR$(a))
  78.     IF lfpos < 1 THEN GOTO DUMP
  79.     GOTO SPLIT
  80. NEXTLOOK:
  81.      strt = lfpos + 1: GOTO search
  82. SPLIT:
  83.      lpart$ = LEFT$(l$, lfpos - 1)
  84.      rpart$ = RIGHT$(l$, LEN(l$) - lfpos)
  85.      IF b > 0 THEN
  86.          s$ = lpart$ + CHR$(b) + rpart$
  87.      ELSE s$ = lpart$ + rpart$
  88.      END IF
  89.      l$ = s$
  90.      GOTO NEXTLOOK
  91. NEWOUT:
  92.     PRINT #2, s$
  93.     GOTO CYCLE
  94. DUMP:
  95.     PRINT #2, l$
  96.     GOTO CYCLE
  97. NOCODE:
  98.     PRINT "ERROR: Missing ASCII code."
  99.     GOTO HELP
  100. BADCODE:
  101.     PRINT "ERROR: Old and new ASCII codes cannot be identical."
  102.     GOTO HELP
  103. nofind:
  104.     PRINT "ERROR: No file by that name found."
  105.     GOTO HELP
  106. BADFILE:
  107.     PRINT "ERROR: File already exists."
  108.     END
  109. FINISH:
  110.     CLOSE
  111.     IF exists(oldfile$) = YES THEN KILL oldfile$
  112.     NAME infile$ AS oldfile$
  113.     NAME outfile$ AS infile$
  114.     PRINT ""
  115.     PRINT "  Finish time: "; TIME$
  116.     END
  117. ASCII:
  118.     CLS
  119.     FOR c = 0 TO 255
  120.         LOCATE INT(c - (INT(c / 20) * 20) + 1), INT(c / 20) * 6 + 1
  121.         PRINT USING "### "; c;
  122.     IF c = 7 OR (c >= 9 AND c <= 13) OR (c >= 29 AND c <= 31) THEN GOTO BLANK
  123.     COLOR 15: PRINT CHR$(c); : COLOR 7: PRINT CHR$(186)
  124.     GOTO NEXTC
  125. BLANK:
  126.         COLOR 15: PRINT " "; : COLOR 7: PRINT CHR$(186)
  127. NEXTC:
  128.         NEXT c
  129.     LOCATE 22, 1: PRINT "  0 = NULL   7 = BELL   9 = HTAB   10 = LINEFEED   11 = VTAB   12 = FORMFEED"
  130.     LOCATE 23, 1: PRINT " 13 = CARRAGE RETURN   28 = FS   29 = GS   30 = RS   31 = US   32 = SPACE"
  131.     LOCATE 25, 27
  132.     COLOR 15
  133.     PRINT "Hit any key to continue";
  134.     COLOR 7
  135. in: w$ = INKEY$: IF w$ = "" THEN GOTO in
  136.     CLS
  137.     GOTO HELP
  138. filename:                                         'splits infile$ into
  139.         period = INSTR(infile$, ".")              'file$ and ext$
  140.         IF period = 0 THEN
  141.             file$ = infile$
  142.             ext$ = ""
  143.             ELSE
  144.                 file$ = LEFT$(infile$, period - 1)
  145.  
  146.                 ext$ = MID$(infile$, period + 1)
  147.         END IF
  148.         RETURN
  149.  
  150. FUNCTION exists (search$)
  151.      savefile$ = search$
  152.      inregs.ax = &H4E00
  153.      inregs.cx = 1     '3 for hidden
  154.      search$ = search$ + CHR$(0)
  155.      inregs.dx = SADD(search$)
  156.      inregs.ds = -1
  157.      CALL INTERRUPTX(&H21, inregs, outregs)
  158.      IF (outregs.flags AND 1) = 1 THEN
  159.             exists = NO
  160.      ELSE
  161.             exists = YES
  162.      END IF
  163.      search$ = savefile$
  164. END FUNCTION
  165.  
  166.