ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/TEXT/UTILITY/DFUTIL1.ZIP/SHIFTER.ZIP/SHIFTER.BAS

BASIC Source File | 1990-11-11 | 4.7 KB | 176 lines

DECLARE SUB parsecommand ()
'SHIFTER switches all Upper to lowercase and vice versa,
' excepting text included in quote marks
'
' $INCLUDE: 'qb.bi'

DECLARE FUNCTION exists (filename$)

CONST YES = 1, NO = 0
DIM SHARED inregs AS RegTypeX, outregs AS RegTypeX
DIM SHARED arg$(10)

      parsecommand
      infile$ = arg$(1)
      IF infile$ = "" THEN GOTO help
      IF exists(infile$) = NO THEN GOTO nofind
      OPEN infile$ FOR INPUT AS #1
      outfile$ = "temp"
      OPEN outfile$ FOR OUTPUT AS #2
      IF RIGHT$(arg$(2), 1) = "U" THEN
            old$ = "Lowercase"
            new$ = "Uppercase"
      ELSEIF RIGHT$(arg$(2), 1) = "L" THEN
            old$ = "Uppercase"
            new$ = "Lowercase"
      ELSE
            GOTO badinstruct
      END IF
      GOSUB filename
      oldfile$ = UCASE$(file$) + ".OLD"
header:
      COLOR 15: PRINT "SHIFTER "; : COLOR 7: PRINT "Fast upper and lowercase converter"
      PRINT "Shifting "; old$; " to "; new$; " in "; infile$; ", creating "; oldfile$
      PRINT "Hit [Ctrl]+[Break] to terminate."
      GOSUB time
      PRINT " Start time:"; newtime$
      PRINT " Processing: ";
      z = 0
cycle:
      IF EOF(1) THEN GOTO finish
      LINE INPUT #1, L$
      z = z + 1: out$ = ""
      LOCATE , 13: PRINT z;
top:
      IF INSTR(L$, CHR$(34)) = 0 THEN
             IF new$ = "Lowercase" THEN GOSUB Lower ELSE GOSUB upper
             ELSE GOTO splitquote
      END IF
      out$ = L$
dump:
      PRINT #2, out$
      GOTO cycle
splitquote:
      lq = INSTR(L$, CHR$(34))
      rq = INSTR(lq + 1, L$, CHR$(34))
             IF rq = 0 THEN rq = LEN(L$)
      lt$ = LEFT$(L$, lq - 1)
      qt$ = MID$(L$, lq, (rq - lq + 1))
      rt$ = MID$(L$, rq + 1)
      L$ = lt$
      IF new$ = "Lowercase" THEN GOSUB Lower ELSE GOSUB upper
      out$ = out$ + L$ + qt$
      start = rq
      L$ = rt$
lookagain:
      IF INSTR(L$, CHR$(34)) = 0 THEN
            IF new$ = "Lowercase" THEN GOSUB Lower ELSE GOSUB upper
            out$ = out$ + L$
      ELSE GOTO splitquote
            IF new$ = "Lowercase" THEN GOSUB Lower ELSE GOSUB upper
            out$ = out$ + L$
      END IF
      GOTO dump
'*************************** general subroutines ******************************
Lower:
      FOR i = 1 TO LEN(L$)
          IF ASC(MID$(L$, i, 1)) > 64 AND ASC(MID$(L$, i, 1)) < 91 THEN
          MID$(L$, i, 1) = CHR$(ASC(MID$(L$, i, 1)) + 32)
          END IF
      NEXT
      RETURN
upper:
      FOR i = 1 TO LEN(L$)
            IF ASC(MID$(L$, i, 1)) > 96 AND ASC(MID$(L$, i, 1)) < 123 THEN
                  MID$(L$, i, 1) = CHR$(ASC(MID$(L$, i, 1)) - 32)
            END IF
      NEXT
      RETURN
time:
      intime$ = TIME$                                 'current time changed
      hour$ = MID$(intime$, 1, 2)                     'to newtime$
      min$ = MID$(intime$, 4, 2)
      sec$ = MID$(intime$, 7, 2)
      hour = VAL(hour$)
      IF hour < 12 THEN ampm$ = "am" ELSE ampm$ = "pm"
      IF hour > 12 THEN hour = hour - 12
      hour$ = STR$(hour)
      newtime$ = hour$ + ":" + min$ + ":" + sec$ + " " + ampm$
      RETURN
filename:                                         'splits infile$ into
          period = INSTR(infile$, ".")              'file$ and ext$
          IF period = 0 THEN
                file$ = infile$
                ext$ = ""
          ELSE
                file$ = LEFT$(infile$, period - 1)
                ext$ = MID$(infile$, period + 1)
          END IF
          RETURN
'****************************** help and error routines ***********************
help:
      PRINT " "
      PRINT "SHIFTER converts Uppercase and Lowercase in a file. "
      PRINT "(c) 1990 David A. Wesson"
      PRINT " "
      PRINT "Syntax: SHIFTER  [d:]oldfile  /U or /L"
      PRINT " where  oldfile = original file  [drive optional]"
      PRINT "           /U   = convert TO Upper"
      PRINT "           /L   = convert TO Lower"
      PRINT ""
      PRINT "NOTE: Words inside quotes will be left unchanged."
      PRINT "      This program makes a backup of the original file"
      PRINT "      named filename.OLD"
      END
killhandle:
      GOTO header
nofind:
      PRINT "ERROR: No file by that name found."
      GOTO help
badinstruct:
      PRINT "ERROR: Bad or missing instruction."
      GOTO help
finish:
      CLOSE
      IF exists(oldfile$) = YES THEN KILL oldfile$
      NAME infile$ AS oldfile$
      NAME outfile$ AS infile$
      GOSUB time
      PRINT ""
      PRINT "Finish time:"; newtime$
      END



FUNCTION exists (search$)
     savefile$ = search$
     inregs.ax = &H4E00
     inregs.cx = 1     '3 for hidden
     search$ = search$ + CHR$(0)
     inregs.dx = SADD(search$)
     inregs.ds = -1
     CALL INTERRUPTX(&H21, inregs, outregs)
     IF (outregs.flags AND 1) = 1 THEN
            exists = NO
     ELSE
            exists = YES
     END IF
     search$ = savefile$
END FUNCTION

SUB parsecommand
      inline$ = COMMAND$
      word = 1
      FOR x = 1 TO LEN(inline$)
            y$ = MID$(inline$, x, 1)
            IF ASC(y$) = 32 THEN
                IF arg$(word) <> "" THEN word = word + 1
            ELSE
                arg$(word) = arg$(word) + y$
            END IF
      NEXT x
END SUB