[Back to FILES SWAG index] [Back to Main SWAG index] [Original]
{
> 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!
}
[Back to FILES SWAG index] [Back to Main SWAG index] [Original]