* Caesar - Caesar cipher
* Simple substitution cipher first used by Julius Caesar
* Shifts characters by their order in the alphabet
* Note: Not very secure
* although it allows 256 ASCII characters rather than 26 letters
* Syntax: do Caesar with <Text or File> [,Shift] [,Decrypt]

* 1. Put Caesar.prg in C:\CAC
* 2. In FoxPro have a path to C:\CAC
* 3. Type MODIFY FILE Temp.Txt
* 4. Paste Message into the blank file
* 5. Close file
* 6. At Command window, type
*     DO CAESAR WITH 'Temp.Txt', -1
*
* Syntax:
*     DO CAESAR WITH <message>, [number of ASCII characters to shift (default 1) ]
* or
*     ? CAESAR(<"message"/.txt file>, [number of ASCII chars to shift (default 1) ]
*    
* Examples:
* KEYBOARD CAESAR("Hello world", 1) (to encrypt)
* KEYBOARD CAESAR("Ifmmp!xpsme",-1) (to decrypt)

* DO CAESAR WITH "Temp.Txt", 5 (to encrypt)
* DO CAESAR WITH "Temp.Txt", -5 (to decrypt)

* USE Customer.DBF
* BROWSE
* DO CAESAR WITH 'Customer.DBF', 37 (to encrypt)
* DO CAESAR WITH 'Customer.DBF', -37 (to encrypt)

parameter sText, nShift, xDeCrypt

do case
case parameters() =0
    wait window 'Must specify text' nowait
    return .f.
case parameters() =1
    nShift =1
    lDecrypt =.f.
case parameters() =2
    * nShift given
    lDecrypt =.f.
case parameters() =3
    if type('xDeCrypt') ='L'
        lDecrypt =xDeCrypt
    else
        lDecrypt =.t.
    endif
endcase

private nX, lFile

if type('_KeyBoard') <>'C'
    public _KeyBoard
    _Keyboard ='A'             && All ASCII
endif

if empty(sText)
    return sText
endif

do case
case '.DBF' $ upper(sText)
    cAlias =substr(sText, 1, at('.DBF', upper(sText)) -1)
    if used(cAlias)
        select &cAlias
    else
        select 0
        use &sText
    endif
    for nField =1 to fcount()
        cField =field(nField)
        if type(cField) ='C'
            wait window 'Processing ' +cField nowait
            nLength =len(&cField)
            replace all (cField) with pCaesar(&cField, nLength)
        endif
    endfor
   
case '.TXT' $ upper(sText)
    if file(sText)
        *_KeyBoard =.f.
        cFile =sText
        wait window iif(lDecrypt,'DeCrypting ','EnCrypting ') +cFile nowait
        nHandle =fopen(cFile)
        nLength =fseek(nHandle,0,2)         && Number of bytes
        nFileTop =fseek(nHandle,0)             && Move pointer to BOF
        if nLength <= 0                     && Is file empty?
            wait window 'This file is empty!' timeout 3
            if fclose(nHandle) =.f.
                wait window cFile +' could not be closed' timeout 3
            endif
            return .f.
        else
            sText =fread(nHandle, nLength)
        endif
        if fclose(nHandle) =.f.
            wait window cFile +' could not be closed' timeout 3
        endif
        lFile =.t.
    endif

    cResult =pCaesar(sText, nLength)

    erase &cFile
    if file(cFile)
        wait window 'Did not erase ' +cFile +' or there is another in the path' timeout 3
    endif
    nHandle =fcreate(cFile)
    nLength2 =fwrite(nHandle, cResult)
    lClosed =fclose(nHandle)
    if nLength2 <> nLength or lClosed =.f.
        wait window 'Something wrong happened' timeout 3
    endif
    =Beeps('u2')
otherwise
    nLength =len(sText)
    cResult =pCaesar(sText, nLength)
    return cResult
endcase
wait window 'Done' nowait


procedure pCaesar
    parameter sText, nLength
    cResult =''
    for nX =1 to nLength
        * wait window ltrim(str(nX)) +'/' +ltrim(str(nLength)) nowait
        do case
        case _KeyBoard ='U'         && Upper case Keyboard characters only
            sText =upper(sText)
            nHigh =96
            nLow =32
        case _KeyBoard ='K'         && Keyboard characters only
            nHigh =126
            nLow =32
        otherwise                 && All ASCII characters
            nHigh =255
            nLow =1
        endcase
   
        cCharacter =substr(sText,nX,1)
        if lDecrypt =.f.
            nCharacter =asc(cCharacter) +nShift
        else
            nCharacter =asc(cCharacter) -nShift
        endif
   
        do while nCharacter > nHigh
            nCharacter =nCharacter -nHigh +nLow
        enddo
        do while nCharacter < nLow
            nCharacter =nCharacter +nHigh -nLow
        enddo
        cResult =cResult +chr(nCharacter)
    endfor
    return cResult