TI cool

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

const
   Size = 250000;

type
   MyBoolean = array [1 .. 8] of Boolean;
   Arr = array [1 .. Size] of Byte;
   ChArr = array [1 .. Size] of Char;

  TForm1 = class(TForm)
    Label1: TLabel;
    RadioGroup1: TRadioGroup;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    btnCipher: TButton;
    Button1Decipher: TButton;
    Button1LoadFile: TButton;
    edtKey: TEdit;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button2: TButton;
    procedure Cipher(var f, fcipher: file);
    procedure RC4(var f, fcipher: file);
    procedure GenerateKey;
    function BinToDec(var tempBool: MyBoolean): Byte;
    procedure Button1LoadFileClick(Sender: TObject);
    procedure btnCipherClick(Sender: TObject);
    procedure Button1DecipherClick(Sender: TObject);
    function DecToBin(Number: Byte): MyBoolean;
    procedure edtKeyKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Enter(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
   Form1: TForm1;
   i, count1: Integer;
   f, fcipher, fDecipher: file;
   bufArr: MyBoolean;
   OrigFile: array [1 .. Size] of Byte;
   key: array [1 .. Size * 8] of Boolean;
   reg: array [1 .. 28] of Boolean;
   FName: string;
   count: LongInt;
   arrkey: array [0 .. 700000] of Byte;
   checkRC4key: Boolean;
   buf: Arr;
   fNameCipher, fNameDecipher: string;
   keyLFSR: string;
   keyLFSRCounter, edtCounter: Integer;

implementation

{$R *.dfm}



procedure TForm1.GenerateKey;
var
   i: Integer;
begin
   for i := 1 to 28 do
   begin
      //reg[i] := (edtKey.Text[i] = '1');
      reg[i] := (keyLFSR[i] = '1');
   end;
end;

function TForm1.BinToDec(var tempBool: MyBoolean): Byte;

   function MyPower(Number, N: Byte): Byte;
   var
      i, temp: Byte;
   begin
      temp := 1;
      for i := 1 to N do
         temp := temp * Number;
      Result := temp;
   end;

var
   i: Integer;
   tempRez, pos: Byte;
begin
   pos := 0;
   i := 8;
   tempRez := 0;
   while i <> 0 do
   begin
      if tempBool[i] = True then
      begin
         tempRez := tempRez + MyPower(2, pos);
      end;
      i := i - 1;
      pos := pos + 1;
   end;
   Result := tempRez;
end;

function TForm1.DecToBin(Number: Byte): MyBoolean;
var
   i: Integer;
   modRez: Byte;
   tempBool: MyBoolean;
begin
   for i := 1 to 8 do
      tempBool[i] := False;
   for i := 8 downto 1 do
   begin
      modRez := Number mod 2;
      Number := Number div 2;
      if modRez = 1 then
         tempBool[i] := True
      else
         tempBool[i] := False;
   end;
   Result := tempBool;
end;

procedure TForm1.RC4(var f, fcipher: file);
var
   j, i, outSize: Integer;
   flag, finish: Boolean;
   str: string;
   fText: TextFile;
   s: array [0 .. 256] of Byte;
   t, k: LongInt;
   key: Arr;
   bufch: ChArr;
begin
   finish := True;
   flag := False;
   while not flag do
   begin
      BlockRead(f, buf, Size, count1);
      if count1 < Size then
         flag := True;
      if finish then
      begin
         Memo1.Lines.Clear;
         if count1 < 8 then
            outSize := count1
         else
            outSize := 8;
         for i := 1 to outSize do
         begin
            {bufArr := DecToBin(buf[i]);
            str := '';
            j := 1;
            while j <= 8 do
            begin
               if bufArr[j] = True then
                  str := str + '1'
               else
                  str := str + '0';
               j := j + 1;
            end;
            Memo1.Lines.Add(str);  }
            Memo1.Lines.Add(inttostr(buf[i]));
         end;
      end;
      for i := 0 to 255 do
         s[i] := i;
      j := 0;
      for i := 0 to 255 do
      begin
         j := (j + s[i] + arrkey[i mod count]) mod 256;
         t := s[i];
         s[i] := s[j];
         s[j] := t;
      end;
      Assignfile(fText, FName + 'KEY_RC4');
      Rewrite(fText);
      i := 0;
      j := 0;
      for k := 0 to count1 - 1 do
      begin
         i := (i + 1) mod 256;
         j := (j + s[i]) mod 256;
         t := s[i];
         s[i] := s[j];
         s[j] := t;
         key[k] := s[(s[i] + s[j]) mod 256];
         write(fText, key[k], ' ');
      end;
      closefile(fText);

      if count1 < Size then
         flag := True;
      if finish then
      begin
         Form1.Memo2.Lines.Clear;
         if count1 < 8 then
            outSize := count1
         else
            outSize := 8;
         for i := 0 to outSize - 1 do
         begin
            str := '';
            str := str + inttostr(key[i]);
            Form1.Memo2.Lines.Add(str);
         end;
      end;
      if finish then
      begin
         Memo3.Lines.Clear;
         if count1 < 8 then
            outSize := count1
         else
            outSize := 8;
         for i := 1 to outSize do
            Form1.Memo3.Lines.Add(inttostr(key[i - 1] xor buf[i]));
         for i := 1 to count1 do
         begin
            bufch[i] := chr(key[i - 1] xor buf[i]);
         end;
         for i := 1 to count1 do         ////
            buf[i] := ord(bufch[i]);     ////
         finish := False;                ////
      end;
      //BlockWrite(fcipher, bufch, count1);
      BlockWrite(fcipher, buf, count1);    ///
   end;
end;

procedure TForm1.Cipher(var f, fcipher: file);
var
   tempReg: Boolean;
   i, j, outSize: Integer;
   flag, finish: Boolean;
   s: string;
   first, last: Integer;
begin
   GenerateKey;
   finish := True;
   flag := False;
   while not flag do
   begin
      BlockRead(f, buf, Size, count1);
      if count1 < Size then
         flag := True;
      i := 1;
      while i <= (count1 * 8) do
      begin
         key[i] := reg[1];
         tempReg := reg[1] xor reg[26];
         j := 1;
         while j <= 27 do
         begin
         //for j := 1 to 27 do
            reg[j] := reg[j + 1];
            inc(j);
         end;
         reg[28] := tempReg;
         Inc(i);
      end;

      if finish then
      begin
         Memo1.Lines.Clear;
         if count1 < 8 then
            outSize := count1
         else
            outSize := 8;
         for i := 1 to outSize do
         begin
            bufArr := DecToBin(buf[i]);
            s := '';
            j := 1;
            while j <= 8 do
            begin
               if bufArr[j] = True then
                  s := s + '1'
               else
                  s := s + '0';
               j := j + 1;
            end;
            Memo1.Lines.Add(s);
         end;

         Memo2.Lines.Clear;
         if count1 < 8 then
            outSize := count1
         else
            outSize := 8;
         for i := 1 to outSize do
         begin
            first := i * 8;
            last := i * 8 - 7;
            j := 8;
            while first >= last do
            begin
               bufArr[j] := key[first]; // ??? ??????
               Dec(first);
               Dec(j);
            end;
            s := '';
            j := 1;
            while j <= 8 do
            begin
               if bufArr[j] = True then
                  s := s + '1'
               else
                  s := s + '0';
               j := j + 1;
            end;
            Memo2.Lines.Add(s);
         end;
      end;
      for i := 1 to count1 do
      begin
         first := i * 8;
         last := i * 8 - 7;
         j := 8;
         while first >= last do
         begin
            bufArr[j] := key[first]; // ?????? ??? ????????? 1 ?????
            Dec(first);
            Dec(j);
         end;
         buf[i] := buf[i] xor BinToDec(bufArr);
      end;
      if finish then
      begin
         Memo3.Lines.Clear;
         if count1 < 8 then
            outSize := count1
         else
            outSize := 8;
         for i := 1 to outSize do
         begin
            bufArr := DecToBin(buf[i]);
            s := '';
            j := 1;
            while j <= 8 do
            begin
               if bufArr[j] = True then
                  s := s + '1'
               else
                  s := s + '0';
               j := j + 1;
            end;
            Memo3.Lines.Add(s);
         end;
         finish := False;
      end;
      BlockWrite(fcipher, buf, count1);
   end;
end;

procedure TForm1.Button1LoadFileClick(Sender: TObject);
var
   temp, keyRC4: string;
   c: string;
   x, code: LongInt;
begin
   {if Length(edtKey.Text) <> 28 then
   begin
      ShowMessage('??????? ????');
      Exit;
   end;    }
   if RadioGroup1.ItemIndex = 0 then
   begin
      label1.Visible := True;
      temp := '';
      if length(keyLFSR) < 28 then
      begin
      //temp := temp + copy(keyLFSR, 1, length(keyLFSR));
         for i := 1 to 28 - length(keyLFSR) do
            temp := temp + '0';
      //insert(temp, keyLFSR, length(keyLFSR) + 1);
         temp := temp + copy(keyLFSR, 1, length(keyLFSR));
         keyLFSRCounter := 28;
         edtCounter := 28;
      end;
      if length(keyLFSR) >= 28 then
      begin
         temp := temp + copy(keyLFSR, 1, 28);
         keyLFSRCounter := 28;
         edtCounter := 28;
      end;
      if Length(keyLFSR) = 0 then
      begin
         ShowMessage('Ââåäèòå êîððåêòíûé êëþ÷');
         Exit;
      end;
      {label1.Caption := IntToStr(Length(temp)) + '/28';
      edtKey.Text := temp;
      keyLFSR :=  temp;}
      edtKey.Text := temp;
      keyLFSR :=  temp;
      label1.Caption := IntToStr(keyLFSRCounter) + '/28';
   end;
   if RadioGroup1.ItemIndex = 1 then
   begin
      count := 0;
      temp := edtKey.Text;
      c := temp + ' ';
      while c <> '' do
      begin
         Val(Copy(c, 1, pos(' ', c) - 1), x, code);
         Delete(c, 1, pos(' ', c));
         if (code = 0) and (x <= 256) and (x >= 0) then
         begin
            arrkey[count] := x;
            Inc(count);
         end;
      end;
      if count = 0 then
      begin
         ShowMessage('Ââåäèòå êîððåêòíûé êëþ÷');
         Exit;
      end;
   end;
   if not OpenDialog1.Execute then
      Exit;
   FName := OpenDialog1.FileName;
   Assignfile(f, FName);
   reset(f, 1);
   i := Length(FName);
   fNameCipher := FName;
   while fNameCipher[i] <> '.' do
      Dec(i);
   Insert('  CIPHER', fNameCipher, i);
   Assignfile(fcipher, fNameCipher);
   fNameDecipher := fNameCipher;
   Insert(' DE', fNameDecipher, pos('CIPHER', fNameDecipher));
   Assignfile(fDecipher, fNameDecipher);
   btnCipher.Enabled := True;
   Button1Decipher.Enabled := True;
end;



procedure TForm1.btnCipherClick(Sender: TObject);
begin
   {if Length(edtKey.Text) <> 28 then
   begin
      ShowMessage('??????? ????');
      Exit;
   end;  }
   reset(f, 1);
   Rewrite(fcipher, 1);
   if RadioGroup1.ItemIndex = 0 then
      Cipher(f, fcipher);
   if RadioGroup1.ItemIndex = 1 then
      RC4(f, fcipher);
   closefile(f);
   closefile(fcipher);
   ShowMessage('Successfully ciphered');
end;

procedure TForm1.Button1DecipherClick(Sender: TObject);
begin
   {if Length(edtKey.Text) <> 28 then
   begin
      ShowMessage('??????? ????');
      Exit;
   end;     }
   reset(fcipher, 1);
   Rewrite(fDecipher, 1);
   if RadioGroup1.ItemIndex = 0 then
      Cipher(fcipher, fDecipher);
   if RadioGroup1.ItemIndex = 1 then
      RC4(fcipher, fDecipher);
   closefile(fcipher);
   closefile(fDecipher);
   ShowMessage('Successfully deciphered');
end;

procedure TForm1.edtKeyKeyPress(Sender: TObject; var Key: Char);
var
  temp: string;
  i, k: integer;
const
   Digit: set of Char = ['0', '1'];
begin
   if RadioGroup1.ItemIndex = 0 then
      label1.Visible := True
   else
   //begin
      label1.Visible := False;
   //   Button1.Visible := True;
   //end;
   if (key <> #8) and (keyLFSRCounter < 45) then
      inc(edtCounter);
   if key in digit then
   begin
      //keyLFSR := keyLFSR + key;
      //inc(keyLFSRCounter);
      //label1.Caption := IntToStr(Length(keyLFSR)) + '/28';
      if keyLFSRCounter <> 45 then
      begin
         keyLFSR := keyLFSR + key;
         inc(keyLFSRCounter);
         label1.Caption := IntToStr(Length(keyLFSR)) + '/28';
      end;
   end;
   if key = #8 then
   begin
      if edtCounter <> 0 then
      begin
         if edtKey.Text[edtCounter] in Digit then
         begin
            keyLFSR := copy(keyLFSR, 1, keyLFSRCounter - 1);
            dec(keyLFSRCounter);
            //label1.Caption := IntToStr(Length(keyLFSR)) + '/28';
            label1.Caption := IntToStr(keyLFSRCounter) + '/28';
         end;
         dec(edtCounter);
      end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   keyLFSRCounter := 0;
   edtCounter := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   c: string;
   x, code: LongInt;
begin
   count := 0;
   if OpenDialog1.Execute then
   begin
      Assignfile(input, OpenDialog1.FileName);
      reset(input);
      while not(Eof(input)) do
      begin
         readln(c);
         c := c + ' ';
         while c <> '' do
         begin
            Val(Copy(c, 1, pos(' ', c) - 1), x, code);
            Delete(c, 1, pos(' ', c));
            if (code = 0) and (x <= 256) and (x >= 0) then
            begin
               arrkey[count] := x;
               Inc(count);
            end;
         end;
      end;
      closefile(input);
   end;
   checkRC4key := False;
   if count <> 0 then
      checkRC4key := True
   else
      Application.MessageBox
        ('ôàéë ñ êëþ÷îì ïóñò èëè ñîäåðæèò íåêîððåêòíûå äàííûå', 'îøèáêà')
end;

procedure TForm1.RadioGroup1Enter(Sender: TObject);
begin
   edtKey.Visible := not ((RadioGroup1.ItemIndex = 0) and (RadioGroup1.ItemIndex = 1));
   edtKey.Clear;
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   Button2.Visible := True;
   Button1LoadFile.Visible := True;
   btnCipher.Visible := True;
   Button1Decipher.Visible := True;
   btnCipher.Enabled := False;
   Button1Decipher.Enabled := False;
   label1.Caption := '0' + '/28';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   keyLFSRCounter := 0;
   edtCounter := 0;
   keyLFSR := '';
   edtKey.Clear;
   Memo1.Clear;
   Memo2.Clear;
   Memo3.Clear;
   label1.Visible := false;
   label1.Caption := '0' + '/28';
   RadioGroup1.ItemIndex := -1;
   Button1LoadFile.Visible := False;
   btnCipher.Visible := False;
   Button1Decipher.Visible := False;
end;

end.