Text encryption - Printable Version

Code: (Select All)

$CONSOLE:ONLY

CLS

DIM SHARED AS STRING phrase, message, code

REDIM SHARED AS INTEGER sCode(0)

phrase = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

SplitCode

SELECT CASE LCASE$(COMMAND$(1))

    CASE "encode"

        en$ = EnCode

        PRINT "EnCode<", en$

        _CLIPBOARD$ = en$

        PRINT

        PRINT "encoded message has been copied to clipboard"

        SYSTEM

    CASE "decode"

        de$ = DeCode

        PRINT "DeCode>", de$

        _CLIPBOARD$ = de$

        SYSTEM

END SELECT



FUNCTION DeCode$

    DIM AS STRING t, h, e

    DIM AS INTEGER c

    c = 1

    h = UCASE$(COMMAND$(3))

    FOR i = 1 TO LEN(h)

        FOR x = 1 TO LEN(phrase)

            IF MID$(h, i, 1) = MID$(phrase, x, 1) THEN

                e = e + MID$(phrase, x - sCode(c), 1)

                EXIT FOR

            END IF

        NEXT x

        IF c = 4 THEN c = 1 ELSE c = c + 1

    NEXT i

    DeCode = dehex(e)



END FUNCTION



FUNCTION EnCode$

    DIM AS STRING t, h, e

    DIM AS INTEGER c

    c = 1

    h = toHex(COMMAND$(3))

    FOR i = 1 TO LEN(h)

        FOR x = 1 TO LEN(phrase)

            IF MID$(h, i, 1) = MID$(phrase, x, 1) THEN

                e = e + MID$(phrase, x + sCode(c), 1)

                EXIT FOR

            END IF

        NEXT x

        IF c = 4 THEN c = 1 ELSE c = c + 1

    NEXT i

    EnCode = e



END FUNCTION



SUB SplitCode

    REDIM sCode(LEN(COMMAND$(2))) AS INTEGER

    FOR i = i TO LEN(COMMAND$(2))

        sCode(i) = VAL(MID$(COMMAND$(2), i, 1))

    NEXT

END SUB



FUNCTION dehex$ (m AS STRING)

    DIM s AS STRING

    FOR i = 1 TO LEN(m) STEP 2

        s = s + CHR$(VAL("&h" + MID$(m, i, 2)))

        dehex = s

    NEXT



END FUNCTION



FUNCTION toHex$ (m AS STRING)

    DIM s AS STRING

    FOR i = 1 TO LEN(m)

        s = s + HEX$(ASC(MID$(m, i, 1)))

        toHex = s

    NEXT

END FUNCTION

Code: (Select All)

5 'File Security Series, Part 1.

6 'Due to the nature of GWBASIC's random number generator,

7 'this program must be rerun *EVERY* time it is used.

10 DefInt A-Z: Dim A1(255), A2(255), A3(1, 127)

50 Cls: Print "Pseudo-random file cypher utility.": Print "Written by Jim Race.": Print: Print

51 Input "(E)ncypher, (D)ecypher, or (Q)uit"; I$: I = Int(InStr("EeDdQq", I$) / 2 + .5): If I = 0 Then 51

52 Print

53 If I = 3 Then End



60 FI$ = "": Line Input "Input filename : "; FI$

70 FO$ = "": Line Input "Output filename: "; FO$

80 Print: Input "Key (numeric): ", K



100 Cls: Print "wait...";: Randomize (K)



130 Open "R", 1, FI$, 1: Field 1, 1 As Z1$

140 Open "R", 2, FO$, 1: Field 2, 1 As Z2$



150 On I GOSUB 200, 500

160 Close: Print "done!": Run



199 'Encypher....

200 GoSub 1000: If L = -1 Then Return

210 For A = 0 To I: A1(A) = (A1(A) + Int(Rnd * 9472)) And 255: Next '  Addition of pseudo-random number

220 J = Int(I / 2): For A = 0 To J '  Transposition

230 R = Int(Rnd * (I + 1)): S = Int(Rnd * (I + 1)): Swap A1(R), A1(S): Next

240 GoSub 2000: GoTo 200



499 'Decypher....

500 GoSub 1000: If L = -1 Then Return

510 For A = 0 To I: A2(A) = Int(Rnd * 9472): Next

520 J = Int(I / 2): For A = 0 To J

530 A3(0, A) = Int(Rnd * (I + 1)): A3(1, A) = Int(Rnd * (I + 1)): Next

540 For A = J To 0 Step -1: Swap A1(A3(0, A)), A1(A3(1, A)): Next '  Transposition

550 For A = 0 To I: A1(A) = (A1(A) - A2(A)) And 255: Next '  Subtraction of pseudo-random number

560 GoSub 2000: GoTo 500



999 'Read a random number of bytes from the input file....

1000 L = Int(Rnd * 256): I = 0

1010 If Loc(1) = LOF(1) Then Close: L = -1: Return

1020 Get 1: A1(I) = Asc(Z1$)

1030 If L > 0 And (Loc(1) < LOF(1)) Then I = I + 1: L = L - 1: GoTo 1020

1040 Return



1999 'Write A1(0)...A1(I) to the output file....

2000 For A = 0 To I

2010 LSet Z2$ = Chr$(A1(A)): Put 2: Next

2020 Return