* 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