unit PNPCore;
interface
const
WinSize = 6;
procedure Encrypt (SName, TName, Password: string);
procedure Decrypt (SName, TName, Password: string);
implementation
type
TKey = array[1..WinSize, 1..WinSize] of Boolean;
var
Key: TKey;
SFile, TFile: file;
FSize: LongInt;
procedure InitKey (Password: string);
const
CodeSize = WinSize*(WinSize+2) shr 3;
var
Code: array[1..CodeSize] of 0..3;
PassL: Integer;
Max, Half, Bit, Start, Sum, X, Y: Integer;
A, B: Integer;
begin
PassL:= Length(Password);
Max:= 2*PassL-3;
if Max>CodeSize then Max:=CodeSize;
Half:= Max div 2;
Start:= PassL-Half;
for Bit:= 1 to Half do
begin
Y:= Start+Bit; X:= 1; Sum:= 0;
repeat
Inc (Sum, Abs(Ord(Password[X])-Ord(Password[Y])));
Inc (X); Dec (Y);
until X>=Y;
Code[Bit]:= Sum;
end;
for Bit:= Half+1 to Max do
begin
Y:= PassL; X:= Bit-Half+1; Sum:= 0;
repeat
Inc (Sum, Abs(Ord(Password[X])-Ord(Password[Y])));
Inc (X); Dec (Y);
until X>=Y;
Code[Bit]:=Sum;
end;
for Bit:= Max+1 to CodeSize do
Code[Bit]:= Code[Bit-Max];
Y:= 1; Bit:= 0;
FillChar (Key, SizeOf(Key), False);
for Y:= 1 to WinSize shr 1 do
for X:= Y to WinSize shr 1 do
begin
Inc (Bit);
B:=Code[Bit] mod 4;
A:=Code[Bit] shr 2 mod 4;
case B of
0:Key[X, Y]:= True;
1:Key[WinSize+1-Y, X]:= True;
2:Key[WinSize+1-X, WinSize+1-Y]:= True;
3:Key[Y, WinSize+1-X]:= True;
end;
if not ((X=Y) or (X+Y=WinSize+1)) then
case A of
0:Key[Y, X]:= True;
1:Key[X, WinSize+1-Y]:= True;
2:Key[WinSize+1-Y, WinSize+1-X]:= True;
3:Key[WinSize+1-X, Y]:= True;
end;
end;
end;
procedure TurnKey (var Key: TKey);
var
TempKey: TKey;
I, J: Integer;
begin
for I:=1 to WinSize do
for J:=1 to WinSize do
TempKey[J, WinSize+1-I]:= Key[I, J];
Key:= TempKey;
end;
procedure Encrypt (SName, TName, Password: string);
const
Count = WinSize*WinSize;
var
Buf: array[1..Count] of Byte;
Matrix: array[1..WinSize, 1..WinSize] of Byte;
CurKey: TKey;
I, J, X, Y, PassL, Result, PassD: Integer;
begin
InitKey (Password);
Assign (SFile, SName);
Assign (TFile, TName);
Reset (SFile, 1);
Rewrite (TFile, 1);
PassL:= Length(Password); PassD:= PassL; CurKey:= Key;
FSize:= FileSize(SFile);
BlockWrite (TFile, FSize, SizeOf(FSize));
FillChar (Buf, SizeOf(Buf), 0);
BlockRead (SFile, Buf, Count, Result);
while Result>0 do
begin
if Result<Count then
for I:= Result+1 to Count do
begin
RandSeed:= MaxAvail;
Buf[I]:= Random(256);
end;
for I:= 1 to Count do
begin
Inc (PassD);
if PassD>PassL then PassD:= 1;
Buf[I]:= Buf[I] xor Byte(Password[PassD]);
end;
J:= 0;
for I:= 1 to 4 do
begin
for X:= 1 to WinSize do
for Y:= 1 to WinSize do
if CurKey[X, Y] then
begin
Inc (J);
Matrix[X, Y]:= Buf[J];
end;
TurnKey (CurKey);
end;
BlockWrite (TFile, Matrix, Count);
FillChar (Buf, SizeOf(Buf), 0);
BlockRead (SFile, Buf, Count, Result);
end;
Close (TFile);
Close (SFile);
end;
procedure Decrypt (SName, TName, Password: string);
const
Count = WinSize*WinSize;
var
Buf: array[1..Count] of Byte;
Matrix: array[1..WinSize, 1..WinSize] of Byte;
CurKey: TKey;
I, J, X, Y, PassL, Result, PassD: Integer;
Readed, EofSign: LongInt;
begin
InitKey (Password);
Assign (SFile, SName);
Assign (TFile, TName);
Reset (SFile, 1);
Rewrite (TFile, 1);
PassL:= Length(Password); PassD:= PassL; CurKey:= Key;
FSize:= 0;
BlockRead (SFile, FSize, SizeOf(FSize));
FillChar (Matrix, SizeOf(Matrix), 0);
BlockRead (SFile, Matrix, Count, Result);
Readed:= 0;
while Result>0 do
begin
J:= 0;
EofSign:= FSize-Readed;
for I:= 1 to 4 do
begin
for X:= 1 to WinSize do
for Y:= 1 to WinSize do
if CurKey[X, Y] then
begin
Inc (J);
Buf[J]:= Matrix[X, Y];
end;
TurnKey (CurKey);
end;
for I:= 1 to Count do
begin
Inc (PassD);
if PassD>PassL then PassD:= 1;
Buf[I]:= Buf[I] xor Byte(Password[PassD]);
if I=EofSign then
begin
BlockWrite (TFile, Buf, I);
Close (TFile);
Close (SFile);
Exit;
end;
end;
BlockWrite (TFile, Buf, Count);
FillChar (Matrix, SizeOf(Matrix), 0);
BlockRead (SFile, Matrix, Count, Result);
Inc (Readed, Count);
end;
Close (TFile);
Close (SFile);
end;
end.