this slowpoke moves

RC4-HEX String Crypter

type
  TRC4Context = record
    D: array[Byte] of Byte;
    I,J: Byte;
end;

//

function StringAsHex(Value : string) : string;
var
  i : integer;
begin
  result:='';
  for i := 1 to Length(Value) do
  begin
    Result := result + IntToHex(Ord(Value[i]), 2);
  end;
end;

FUNCTION HexToByte(s:shortstring):Byte;
Const    hex : string = '0123456789abcdef';
VAR   num:byte;
BEGIN
     s:= lowercase(s);
     num:=(pos(s[1],hex)-1)*16+(pos(s[2],hex)-1);
     Result:=byte(num);
END;

function HexToString(HexString:String):String;
var
  i: Integer;
begin
  for i:= 0 to (length(HexString) div 2 -1) do
  begin
    result:=result + chr(HexToByte(HexString[(i*2)+1]+HexString[(i*2)+2]));
  end;
end; 

procedure RC4Init(var RC4: TRC4Context; const Key: String);
var
  R,S,T,K: Byte;
  U,L: Integer;
begin
  L := Length(Key);
  with RC4 do
  begin
    I := 0;
    J := 0;
    for S := 0 to 255 do D[S] := S;
    R := 0;
    U := 0;
    for S := 0 to 255 do
    begin
      if U < L then K := PByteArray(Key)[U] else K := 0;
      Inc(U);
      if U >= L then U := 0;

      Inc(R, D[S] + K);
      T := D[S];
      D[S] := D[R];
      D[R] := T;
    end;
  end;
end;

procedure RC4Code(var RC4: TRC4Context; const Source; var Dest; Count: Integer);
var
  S: Integer;
  T: Byte;
begin
  with RC4 do
    for S := 0 to Count -1 do
    begin
      Inc(I);
      T := D[I];
      Inc(J, T);
      D[I] := D[J];
      D[J] := T;
      Inc(T, D[I]);
      TByteArray(Dest)[S] := TByteArray(Source)[S] xor D[T];
    end;
end;

procedure RC4Done(var RC4: TRC4Context);
begin
  FillChar(RC4, SizeOf(RC4), 0);
end;
Crypt :
procedure TForm1.Button1Click(Sender: TObject);
var
  x: TRC4Context;
  str1, str2, str3: string;
begin
  //readLn(str1);
  str1 := Memo1.Text;
  setLength(str2,length(str1));
  //writeLn('text: '+str1);

  RC4Init(x,'Passwort');
  RC4Code(x, str1[1], str2[1], Length(str1)); 
  Rc4Done(x);
  Memo2.Text := StringAsHex(str2)
end;
Decrypter :
procedure TForm1.Button2Click(Sender: TObject);
var
  x: TRC4Context;
  str1, str2, str3: string;
begin
  //readLn(str1);
  str1 := HexToString(Memo2.Text);
  setLength(str2,length(str1));
  //writeLn('text: '+str1);

  RC4Init(x,'Passwort');
  RC4Code(x, str1[1], str2[1], Length(str1));
  Rc4Done(x);
  Memo1.Text := str2;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate