home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / TEXT / UTILITY / DFUTIL1.ZIP / SCRAMBLE.ZIP / SCRAMBLE.BAS next >
Encoding:
BASIC Source File  |  1990-11-11  |  3.6 KB  |  140 lines
  1. 'Scrambles and unscrambles files so that they may not be read.
  2. '
  3. ' $INCLUDE: 'qb.bi'
  4.  
  5. DECLARE FUNCTION exists (filename$)
  6. DECLARE SUB parsecommand ()
  7.  
  8. CONST YES = 1, NO = 0
  9. DIM SHARED inregs AS RegTypeX, outregs AS RegTypeX
  10. DIM SHARED arg$(10)
  11.  
  12.     parsecommand
  13.     infile$ = arg$(1)
  14.     IF infile$ = "" THEN GOTO help
  15.     IF exists(infile$) = NO THEN GOTO nofind
  16.     OPEN infile$ FOR INPUT AS #1
  17.     outfile$ = "temp"
  18.     OPEN outfile$ FOR OUTPUT AS #2
  19.     GOSUB filename
  20.     oldfile$ = UCASE$(file$) + ".OLD"
  21.     SELECT CASE RIGHT$(arg$(2), 1)
  22.         CASE "S": pro$ = "Scrambling"
  23.         CASE "U": pro$ = "Unscrambling"
  24.         CASE ELSE: GOTO badinstruct
  25.     END SELECT
  26. HEADER:
  27.     COLOR 15: PRINT "SCRAMBLE "; : COLOR 7: PRINT "Fast file scambler"
  28.     PRINT pro$; " "; infile$; ", making backup in "; oldfile$
  29.     PRINT "Hit [Ctrl]+[Break] to terminate."
  30.     GOSUB TIME
  31.     PRINT "      Start time:"; newtime$
  32.     PRINT " Processing Line: ";
  33.     z = 0
  34.     DO UNTIL EOF(1)
  35.         z = z + 1
  36.         LINE INPUT #1, l$
  37.         LOCATE , 18: PRINT z;
  38.         out$ = ""
  39.         IF pro$ = "Scrambling" THEN GOSUB SCRAMBLE
  40.         IF pro$ = "Unscrambling" THEN GOSUB UNSCRAMBLE
  41.         out$ = l$
  42.         PRINT #2, out$
  43.     LOOP
  44. FINISH:
  45.       CLOSE
  46.       IF exists(oldfile$) = YES THEN KILL oldfile$
  47.       NAME infile$ AS oldfile$
  48.       NAME outfile$ AS infile$
  49.       GOSUB TIME
  50.       PRINT
  51.       PRINT "     Finish time:"; newtime$
  52.       CLOSE
  53.       END
  54. '*************************** GENERAL SUBROUTINES ******************************
  55. SCRAMBLE:
  56.     FOR i = 1 TO LEN(l$)
  57.         IF ASC(MID$(l$, i, 1)) < 128 THEN
  58.             MID$(l$, i, 1) = CHR$(ASC(MID$(l$, i, 1)) + 128)
  59.         END IF
  60.     NEXT
  61.     RETURN
  62. UNSCRAMBLE:
  63.     FOR i = 1 TO LEN(l$)
  64.         IF ASC(MID$(l$, i, 1)) > 127 THEN
  65.              MID$(l$, i, 1) = CHR$(ASC(MID$(l$, i, 1)) - 128)
  66.         END IF
  67.     NEXT
  68.     RETURN
  69. filename:
  70.     p = INSTR(infile$, ".")
  71.     IF p = 0 THEN
  72.         file$ = infile$
  73.     ELSE
  74.         file$ = LEFT$(infile$, p - 1)
  75.     END IF
  76.     RETURN
  77. TIME:
  78.       intime$ = TIME$                                     'current time changed
  79.             hour$ = MID$(intime$, 1, 2)                     'to newtime$
  80.             min$ = MID$(intime$, 4, 2)
  81.             sec$ = MID$(intime$, 7, 2)
  82.             hour = VAL(hour$)
  83.                   IF hour < 12 THEN ampm$ = "am" ELSE ampm$ = "pm"
  84.                   IF hour > 12 THEN hour = hour - 12
  85.             hour$ = STR$(hour)
  86.       newtime$ = hour$ + ":" + min$ + ":" + sec$ + " " + ampm$
  87.       RETURN
  88. '****************************** HELP AND ERROR ROUTINES ***********************
  89. help:
  90.       PRINT " "
  91.       PRINT "SCRAMBLE scrambles ASCII files for file security."
  92.       PRINT "(c)1990 David A. Wesson"
  93.       PRINT " "
  94.       PRINT "Syntax: SCRAMBLE [d:]oldfile  /S or /U"
  95.       PRINT " where  oldfile = original file [drive optional]"
  96.       PRINT "           /S   = SCRAMBLE file"
  97.       PRINT "           /U   = UNSCRAMBLE file"
  98.       PRINT ""
  99.       PRINT "NOTE: A backup file of the original is made named filename.OLD"
  100.       END
  101. nofind:
  102.       PRINT "ERROR: No file by that name found."
  103.       GOTO help
  104. badfile:
  105.       PRINT "ERROR: Duplicate or missing filename."
  106.       GOTO help
  107. badinstruct:
  108.       PRINT "ERROR: Bad or missing instruction."
  109.       GOTO help
  110.  
  111. FUNCTION exists (search$)
  112.      savefile$ = search$
  113.      inregs.ax = &H4E00
  114.      inregs.cx = 1     '3 for hidden
  115.      search$ = search$ + CHR$(0)
  116.      inregs.dx = SADD(search$)
  117.      inregs.ds = -1
  118.      CALL INTERRUPTX(&H21, inregs, outregs)
  119.      IF (outregs.flags AND 1) = 1 THEN
  120.             exists = NO
  121.      ELSE
  122.             exists = YES
  123.      END IF
  124.      search$ = savefile$
  125. END FUNCTION
  126.  
  127. SUB parsecommand
  128.       inline$ = COMMAND$
  129.       word = 1
  130.       FOR x = 1 TO LEN(inline$)
  131.             y$ = MID$(inline$, x, 1)
  132.             IF ASC(y$) = 32 THEN
  133.                 IF arg$(word) <> "" THEN word = word + 1
  134.             ELSE
  135.                 arg$(word) = arg$(word) + y$
  136.             END IF
  137.       NEXT x
  138. END SUB
  139.  
  140.