5748314 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n encr4.bas
   1: DECLARE FUNCTION Decrypted$ (t$, m!, n!)
   2: DECLARE FUNCTION Encrypted$ (t$, m!, n!)
   3: DECLARE FUNCTION NoLowAscii! (t$)
   4: DECLARE FUNCTION Revers$ (txt$)
   5: DECLARE FUNCTION BIN$ (n!)
   6: ON ERROR GOTO HELP
   7: 's$ = COMMAND$
   8: s$ = "dde.inc dde.dec 1 2"
   9: IF s$ = "" THEN GOTO HELP
  10: cntr = INSTR(s$, " ")
  11: p1$ = MID$(s$, 1, cntr - 1)
  12: cntr1 = INSTR(cntr + 1, s$, " ")
  13: p2$ = MID$(s$, cntr + 1, cntr1 - cntr - 1)
  14: cntr = cntr1
  15: cntr1 = INSTR(cntr1 + 1, s$, " ")
  16: p3 = VAL(MID$(s$, cntr + 1, cntr1 - cntr))
  17: cntr = cntr1
  18: cntr1 = LEN(s$)
  19: p4 = VAL(MID$(s$, cntr + 1, cntr1 - cntr))
  20: IF UCASE$(p1$) = UCASE$(p2$) THEN GOTO HELP
  21: IF p3 < 4 THEN PRINT "Encrypting "; UCASE$(p1$); "...";  ELSE PRINT "Decrypting "; UCASE$(p1$); "...";
  22: OPEN p1$ FOR BINARY AS #1
  23: OPEN p2$ FOR BINARY AS #2
  24: IF LOF(2) > 0 THEN CLOSE 2: KILL p2$: OPEN p2$ FOR BINARY AS #2
  25: DIM gg AS STRING * 100
  26: FOR q = 0 TO LOF(1)
  27: GET #1, , gg
  28: IF LEN(gg) + q > LOF(1) THEN g$ = MID$(gg, 1, (LEN(gg) + q) - LOF(1)) ELSE g$ = gg
  29: IF p3 < 4 THEN bg$ = Encrypted$(g$, p3, p4) ELSE bg$ = Decrypted$(g$, p3 - 3, p4)
  30: PUT #2, , bg$
  31: q = q + LEN(g$)
  32: NEXT q
  33: CLOSE 1, 2
  34: PRINT ".Done"
  35: END
  36: HELP:
  37: PRINT "Encrypt"
  38: PRINT "Syntax: "
  39: PRINT "        ENCRYPT infile outfile method key"
  40: PRINT
  41: PRINT " infile  - The file to be incrypted."
  42: PRINT " outfile - The new encrypted file."
  43: PRINT " method  - The encryption method to use [1|2|3|4|5|6]."
  44: PRINT " key     - The encryption key (the higest value is based on the method)."
  45: END
  46: Invaild:
  47: 
  48: RESUME NEXT
  49: 
  50: FUNCTION BIN$ (n)
  51: ff$ = HEX$(n)
  52: FOR q = 1 TO LEN(ff$)
  53: IF MID$(ff$, q, 1) = "0" THEN gg$ = gg$ + "0000"
  54: IF MID$(ff$, q, 1) = "1" THEN gg$ = gg$ + "0001"
  55: IF MID$(ff$, q, 1) = "2" THEN gg$ = gg$ + "0010"
  56: IF MID$(ff$, q, 1) = "3" THEN gg$ = gg$ + "0011"
  57: IF MID$(ff$, q, 1) = "4" THEN gg$ = gg$ + "0100"
  58: IF MID$(ff$, q, 1) = "5" THEN gg$ = gg$ + "0101"
  59: IF MID$(ff$, q, 1) = "6" THEN gg$ = gg$ + "0110"
  60: IF MID$(ff$, q, 1) = "7" THEN gg$ = gg$ + "0111"
  61: IF MID$(ff$, q, 1) = "8" THEN gg$ = gg$ + "1000"
  62: IF MID$(ff$, q, 1) = "9" THEN gg$ = gg$ + "1001"
  63: IF MID$(ff$, q, 1) = "A" THEN gg$ = gg$ + "1010"
  64: IF MID$(ff$, q, 1) = "B" THEN gg$ = gg$ + "1100"
  65: IF MID$(ff$, q, 1) = "C" THEN gg$ = gg$ + "1100"
  66: IF MID$(ff$, q, 1) = "D" THEN gg$ = gg$ + "1101"
  67: IF MID$(ff$, q, 1) = "E" THEN gg$ = gg$ + "1110"
  68: IF MID$(ff$, q, 1) = "F" THEN gg$ = gg$ + "1111"
  69: NEXT q
  70: BIN$ = gg$
  71: END FUNCTION
  72: 
  73: FUNCTION Decrypted$ (t$, m, n)
  74: t$ = Revers$(t$)
  75: ON ERROR GOTO Invaild
  76: Stp = m + 1
  77: IF m = 3 THEN Stp = 4
  78: FOR q = 1 TO LEN(t$) STEP Stp
  79: IF m = 1 THEN xx$ = HEX$(ASC(MID$(t$, q, 1)) / n) + HEX$(ASC(MID$(t$, q + 1, 1)) / n): xOutx$ = xOutx$ + CHR$(VAL("&H" + xx$))
  80: IF m = 2 THEN xx$ = RTRIM$(LTRIM$(STR$(ASC(MID$(t$, q, 1)) / n))) + RTRIM$(LTRIM$(STR$(ASC(MID$(t$, q + 1, 1)) / n))) + RTRIM$(LTRIM$(STR$(ASC(MID$(t$, q + 2, 1)) / n))): xOutx$ = xOutx$ + CHR$(VAL(xx$))
  81: IF m = 3 THEN
  82: xx$ = ""
  83: FOR z = 0 TO 3
  84: ax$ = RTRIM$(LTRIM$(STR$(VAL(LTRIM$(STR$(ASC(MID$(t$, q + z, 1)) / n))))))
  85: xx$ = xx$ + STRING$(2 - LEN(ax$), "0") + ax$: ax$ = ""
  86: NEXT z
  87: xOutx$ = xOutx$ + CHR$(VAL("&B" + LTRIM$(xx$)))
  88: END IF
  89: NEXT q
  90: Decrypted$ = xOutx$
  91: END FUNCTION
  92: 
  93: 'IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  94: 'Encypting Scheme with 3 methods (m) 
  95: ' 1 = Double Size                    
  96: ' 2 = Triple Size                    
  97: ' 3 = 6x Size                        
  98: 'EIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  99: FUNCTION Encrypted$ (t$, m, n)
 100: FOR q = 1 TO LEN(t$)
 101: IF m = 1 THEN xx$ = STRING$(2 - LEN(HEX$(ASC(MID$(t$, q, 1)))), "0") + HEX$(ASC(MID$(t$, q, 1)))
 102: IF m = 2 THEN xx$ = STRING$(3 - LEN(RTRIM$(LTRIM$(STR$(ASC(MID$(t$, q, 1)))))), "0") + RTRIM$(LTRIM$(STR$(ASC(MID$(t$, q, 1)))))
 103: IF m = 3 THEN xx$ = STRING$(8 - LEN(RTRIM$(LTRIM$(BIN$(CINT(ASC(MID$(t$, q, 1))))))), "0") + RTRIM$(LTRIM$(BIN$(ASC(MID$(t$, q, 1)))))
 104: IF m = 1 THEN xOutx$ = xOutx$ + CHR$(VAL("&H" + MID$(xx$, 1, 1)) * n) + CHR$(VAL("&H" + MID$(xx$, 2, 1)) * n)
 105: IF m = 2 THEN xOutx$ = xOutx$ + CHR$(VAL(MID$(xx$, 1, 1)) * n) + CHR$(VAL(MID$(xx$, 2, 1)) * n) + CHR$(VAL(MID$(xx$, 3, 1)) * n)
 106: IF m = 3 THEN
 107: xx$ = MID$(xx$, 1, 8)
 108: FOR z = 1 TO LEN(xx$) STEP 2
 109: xOutx$ = xOutx$ + CHR$(VAL(MID$(xx$, z, 2)) * n)
 110: '? xOutx$;" xOutx$"
 111: '? xx$; " xx$"
 112: NEXT z
 113: END IF
 114: NEXT q
 115: Encrypted$ = Revers$(xOutx$)
 116: END FUNCTION
 117: 
 118: FUNCTION NoLowAscii (t$)
 119: FOR q = 0 TO 31
 120: 'IF ASC(MID$(t$, q, 1)) = 13 THEN dd = 1
 121: 'IF ASC(MID$(t$, q, 1)) < 32 AND dd = 0 THEN NoLowAscii = 0: EXIT FUNCTION
 122: 'dd = 0
 123: IF INSTR(t$, CHR$(q)) = 0 = 0 = -1 = -1 THEN dd = 1
 124: NEXT q
 125: IF dd = 1 THEN NoLowAscii = 0 ELSE NoLowAscii = 1
 126: END FUNCTION
 127: 
 128: FUNCTION Revers$ (txt$)
 129: IF txt$ = "" THEN EXIT FUNCTION
 130: FOR q = LEN(txt$) TO 1 STEP -1
 131: tt$ = tt$ + MID$(txt$, q, 1)
 132: NEXT q
 133: Revers$ = tt$
 134: END FUNCTION
 135: 
5748315 [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:02:21