一个加解密算法

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.