' +---------------------------------------------------------------------+
    ' |                 - E n c r y p t   R o u t i n e -                   |
    ' |                                                                     |
    ' |                     Public Domain -  FreeWare                       |
    ' +---------------------------------------------------------------------+
    ' | This routine is used in a GOSUB, and the GOSUB calls and/or uses    |
    ' | 3 FUNCTIONs and 2 SUBs. They are located below double line,         |
    ' | beginning at line 102.                                              |
    ' |                                                                     |
    ' | Example to use : GOSUB filecrypt                                    |
    ' +---------------------------------------------------------------------+
    ' |  Author: Donald B. "Don" Smith                                      |
    ' |  Email : smithdonb@earthlink.net                                    |
    ' |  Date: 03/25/2002                                                   |
    ' +---------------------------------------------------------------------+
    ' |                      - ABOUT THE AUTHOR -                           |
    ' +---------------------------------------------------------------------+
    ' |                                                                     |
    ' | Hello. My name is Don Smith and I am a thirty-year retired teacher  |
    ' | of Math/History/Spanish residing in Orange County, California. I    |
    ' | am also a former six-year Sergeant of Marines. Who-Rah! On certain  |
    ' | forums I am known as MarineDon. My email is: smithdonb@earthlink.net|
    ' |                                                                     |
    ' +---------------------------------------------------------------------+
    ' |                 - COPYING AND DISTIBUTING -                         |
    ' +---------------------------------------------------------------------+
    ' | Since this code is public domain and freeware, anyone may freely    |
    ' | copy and distribute it. If you use the QuickBasic code in one of    |
    ' | your own programs, you do not have to cite my name as the author,   |
    ' | and you may even change its name.                                   |
    ' +---------------------------------------------------------------------+

filecrypt:
    ' +--------------------------------------------------------------------+
    ' | Encryption routine uses the following FUNCTIONs and SUBs:          |
    ' +--------------------------------------------------------------------+
    ' | DECLARE FUNCTION NewWord$ ()..Returns a pseudorandom word of a     |
    ' |                               possibly speakable form.             |
    ' |                                                                    |
    ' | DECLARE FUNCTION Rand& ()..Returns a pseudrandom long integer in   |
    ' |                             range of 0 through 999999999.          |
    ' |                                                                    |
    ' | DECLARE FUNCTION RandInteger% (a%, b%)...Returns a pseudorandom    |
    ' |                                          integer in the range      |
    ' |                                          a% to b% inclusive.       |
    ' +--------------------------------------------------------------------+
    ' | SUB RandShuffle (key$)..Creates an original table of pseudorandom  |
    ' |                         long integers for use by the FUNCTION Rand&|
    ' |                                                                    |
    ' |                                                                    |
    ' | SUB ProcesX (a$)........Enciphers a string by XORing with          |
    ' |                         pseudorandom bytes.                        |
    ' +--------------------------------------------------------------------+
    ' +--------------------------------------------------------------------+
    ' | The line below, cmd$ = SM$(Selection%) + " " + EdW$, means:        |
    ' +--------------------------------------------------------------------+
    ' | SM$(Selection%) = The file to be viewed.                           |
    ' | " " = One space.                                                   |
    ' | EdW$ = The password.                                               |
    ' +--------------------------------------------------------------------+
    ' | Compile:                                                           |
    ' |           For library, only Bcom45.Lib is required.                |
    ' |           The QB.Lib is NOT required.                              | 
    ' +--------------------------------------------------------------------+

    cmd$ = SM$(Selection%) + " " + EdW$
    DIM SHARED r&(1 TO 100)  'for use in SUB RandShuffle
    cmd$ = cmd$ + " "
    firstSpace% = INSTR(cmd$, " ")

    FileName$ = LEFT$(cmd$, firstSpace% - 1)

    'Grab the rest of the command line as the cipher key:
    key$ = LTRIM$(MID$(cmd$, firstSpace% + 1))

    'Prepare the pseudorandom numbers using the key for shuffling
    CALL RandShuffle(key$)

    'Open up the file:
    OPEN FileName$ FOR BINARY AS #1
    fileLength& = LOF(1)

    'Process the file in manageable pieces:
    a$ = SPACE$(BYTES)
    count% = fileLength& \ BYTES

    'Loop through the file
    FOR I% = 0 TO count%
        j& = I% * BYTES + 1
        IF I% = count% THEN
            a$ = SPACE$(fileLength& - BYTES * count%)
        END IF
        GET #1, j&, a$
        CALL ProcesX(a$)
        PUT #1, j&, a$
    NEXT I%

    CLOSE #1
    ERASE r&


'================================================================


DEFSNG A-Z
FUNCTION NewWord$ STATIC
    CONST vowel$ = "aeiou"
    CONST consonant$ = "bcdfghklmnpqrstvwxyz"
    syllables% = Rand& MOD 3 + 1
    FOR I% = 1 TO syllables%
        t$ = t$ + MID$(consonant$, RandInteger%(1, 21), 1)
        IF I% = 1 THEN
            t$ = UCASE$(t$)
        END IF
        t$ = t$ + MID$(vowel$, RandInteger%(1, 5), 1)
    NEXT I%
    IF Rand& MOD 2 THEN
        t$ = t$ + MID$(consonant$, RandInteger%(1, 21), 1)
    END IF
    NewWord$ = t$
    t$ = ""
END FUNCTION

SUB ProcesX (a$) STATIC
    FOR I% = 1 TO LEN(a$)
        byte% = ASC(MID$(a$, I%, 1)) XOR RandInteger%(0, 255)
        MID$(a$, I%, 1) = CHR$(byte%)
    NEXT I%
END SUB

FUNCTION Rand& STATIC
    'Get the pointers into the table:
    I% = r&(98)
    j% = r&(99)

    'Subtract the two table values:
    t& = r&(I%) - r&(j%)

    'Adjust result if less then zero:
    IF t& < 0 THEN
        t& = t& + 1000000000
    END IF

    'Replace table entry with new random number
    r&(I%) = t&

    'Decrement first index, keeping in range 1 through 55:
    IF I% > 1 THEN
        r&(98) = I% - 1
    ELSE
        r&(98) = 55
    END IF

    'Decrment second index, keeping in range 1 through 55:
    IF j% > 1 THEN
        r&(99) = j% - 1
    ELSE
        r&(99) = 55
    END IF

    'Use last random number to index into shuffle table:
    I% = r&(100) MOD 42 + 56

    'Grab random from table at current random number:
    r&(100) = r&(I%)

    'Put new calculated random into table:
    r&(I%) = t&

    'Return the random number grabbed from the table:
    Rand& = r&(100)

END FUNCTION

FUNCTION RandInteger% (a%, b%)
    RandInteger% = a% + (Rand& MOD (b% - a% + 1))
END FUNCTION

SUB RandShuffle (key$) STATIC

    'Form 97-character string, with key$ as part of it:
    k$ = LEFT$("Abra Ca Da Bra" + key$ + SPACE$(83), 97)

    'Use each character to seed table:
    FOR I% = 1 TO 97
        r&(I%) = ASC(MID$(k$, I%, 1)) * 8171717 + I% * 997&
    NEXT I%

    'Preserve string space:
    k$ = ""

    'Initialize pointers into table:
    I% = 97
    j% = 12

    'Randomize the table to get it warmed up:
    FOR k% = 1 TO 997

        'Subtract entries pointed to by i% and j%:
        r&(I%) = r&(I%) - r&(j%)

        'Adjust result if less than zero:
        IF r&(I%) < 0 THEN
            r&(I%) = r&(I%) + 1000000000
        END IF

        'Decrement first index, keeping in range of 1 through 97:
        IF I% > 1 THEN
            I% = I% - 1
        ELSE
            I% = 97
        END IF

        'Decrement second index, keeping in range of 1 through 97:
        IF j% > 1 THEN
            j% = j% - 1
        ELSE
            j% = 97
        END IF
    NEXT k%

    'Initialize pointers for use by Rand& function:
    r&(98) = 55
    r&(99) = 24

    'Initialize pointer for shuffle table lookup by Rand& function:
    r&(100) = 77

END SUB