• Здраво и добредојдовте на форумот на IT.mk.

    Доколку сеуште не сте дел од најголемата заедница на ИТ професионалци и ентузијасти во Македонија, можете бесплатно да се - процесот нема да ви одземе повеќе од 2-3 минути, а за полесна регистрација овозможивме и регистрирање со Facebook и Steam.

[Delphi]Енкрипција на текст

  • Ја почнал/а темата
  • #1

Coolzrock

Intern
28 октомври 2008
139
5
Код:
unit unRC4;
 
interface
 
type
  PByteArray = ^TByteArray;
  TByteArray = Array [0..32767] Of Byte;
 
  TRC4 = class
  private
    D               : array[Byte] of Byte;
    I,J             : Byte;
    procedure Init(const Key: string);
    procedure Done;
    procedure Code(Source, Dest: pChar; Count: Integer);
  public
    function Encrypt(S: pChar; const Password: string): AnsiString;
    function Decrypt(S: pChar; const Password: string): AnsiString;
  end;
 
implementation
 
{ TRC4.Encrypt
  This function will return the text(S) encrypted with the chosen password. }
function TRC4.Encrypt(S: pChar; const Password: string): AnsiString;
begin
  SetLength(Result, Length(S));
  Init(Password);
  Code(pChar(S), pChar(Result), Length(S));
  Done;
end;
 
{ TRC4.Decrypt
  This function will return the text(S) decrypted with the chosen password. }
function TRC4.Decrypt(S: pChar; const Password: string): AnsiString;
begin
  SetLength(Result, Length(S));
  Init(Password);
  Code(pChar(S), pChar(Result), Length(S));
  Done;
end;
 
{ TRC4.Init
  This routine will prepare the encryption/decryption. }
procedure TRC4.Init(const Key: string);
var
  R, S, T, K        : Byte;
  U,L               : Integer;
  DummyArray        : array [0..1599] of Char;
begin
{$R-}
{$Q-}
  L := Length(Key);
  I := 0;
  J := 0;
  R := 0;
  U := 0;
  for S := 0 to 255 do
    D[S] := S;
  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;
  Code(@DummyArray, @DummyArray, 1600);
end;
 
{ TRC4.Done
  This routine will clean the variables used when encrypting/decrypting. }
procedure TRC4.Done;
begin
  FillChar(D, sizeOf(D), 0);
  FillChar(I, sizeOf(I), 0);
  FillChar(J, sizeOf(J), 0);
end;
 
{ TRC4.Code
  This routine will encrypt the text. }
procedure TRC4.Code(Source, Dest: pChar; Count: Integer);
var
  S                 : Integer;
  T                 : Byte;
begin
  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]);
    Byte(Dest[S]) := Byte(Source[S]) xor D[T];
  end;
end;
 
end.
 

Aleks

Gaining Experience
18 мај 2007
5,748
288
Ако веќе пастираш туѓи кодови наведи ја нивната локација од каде си ги нашол а не вака.
 

gOJDO

Epic
23 јануари 2008
9,764
14,886
сред село
gOJDO's setup  
Processor & Cooler
Intel со вентилатор
Motherboard
Asus
Storage
полн
PSU
ЕВН Снабдување
RAM
алуминиумски
Video card
Super VGA
Case
closed
Mouse
хрчак домашен
Keyboard
механичка
Audio
сардисаунд
Monitor
телевизор у боја
OS
Windows

Нови мислења

Последни Теми

Статистика

Теми
43,594
Мислења
824,200
Членови
28,086
Најнов член
martinivs
На врв Дно