{
> Is there out there that has any good encription code.. something like rsa?

{****************************************************************************}
{                Unit to Compute in a Very Pascal Way                        }
{****************************************************************************}
{                      Incredible File Utilities                             }
{****************************************************************************}
{              Version : 1.0                  Dec  1990                      }
{****************************************************************************}
Unit FileUtil ;
{****************************************************************************}
Interface uses dos ;
{****************************************************************************}
Const
     Crea  = 'UNIT FILEUTIL.TPU V.1.0 By: Jeffrey N. Thompson' ;
     Creat = '(C) Copywrite 1990,1991 By KJE Software Opportunities
Exclusively' ;{ Procedure and function List }
Function  FileExists(pathname:string):boolean ;
function  KillFile(pathname : string):boolean ;
Procedure cryptB(var Rec ; size : word ; Sym : Byte) ;
Procedure CryptStr(var Rec ; Size : Word ; Ecrypt : string) ;
Procedure CryptS(Var Rec ; Size : Word ; Seed : longint) ;
Function  CryptfileStr(Fname:string; Ecrypt : string) : integer ;
Function  CryptfileWithFile(Fname,Keyname : String) : Integer ;
Function  CryptFileS(Fname : string ; Seed : longint) : integer ;
{****************************************************************************}
Implementation    { Uses }
{ Procedures and functions follow }
{****************************************************************************}
{ Check if a filename Exists in the current drive and directory. }
Function FileExists(pathname : string) : boolean ;
Var
        search : searchrec ;
        exists : boolean ;
Begin   { Exists }
     exists := false ;
     findfirst(pathname,anyfile,search) ;
     exists := (doserror = 0) and (search.name <> '') ;
     fileexists := exists ;
End ;  { Exists }
{****************************************************************************}
 { Destroys a file.  Unrecoverably }
function  KillFile(pathname : string):boolean ;
var
   kfile : file ;
   buffer : array[1..2048] of byte ;
   numread,numwritten : word ;
   I  : integer ;
   j2 : longint ;
   found : boolean ;

begin
{$F-}
   if fileexists(pathname) then
   begin
        found := true ;
        assign(kfile,pathname) ;
        setfattr(kfile,0) ;
        reset(kfile,1) ;
        repeat
             Blockread(kfile,buffer,sizeof(buffer),numread) ;
             j2 := filepos(kfile) ;
             for I := 1 to numread do buffer[i] := random(255) ;
             seek(kfile,j2-numread) ;
             blockwrite(kfile,buffer,numread,numwritten) ;
             seek(kfile,j2) ;
        until (numread = 0) or (numwritten <> numread) ;
        close(kfile) ;
        erase(kfile) ;
   end else found := false ;
{$F+}
     killfile := (ioresult=0) and (found) ;
  end ;
{****************************************************************************}
 { Encrypt a record of SIZE with a Byte Sized SYMbol }
procedure cryptb(var Rec ; size : word ; Sym : Byte) ;

type
    buffers = array[1..65535] of byte ;
var
   I : word ;
   buffer : ^buffers ;

begin
     buffer := nil ;
     buffer := @rec ;
     for I := 1 to size do buffer^[I] := buffer^[i] xor sym ;
end ;

{****************************************************************************}
 { Encrypts a record of SIZE with a Sliding String method }
procedure CryptStr(var Rec ; Size : Word ; Ecrypt : string) ;
type
    buffers = array[1..65535] of byte ;
var
   I,J : word ;
   buffer : ^buffers ;
   l : integer ;
   c1 : char ;

begin
     l := length(ecrypt) ;
     if l = 1 then
     begin
          c1 := ecrypt[1] ;
          cryptb(rec,size,byte(c1)) ;
          exit ;
     end ;
     if l<2 then exit ;
     buffer := nil ;
     buffer := @rec ;
     j := 1 ;
     for I := 1 to size do
     begin
          buffer^[I] := buffer^[i] xor byte(ecrypt[j]) ;
          inc(j) ;
          if j > l then
          begin
               j := 1 ;
               c1 := ecrypt[1] ;
               move(ecrypt[2],ecrypt[1],l-1) ;
               ecrypt[l] := c1 ;
          end ;
     end ;
end ;
{****************************************************************************}
 { Encrypts a record of SIZE  with a list of random numbers produced by
 Initial Seeding with SEED }
procedure cryptS(var Rec ; size : word ; Seed : longint) ;

type
    buffers = array[1..65535] of byte ;
var
   I : word ;
   buffer : ^buffers ;

begin
     randseed := seed ;
     buffer := nil ;
     buffer := @rec ;
     for I := 1 to size do buffer^[I] := buffer^[i] xor byte(random(254)+1) ;
end ;

{****************************************************************************}
{ Encrypts a file, with a string using a sliding string method }
{ String em up! }
function CryptfileStr(Fname:string; Ecrypt : string) : integer ;
const
     tempfilename = 'KJETLHM.DS2' ;
var
   fromfile,tofile : file ;
   buffer : array[1..2048] of byte ;
   numread,numwritten,attr : word ;
   error : boolean ;
   I,J,L : integer ;
   j2 : longint ;
   c1 : char ;

begin
     if not fileexists(fname) then
     begin
          cryptfileStr := 1 ;
          exit ;
     end ;
     if length(ecrypt) <= 1 then
     begin
          cryptfileStr := 2 ;
          exit ;
     end ;
     l := length(ecrypt) ;
{$I-}
     assign(fromfile,fname) ;
     assign(tofile,tempfilename) ;
     getfattr(fromfile,attr) ;
     setfattr(fromfile,0) ;
     reset(fromfile,1) ;
     rewrite(tofile,1) ;
     repeat
          blockread(fromfile,buffer,sizeof(buffer),numread) ;
          j := 1 ;
          for I := 1 to sizeof(buffer) do
          begin
               buffer[I] := buffer[I] xor byte(ecrypt[j]) ;
               inc(j) ;
               if j > l then
               begin
                    j := 1 ;
                    c1 := ecrypt[1] ;
                    move(ecrypt[2],ecrypt[1],l-1) ;
                    ecrypt[l] := c1 ;
               end ;
          end ;
          blockwrite(tofile,buffer,numread,numwritten) ;
     until (numread = 0) or (numwritten <> numread) ;
     close(tofile) ;
     close(fromfile) ;
     error := killfile(fname) ;
     rename(tofile,fname) ;
     setfattr(tofile,attr) ;
{$I+}
     cryptfileStr := (IOresult)
end ;
{****************************************************************************}
 { encrypts a file with another file as the key, using a sliding method
 }
{ File this sucker! }
Function CryptfileWithFile(Fname,Keyname : String) : Integer ;
const
     Tempfilename = 'KJETLHM.DS3' ;
var
   Infile,Keyfile,Outfile : file ;
   Bfile : File of Byte ;
   inBuffer,keybuffer,outbuffer : array[1..2048] of byte ;
   attr,kattr : word ;
   I,J : longint ;
   numread,numwritten,numkread : word ;
   error : boolean ;

begin
     if not fileexists(fname) then
     begin
          cryptfilewithfile := 1 ;
          exit ;
     end ;
     if not fileexists(keyname) then
     begin
          cryptfilewithfile := 2  ;
          exit ;
     end ;
     {$I-}
     Assign(infile,fname) ;
     assign(keyfile,keyname) ;
     assign(outfile,tempfilename) ;
     getfattr(infile,attr) ;
     getfattr(keyfile,kattr) ;
     setfattr(infile,0) ;
     setfattr(keyfile,0) ;
     reset(infile,1) ;
     reset(keyfile,1) ;
     rewrite(outfile,1) ;
     repeat
          { Fill the input buffer }
          blockread(infile,inbuffer,sizeof(inbuffer),numread) ;
          { Fill the key buffer }
          blockread(keyfile,keybuffer,sizeof(keybuffer),numkread) ;
          j := numkread ;
          if numkread < numread then { The Keyfile is smaller }
          repeat  { Keep resetting and reading until the buffer is full }
               reset(keyfile,1) ;
               blockread(keyfile,keybuffer[j+1],numread-j,numkread) ;
               j := j + numkread ;
               if j > numread then HALT(3) ;
          until j = numread ;
          for I := 1 to numread do
           outbuffer[I] := inbuffer[I] XOR keybuffer[I] ;
          blockwrite(outfile,outbuffer,numread,numwritten) ;
     until (numread = 0) or (numwritten <> numread) ;
     close(keyfile) ;
     setfattr(keyfile,kattr) ;  { Restore the attributes }
     close(infile) ;
     close(outfile) ;
     { Now destroy the old file }
     error := killfile(fname) ;
     rename(outfile,fname) ;
     setfattr(outfile,attr) ;
{$I+}
     cryptfilewithfile := IoResult ;
end ;
{****************************************************************************}
 { Encrypts a file, using a list of random numbers generated with an
 initial SEED.   The Seed is your key } 
function CryptfileS(Fname:string; Seed : Longint) : integer ;
const
     tempfilename = 'KJETLHM.DS4' ;
var
   fromfile,tofile : file ;
   buffer : array[1..2048] of byte ;
   numread,numwritten,attr : word ;
   I : integer ;
   error : boolean ;

begin
     if not fileexists(fname) then
     begin
          cryptfileS := 1 ;
          exit ;
     end ;
     randseed := seed ;
{$I-}
     assign(fromfile,fname) ;
     assign(tofile,tempfilename) ;
     getfattr(fromfile,attr) ;
     setfattr(fromfile,0) ;
     reset(fromfile,1) ;
     rewrite(tofile,1) ;
     repeat
          blockread(fromfile,buffer,sizeof(buffer),numread) ;
          for I := 1 to numread do
           buffer[I] := buffer[I] xor byte(random(254)+1) ;
          blockwrite(tofile,buffer,numread,numwritten) ;
     until (numread = 0) or (numwritten <> numread) ;
     close(tofile) ;
     close(fromfile) ;
     error := killfile(fname);
     rename(tofile,fname) ;
     setfattr(tofile,attr) ;
{$I+}
     cryptfileS := IOresult  ;
end ;
{****************************************************************************}
{****************************************************************************}
end. { Unit }

{
These are not weird math methods of encryption.  They are simple
 Extreemly fast XOR methods.  By using multiple methods on various parts
 of a file, or database, you can foil any attempt at cracking.  This is
 true because the cracker has no way of knowing where to start, even if
 he possesses the keys..

     I have a standing challenge, if anyone cares to take it...  Here
 are the methods, I'll post a small file, and even give you the keys I
 used to ecrypt a simple one line sentence.  If you can crack it, I'll
 buy you a pentium computer!
}