Jedna procedura służy do szyfrowania i rozszyfrowania informacji. Moc kryptograficzna tego szyfru zależy od długości klucza. Jeżeli klucz będzie zawierał pusty łańcuch to funkcja wykorzysta zawarty w niej klucz domyślny.
function DenCrypt(Str : string; Key : string): string;
var X, Y : Integer; A : Byte;
begin
if Key = '' then Key := 'd1duOsy3n6qrPr2eF9u';
Y := 1;
for X := 1 to length(Str) do begin
A := (ord(Str[X]) and $0f) xor (ord(Key[Y]) and $0f);
Str[X] := char((ord(Str[X]) and $f0) + A);
inc(Y);
if Y > length(Key) then Y := 1; end; Result := Str;
end;
unit untCrypt;
interface
function Crypt(const strText: string; const intKey: longint): string; // funkcja szyfrująca
function Decrypt(const strText: string; const intKey: longint): string; //funkcja rozszyfrująca
const intDefKey = -967283; // wybrany klucz domyślny gdyby IntKey =0
implementation
function Crypt(const strText: string; const intKey: longint): string;
var i: integer; strResult: string;
begin // initialize result
strResult := strText; // zmienna RandSeed z losowo generowanymi znakami
RandSeed := intKey; // szyfrowanie
for i := 1 to Length(strText) do
strResult[i] := Chr(Ord(strResult[i]) xor Random(255));
Crypt := strResult; // ustaw wynik
end;
function Decrypt(const strText: string; const intKey: longint): string;
begin // rozszyfrowanie łańcucha znaków
Decrypt := Crypt(strText, intKey);
end;
end.
Przykład użycia tego szyfru:
var s: string;
begin
s := 'Ala ma kota a kot ma Alę';
s := Crypt(s,12345);
ShowMessage(Format('Zaszyfrowane słowa: %s', [s]));
ShowMessage(Format('Rozszyfrowane słowa: %s', [decrypt(s,12345)]));
Hasło jest liczbą, wspólną dla kodowania i rozkodowania funkcją XorStr
function XorStr(Stri, Strk: String): String;
var Longkey: string; I: Integer; Next: char;
begin
for I := 0 to (Length(Stri) div Length(Strk)) do Longkey := Longkey + Strk;
for I := 1 to length(Stri) do begin
Next := chr((ord(Stri[i]) xor ord(Longkey[i]))); Result := Result + Next;
end; end;
procedure TForm1.Button1Click(Sender: TObject);
begin { kodowanie }
Edit1.Text := XorStr('The String', '1234567890');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin { Rozkodowanie }
Edit2.Text := XorStr(Edit1.Text, '1234567890');
end;
const C1 = 52845; C2 = 22719; //deklaracja stałych
function Encrypt(const S: String; Key: Word): String;
var I: byte;
begin
Result[0] := S[0]; for I := 1 to Length(S) do begin
Result[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(Result[I]) + Key) * C1 + C2;
end; end;
function Decrypt(const S: String; Key: Word): String;
var I: byte;
begin
Result[0] := S[0]; for I := 1 to Length(S) do begin
Result[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(S[I]) + Key) * C1 + C2;
end; end;
function Decode(const S: AnsiString): AnsiString;
const
Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0);
var I: LongInt;
begin
case Length(S) of
2: begin
I := Map[S[1]] + (Map[S[2]] shl 6); SetLength(Result, 1);
Move(I, Result[1], Length(Result)) end;
3: begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12); SetLength(Result, 2);
Move(I, Result[1], Length(Result)) end;
4: begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) + (Map[S[4]] shl 18);
SetLength(Result, 3); Move(I, Result[1], Length(Result))
end end end;
function Encode(const S: AnsiString): AnsiString;
const
Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
'abcdefghijklmnopqrstuvwxyz0123456789+/';
var I: LongInt;
begin
I := 0; Move(S[1], I, Length(S));
case Length(S) of
1: Result := Map[I mod 64] + Map[(I shr 6) mod 64];
2: Result := Map[I mod 64] + Map[(I shr 6) mod 64] + Map[(I shr 12) mod 64];
3: Result := Map[I mod 64] + Map[(I shr 6) mod 64] + Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
end end;
W przypadku zakodowania pliku graficznego przy pomocy dowolnego kodu traci on swoje właściwości pliku graficznego i nie jest rozpoznawany i automatycznie uruchamiany z poziomu systemu Windows. Poniższy kod robi z bitmapy sieczkę, która jest jednak traktowana jako bitmapa.
procedure EncryptBMP(const BMP: TBitmap; Key: Integer);
var BytesPorScan: Integer; w, h: integer; p: pByteArray;
begin
try BytesPorScan := Abs(Integer(BMP.ScanLine[1]) - Integer(BMP.ScanLine[0]));
except raise Exception.Create('Error'); end; RandSeed := Key;
for h := 0 to BMP.Height - 1 do begin
P := BMP.ScanLine[h]; for w := 0 to BytesPorScan - 1 do
P^[w] := P^[w] xor Random(256);
end; end;
//i przykład kodowania przy pomocy klucza liczbowego - 623 ..........
procedure TForm1.Button1Click(Sender: TObject);
begin
EncryptBMP(Image1.Picture.Bitmap, 623); Image1.Refresh;
end;
poniżej dodatkowy plik z funkcjami szyfrującymi, który należy dołączyć (uses) do formatki naszego programu. Wadą tego szyfru jest fakt kodowania za pomocą jednoznakowego hasła.
unit EncodStr;
interface
uses Classes;
type TEncodedStream = class (TFileStream)
private
FKey: Char;
public
constructor Create(const FileName: string; Mode: Word);
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
property Key: Char read FKey write FKey default 'A';
end;
implementation
constructor TEncodedStream.Create( const FileName: string; Mode: Word);
begin
inherited Create (FileName, Mode); FKey := 'A';
end;
function TEncodedStream.Write(const Buffer; Count: Longint): Longint;
var pBuf, pEnc: PChar; I, EncVal: Integer;
begin // allocate memory for the encoded buffer
GetMem (pEnc, Count);
try // use the buffer as an array of characters
pBuf := PChar (@Buffer); // for every character of the buffer
for I := 0 to Count - 1 do begin // encode the value and store it
EncVal := ( Ord (pBuf[I]) + Ord(Key) ) mod 256; pEnc [I] := Chr (EncVal);
end; // write the encoded buffer to the file
Result := inherited Write (pEnc^, Count);
finally FreeMem (pEnc, Count); end;
end;
function TEncodedStream.Read(var Buffer; Count: Longint): Longint;
var pBuf, pEnc: PChar; I, CountRead, EncVal: Integer;
begin // allocate memory for the encoded buffer
GetMem (pEnc, Count);
try // read the encoded buffer from the file
CountRead := inherited Read (pEnc^, Count); // use the output buffer as a string
pBuf := PChar (@Buffer); // for every character actually read
for I := 0 to CountRead - 1 do begin // decode the value and store it
EncVal := ( Ord (pEnc[I]) - Ord(Key) ) mod 256; pBuf [I] := Chr (EncVal); end;
finally FreeMem (pEnc, Count);
end; // return the number of characters read
Result := CountRead;
end;
end.
//a poniżej przykłady użycia tego szyfru w naszym programie
//szyfrowanie - tekst z pola Memo1 zapisujemy do pliku z jednoczesnym szyfrowaniem jego treści....
procedure TForm1.Button1Click(Sender: TObject);
var EncStr: TEncodedStream;
begin
if SaveDialog1.Execute then begin
EncStr := TEncodedStream.Create( SaveDialog1.Filename, fmCreate);
try Memo1.Lines.SaveToStream (EncStr);
finally EncStr.Free;
end; end; end;
//rozszyfrowanie - ładujemy na Memo1 treść z pliku, która jest w locie rozszyfrowana.....
procedure TForm1.Button2Click(Sender: TObject);
var EncStr: TEncodedStream;
begin
if OpenDialog1.Execute then begin
EncStr := TEncodedStream.Create(OpenDialog1.FileName, fmOpenRead);
try Memo2.Lines.LoadFromStream (EncStr);
finally EncStr.Free;
end; end; end;
Ciekawy bowiem ta sama procedura służy do kodowania i rozkodowania tekstu. Jedynie zmienna decode przyjmuje własciwość FALSE podczas kodowania oraz TRUE przy rozkodowywaniu. Szyfr potrzebuje modułów: Windows, SysUtils, Classes. Hasło może być dowolnym stringiem
var s: string;
procedure Code(var text: string; password: string; decode: boolean);
var i, PasswordLength: integer; sign: shortint;
begin
PasswordLength := length(password);
if PasswordLength = 0 then Exit;
if decode then sign := -1
else sign := 1;
for i := 1 to Length(text) do text[i] := chr(ord(text[i]) + sign * ord(password[i mod PasswordLength + 1]));
end;
//a oto przykład kodowania tekstu....
procedure TForm1.Button1Click(Sender: TObject);
begin
s := Memo1.Text; code(s, Edit1.Text, false);
Memo1.Text := s;
end;
//i przykład rozkodowania......
procedure TForm1.Button2Click(Sender: TObject);
begin
code(s, Edit1.Text, true); Memo1.Text := s;
end;
Trochę to skomplikowane bo:
1. Te dwie funkcje są używane do szyfrowania i deszyfrowania tekstu.
2. Kluczem szyfrujacym są 4 liczby z zakresy 1 do 120, z tym że iloczyn liczb Key1 * Key4 musi być różny
od iloczynu Key2 * Key3 bo inaczej funkcja zwróci zero.
3.Tych samych numerów należy używac do szyfrowania i dekryptażu.
function Encrypt(Text : string; Key1, Key2, Key3, Key4 : Integer) : string;
var BufS, Hexa, Hexa1, Hexa2 : string; BufI, BufI2, Sc, Sl,
Num1, Num2, Num3, Num4, Res1, Res2, Res3, Res4 : Integer;
begin
Sl := Length(Text); Sc := 0; BufS := '';
if (Key1 in [1 .. 120]) and (Key2 in [1 .. 120]) and (Key3 in [1 .. 120]) and (Key4 in [1 .. 120]) then
begin
BufI := Key1 * Key4; BufI2 := Key3 * Key2; BufI := BufI - BufI2; if BufI = 0 then
begin
Result := ''; Exit; end;
end else begin
Result := ''; Exit; end;
repeat
Inc(Sc); if Sc > Sl then Num1 := 0 else Num1 := Ord(Text[Sc]); Inc(Sc);
if Sc > Sl then Num2 := 0 else Num2 := Ord(Text[Sc]);
Inc(Sc);
if Sc > Sl then Num3 := 0 else Num3 := Ord(Text[Sc]);
Inc(sc);
if Sc > Sl then Num4 := 0 else Num4 := Ord(Text[Sc]);
Res1 := Num1 * Key1; BufI := Num2 * Key3; Res1 := Res1 + BufI;
Res2 := Num1 * Key2; BufI := Num2 * Key4; Res2 := Res2 + BufI;
Res3 := Num3 * Key1; BufI := Num4 * Key3; Res3 := Res3 + BufI;
Res4 := Num3 * Key2; BufI := Num4 * Key4; Res4 := Res4 + BufI;
for BufI := 1 to 4 do
begin
case BufI of
1 : Hexa := IntToHex(Res1, 4);
2 : Hexa := IntToHex(Res2, 4);
3 : Hexa := IntToHex(Res3, 4);
4 : Hexa := IntToHex(Res4, 4);
end;
Hexa1 := '$' + Hexa[1] + Hexa[2]; Hexa2 := '$' + Hexa[3] + Hexa[4];
if (Hexa1 = '$00') and (Hexa2 = '$00') then
begin
Hexa1 := '$FF'; Hexa2 := '$FF'; end;
if Hexa1 = '$00' then Hexa1 := '$FE'; if Hexa2 = '$00' then
begin
Hexa2 := Hexa1; Hexa1 := '$FD';
end;
BufS := BufS + Chr(StrToInt(Hexa1)) + Chr(StrToInt(Hexa2));
end;
until Sc >= Sl; Result := BufS;
end;
function Decrypt(Text : string; Key1, Key2, Key3, Key4 : Integer) : string;
var BufS, Hexa1, Hexa2 : string; BufI, BufI2, Divzr, Sc, Sl,
Num1, Num2, Num3, Num4, Res1, Res2, Res3, Res4 : Integer;
begin
Sl := Length(Text); Sc := 0; BufS := '';
if (Key1 in [1 .. 120]) and (Key2 in [1 .. 120]) and (Key3 in [1 .. 120]) and (Key4 in [1 .. 120]) then
begin
Divzr := Key1 * Key4; BufI2 := Key3 * Key2; Divzr := Divzr - BufI2; if Divzr = 0 then
begin
Result := ''; Exit; end;
end else begin
Result := ''; Exit; end;
repeat
for BufI := 1 to 4 do begin
Inc(Sc); Hexa1 := IntToHex(Ord(Text[Sc]), 2);
Inc(Sc); Hexa2 := IntToHex(Ord(Text[Sc]), 2);
if Hexa1 = 'FF' then
begin
Hexa1 := '00'; Hexa2 := '00';
end;
if Hexa1 = 'FE' then Hexa1 := '00'; if Hexa1 = 'FD' then
begin
Hexa1 := Hexa2; Hexa2 := '00'; end;
case BufI of
1 : Res1 := StrToInt('$' + Hexa1 + Hexa2);
2 : Res2 := StrToInt('$' + Hexa1 + Hexa2);
3 : Res3 := StrToInt('$' + Hexa1 + Hexa2);
4 : Res4 := StrToInt('$' + Hexa1 + Hexa2);
end; end;
BufI := Res1 * Key4; BufI2 := Res2 * Key3; Num1 := BufI - BufI2;
Num1 := Num1 div Divzr; BufI := Res2 * Key1; BufI2 := Res1 * Key2;
Num2 := BufI - BufI2; Num2 := Num2 div Divzr; BufI := Res3 * Key4;
BufI2 := Res4 * Key3; Num3 := BufI - BufI2; Num3 := Num3 div Divzr;
BufI := Res4 * Key1; BufI2 := Res3 * Key2; Num4 := BufI - BufI2;
Num4 := Num4 div Divzr;
BufS := BufS + Chr(Num1) + Chr(Num2) + Chr(Num3) + Chr(Num4);
until Sc >= Sl; Result := BufS;
end;
Ten mały fragment kodu pozwala na szybkie tworzenie obrony shareware, która nie wpływa na funkcjonalność programu, ale "prosi", aby zarejestrować program. Program z tym kodem (jak shareware) może być użyty tylko 1 raz; ponowne użycie - po restarcie systemu. Bazuje na obsłudze zdarzenia - w Onformshow:
procedure tform1.formshow(sender: tobject);
var atom: integer; crlf: string;
begin
if globalfindatom('this_is_some_obscuree_text') = 0 then
atom := globaladdatom('this_is_some_obscuree_text') //unikalny string w PC
else begin
crlf := #10 + #13; //zmiana linii i na początek wiersza
showmessage('Ta wersja może być użyta tylko raz '
+ 'w danym seansie Windowsa.' + crlf
+ 'dla kolejnych uruchomień'
+ crlf + 'należy program ZAREJESTROWAĆ !');
close;
end; end;
const csCryptFirst = 20; csCryptSecond = 230; csCryptHeader = 'Crypted';
type ECryptError = class(Exception);
function CryptString(Str:String):String;
var i,clen : Integer;
begin
clen := Length(csCryptHeader); SetLength(Result, Length(Str)+clen);
Move(csCryptHeader[1], Result[1], clen); For i := 1 to Length(Str) do
begin
if i mod 2 = 0 then
Result[i+clen] := Chr(Ord(Str[i]) xor csCryptFirst)
else
Result[i+clen] := Chr(Ord(Str[i]) xor csCryptSecond);
end; end;
function UnCryptString(Str:String):String;
var i, clen : Integer;
begin
clen := Length(csCryptHeader); SetLength(Result, Length(Str)-clen);
if Copy(Str, 1, clen) < > csCryptHeader then
raise ECryptError.Create('UnCryptString failed');
For i := 1 to Length(Str)-clen do
begin
if (i) mod 2 = 0 then Result[i] := Chr(Ord(Str[i+clen]) xor csCryptFirst)
else
Result[i] := Chr(Ord(Str[i+clen]) xor csCryptSecond);
end; end;
Prosty ale skuteczny przykład szyfru XOR:
var key, text, longkey, result : string; i : integer; toto, c : char;
begin
for i := 0 to (length(text) div length(key)) do longkey := longkey + key;
for i := 1 to length(text) do
begin
toto := chr((ord(text[i]) XOR ord(longkey[i]))); // XOR algorytm
result := result + toto; end;
end;
Ta metoda szyfrowania polega na zastąpieniu całych zdań, słów, sylab, liter cyfr w różnych kombinacjach na podstawie wcześniej przyjętego systemu, który jest zarazem kluczem do odszyfrowania tekstu. Jego moc kryptograficzna jest ograniczona; może być z powodzeniem stosowany jako szyfr wstępny przy wielostopniowym kodowaniu.
Poniżej przykład najprostszy - szyfrowanie operacji liczbowych. Według takiego modelu można zmieniać nawet wszystkie znaki.
Procedure Code (Code: String; var Rez: String);
Begin // to właściwie baza szyfrowania -tak program będzie zamieniał symbole (słowa, frazy)
If code='0' then Rez:='5';
If code='1' then Rez:='i';
If code='2' then Rez:='x';
If code='3' then Rez:='p';
If code='4' then Rez:='9';
If code='5' then Rez:='8';
If code='6' then Rez:='*';
If code='7' then Rez:='-';
If code='8' then Rez:='+';
If code='9' then Rez:='!';
End;
Procedure Decode (Code: String; var Rez: String);
Begin // w procesie dekryptażu symbole odzyskają swoje wartości
If code='5' then Rez:='0';
If code='i' then Rez:='1';
If code='x' then Rez:='2';
If code='p' then Rez:='3';
If code='9' then Rez:='4';
If code='8' then Rez:='5';
If code='*' then Rez:='6';
If code='-' then Rez:='7';
If code='+' then Rez:='8';
If code='!' then Rez:='9';
End;
Teraz w zdarzeniu OnClick dla Button1 i Button2 piszemy:
Procedure TForm1.Button1Click (Sender: TObject);
Var Result: String; //zmienna wyjsciowa - aby zapisać wynik
Begin
Code(Edit1.Text, Result); //Zabieg pobierania tekstu z Edit1 i do zmiennej wyjściowej.
Result:=” ); //jeżeli w Edit1 nie ma tekstu to wynik pusty
Edit1.Text:=Result; //w Edit1 wprowadzany jest tekst zaszyfrowany
End;
Procedure TForm1.Button2Click (Sender: TObject);
Var Result: String; //zmienna wyjsciowa - aby zapisać wynik
Begin
Decode(Edit1.Text, Result); //Zabieg pobierania tekstu z Edit1 i do zmiennej wyjściowej.
Edit1.Text:=Result;
End;
procedure TForm1.Button1Click(Sender: TObject);
var s: String[255]; c: array[0..255] of Byte absolute s; i: Integer;
begin {kodowanie hasła}
s := 'Znaki hasła';
for i := 1 to Ord(s[0]) do c[i] := 23 xor c[i]; Label1.Caption := s;
{rozkodowanie hasła}
s := Label1.Caption;
for i := 1 to Length(s) do s[i] := Char(23 xor Ord(c[i])); Label2.Caption := s;
end;
function VigenerCoDec(Input, Key: pchar): pchar
var i, j: integer; tmps, text: string;
begin
text := Input; for i := 1 to length(text) do
begin
if i > length(key) then j := i mod length(key)
else
j := i; tmps := tmps + chr((ord(text[i])) xor (ord(key[j])));
end; result := pchar(tmps);
end;
//przykład kodowania - lub rozkodowania bo funkcja wspólna:
Text := edit1.text; // tekst do zakodowania
K := edit2.text; // hasło dowolne znaki
Edit3.text := VigenerCoDec(Text, K); //Edit3 - tam tekst zakodowany
unit ucrypt;
interface
type TEAKey = array[0..3] of cardinal;
procedure TEA_Encode(Input, Output: pointer; size: integer; key: TEAKey);
procedure TEA_Decode(Input, Output: pointer; size: integer; key: TEAKey);
implementation
type TEAData = array[0..1] of cardinal;
PTEAKey = ^TEAKey;
PTEAData = ^TEAData;
procedure TEA_Cipher(v: PTEAData; var w: PTEAData; k: PTEAKey);
var y, z, sum, delta, n: Cardinal;
begin
y := (v)[0]; z := (v)[1]; sum := 0; delta := $9E3779B9; n := 32;
while (n > 0) do
begin
inc(y, (z shl 4 xor z shr 5) + z xor sum + (k)[sum and 3]); inc(sum, delta);
inc(z, (y shl 4 xor y shr 5) + y xor sum + (k)[sum shr 11 and 3]); dec(n);
end;
(w)[0] := y; (w)[1] := z;
end;
procedure TEA_DeCipher(v: PTEAData; var w: PTEAData; k: PTEAKey);
var y, z, sum, delta, n: Cardinal;
begin
y := v[0]; z := v[1]; sum := $0C6EF3720; delta := $9E3779B9; n := 32;
while (n > 0) do
begin
dec(z, (y shl 4 xor y shr 5) + y xor sum + k[sum shr 11 and 3]); dec(sum, delta);
dec(y, (z shl 4 xor z shr 5) + z xor sum + k[sum and 3]); dec(n);
end;
w[0] := y; w[1] := z;
end;
procedure TEA_EnDec(encode: boolean; Input, Output: pointer; size: integer; key: TEAKey);
var DataIn, DataOut: TEAData; DOut: PTEAData; i, sz: integer;
begin
DOut := @DataOut; sz := (size shr 3) shl 3; i := 0;
repeat
DataIn[0] := Cardinal((pointer(Cardinal(Input) + Cardinal(i)))^);
DataIn[1] := Cardinal((pointer(Cardinal(Input) + Cardinal(i + 4)))^);
if encode then
TEA_Cipher(@DataIn, DOut, @key)
else
TEA_DECipher(@DataIn, DOut, @key);
Cardinal(pointer(Cardinal(Output) + Cardinal(i))^) := DataOut[0];
Cardinal(pointer(Cardinal(Output) + Cardinal(i + 4))^) := DataOut[1];
inc(i, 8); until i >= sz;
end;
procedure TEA_Encode(Input, Output: pointer; size: integer; key: TEAKey);
begin
TEA_EnDec(true, Input, Output, size, key);
end;
procedure TEA_Decode(Input, Output: pointer; size: integer; key: TEAKey);
begin
TEA_EnDec(false, Input, Output, size, key);
end;
end.
{$I-,R-} Unit Crypter;
interface
Uses Objects;
procedure EnCrypt(var Pntr: Array of Char; ArrLen: Word; password: string);
{ - szyfruje blok tekstu }
procedure DeCrypt(var Pntr: Array of Char; ArrLen: Word; password: string);
{ - rozszyfruje blok... }
procedure EnCryptStream(var st: tStream; Password: String);
{ -szyfrowanie streamu - strumienia }
procedure DeCryptStream(var st: tStream; Password: String);
{ - rozszyfrowanie streamu }
implementation
procedure EnCrypt(var Pntr: Array of Char; ArrLen:Word; password: string);
var len,pcounter: byte; x:Word;
begin
len := length(password) div 2; pcounter := 1;
for x:=0 to ArrLen-1 do begin
Pntr[x] := chr(ord(password[pcounter]) + ord(Pntr[x]) + len);
inc(pcounter); if pcounter > length(password) then pcounter := 1;
end; end;
procedure DeCrypt(var Pntr: Array of Char; ArrLen:Word; password: string);
var len,pcounter: byte; x:Word;
begin
len := length(password) div 2; pcounter := 1;
for x:=0 to ArrLen-1 do begin
Pntr[x] := chr(ord(Pntr[x]) - ord(password[pcounter]) - len);
inc(pcounter); if pcounter > length(password) then pcounter := 1;
end; end;
type pBuffer = ^tBuffer;
tBuffer = Array[1..$FFFF] of Char;
procedure EnCryptStream(var st: tStream; Password: String);
var buf: pBuffer; StSize, StPos, p: Longint;
begin
if (@st=nil) or (Password='') then exit; New(buf);
StPos:=st.GetPos; StSize:=st.GetSize; st.Reset; st.Seek(0);
repeat
p:=st.GetPos;
if SizeOf(Buf^) > St.GetSize-St.GetPosthen st.Read(buf^,St.GetSize-St.GetPos)
else
st.Read(buf^,SizeOf(Buf^)); EnCrypt(buf^,SizeOf(buf^),password);
st.Reset; st.Seek(p); st.Write(buf^,SizeOf(Buf^));
until (St.GetSize=St.GetPos); st.Seek(StSize); st.Truncate; st.Seek(StPos);
Dispose(buf);
end;
procedure DeCryptStream(var st: tStream; Password: String);
var buf: pBuffer; StSize, StPos, p: Longint;
begin
if (@st=nil) or (Password='') then exit; New(buf); StPos:=st.GetPos;
StSize:=st.GetSize; st.Reset; st.Seek(0);
repeat
p:=st.GetPos;
if SizeOf(Buf^) > St.GetSize-St.GetPosthen st.Read(buf^,St.GetSize-St.GetPos)
else
st.Read(buf^,SizeOf(Buf^)); DeCrypt(buf^,SizeOf(buf^),password);
st.Reset; st.Seek(p); st.Write(buf^,SizeOf(Buf^));
until (St.GetSize=St.GetPos); st.Seek(StSize); st.Truncate; st.Seek(StPos);
Dispose(buf);
end;
end.
Prosty ale działa bez zarzutów.
var key, text, longkey, result: string; i: integer; toto, c: char;
begin
for i := 0 to (length(text) div length(key)) do
longkey := longkey + key; for i := 1 to length(text) do
begin
toto := chr((ord(text[i]) xor ord(longkey[i]))); // to algorytm XOR
result := result + toto;
end;
end;
Ta metoda to szyfrowanie według standardu Base64 z 2 dodatkowymi zmiennymi C1 i C2.
unit uEncrypt;
interface
function Decrypt(const S: AnsiString; Key: Word): AnsiString;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;
implementation
const C1 = 52845; C2 = 22719;
function Decode(const S: AnsiString): AnsiString;
const
Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0);
var I: LongInt;
begin
case Length(S) of
2: begin
I := Map[S[1]] + (Map[S[2]] shl 6); SetLength(Result, 1);
Move(I, Result[1], Length(Result))
end;
3: begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
SetLength(Result, 2); Move(I, Result[1], Length(Result))
end;
4: begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
(Map[S[4]] shl 18); SetLength(Result, 3); Move(I, Result[1], Length(Result))
end end
end;
function PreProcess(const S: AnsiString): AnsiString;
var SS: AnsiString;
begin
SS := S; Result := ''; while SS < > '' do
begin
Result := Result + Decode(Copy(SS, 1, 4)); Delete(SS, 1, 4)
end end;
function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;
var I: Word; Seed: Word;
begin
Result := S; Seed := Key;
for I := 1 to Length(Result) do
begin
Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)
end end;
function Decrypt(const S: AnsiString; Key: Word): AnsiString;
begin
Result := InternalDecrypt(PreProcess(S), Key)
end;
function Encode(const S: AnsiString): AnsiString;
const
Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
'abcdefghijklmnopqrstuvwxyz0123456789+/';
var I: LongInt;
begin
I := 0; Move(S[1], I, Length(S));
case Length(S) of
1: Result := Map[I mod 64] + Map[(I shr 6) mod 64];
2: Result := Map[I mod 64] + Map[(I shr 6) mod 64] + Map[(I shr 12) mod 64];
3: Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
end end;
function PostProcess(const S: AnsiString): AnsiString;
var SS: AnsiString;
begin
SS := S; Result := ''; while SS < > '' do
begin
Result := Result + Encode(Copy(SS, 1, 3)); Delete(SS, 1, 3)
end end;
function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;
var I: Word; Seed: Word;
begin
Result := S; Seed := Key;
for I := 1 to Length(Result) do
begin
Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)
end end;
function Encrypt(const S: AnsiString; Key: Word): AnsiString;
begin
Result := PostProcess(InternalEncrypt(S, Key))
end;
end.
// Przykład:
procedure TForm1.Button1Click(Sender: TObject);
const my_key = 33189;
var sEncrypted, sDecrypted :AnsiString;
begin
// Szyfrowanie ciągu znaków
sEncrypted := Encrypt('Ten tekst zaraz zostanie zakodowany' , my_key);
// komunikat pokaże zakodowany tekst
ShowMessage(sEncrypted);
// Teraz czas na rozkodowanie tekstu
sDecrypted := Decrypt(sEncrypted , my_key);
// i pokaz tekstu rozkodowanego w postaci komunikatu
ShowMessage(sDecrypted);
end;
unit RC5;
interface
uses SysUtils, Classes;
type TRC5Block = array[1..2] of LongWord;
const Rounds = 12; BlockSize = 8; BufferSize = 2048;
KeySize = 64; KeyLength = 2 * (Rounds + 1); P32 = $b7e15163; Q32 = $9e3779b9;
var Key : string; KeyPtr : PChar; S : array[0..KeyLength-1] of LongWord;
//funkcje pomocnicze
procedure Initialize(AKey: string); // inicjacja
procedure CalculateSubKeys; // przygotowanie podkluczy
function EncipherBlock(var Block): Boolean; // szyfrowanie bloku 8-bajtowego
function DecipherBlock(var Block): Boolean; // deszyfracja bloku
//główne funkcje
function EncryptCopy(DestStream, SourseStream : TStream; Count: Int64;
Key : string): Boolean; // szyfrowanie danych z jednego strumienia w drugi
function DecryptCopy(DestStream, SourseStream : TStream; Count: Int64;
Key : string): Boolean; //rozszyfrowanie ze strumienia do strumienia
function EncryptStream(DataStream: TStream; Count: Int64;
Key: string): Boolean; // szyfruje zawartość strumienia
function DecryptStream(DataStream: TStream; Count: Int64;
Key: string): Boolean; // rozszyfruje zawartość strumienia
implementation
function ROL(a, s: LongWord): LongWord;
asm
mov ecx, s
rol eax, cl
end;
function ROR(a, s: LongWord): LongWord;
asm
mov ecx, s
ror eax, cl
end;
procedure InvolveKey;
varTempKey : string; i, j : Integer;K1, K2 : LongWord;
begin
// maksymalizacja klucza więcej niż 64 znaki
TempKey := Key; i := 1;
while ((Length(TempKey) mod KeySize) < > 0) do
begin
TempKey := TempKey + TempKey[i]; Inc(i);
end;
i := 1; j := 0; while (i < Length(TempKey)) do
begin
Move((KeyPtr+j)^, K1, 4); Move(TempKey[i], K2, 4); K1 := ROL(K1, K2) xor K2;
Move(K1, (KeyPtr+j)^, 4); j := (j + 4) mod KeySize; Inc(i, 4);
end; end;
procedure Initialize(AKey: string);
begin
Key := AKey; GetMem(KeyPtr, KeySize); FillChar(KeyPtr^, KeySize, #0);
InvolveKey;
end;
{$R-,Q-}
procedure CalculateSubKeys;
var i, j, k : Integer; L : array[0..15] of LongWord; A, B : LongWord;
begin
Move(KeyPtr^, L, KeySize); // kopiuje key do L
S[0] := P32; // teraz inicjuje tablice S
for i := 1 to KeyLength-1 do S[i] := S[i-1] + Q32;
i := 0; j := 0; A := 0; B := 0; for k := 1 to 3*KeyLength do
begin
A := ROL((S[i] + A + B), 3); S[i] := A; B := ROL((L[j] + A + B), (A + B));
L[j] := B; i := (i + 1) mod KeyLength; j := (j + 1) mod 16; end;
end;
function EncipherBlock(var Block): Boolean;
var RC5Block : TRC5Block absolute Block; i : Integer;
begin
Inc(RC5Block[1], S[0]); Inc(RC5Block[2], S[1]); for i := 1 to Rounds do
begin
RC5Block[1] := ROL((RC5Block[1] xor RC5Block[2]), RC5Block[2]) + S[2*i];
RC5Block[2] := ROL((RC5Block[2] xor RC5Block[1]), RC5Block[1]) + S[2*i+1];
end; Result := TRUE;
end;
function DecipherBlock(var Block): Boolean;
var RC5Block : TRC5Block absolute Block; i : Integer;
begin
for i := Rounds downto 1 do
begin
RC5Block[2] := ROR((RC5Block[2]-S[2*i+1]), RC5Block[1]) xor RC5Block[1];
RC5Block[1] := ROR((RC5Block[1]-S[2*i]), RC5Block[2]) xor RC5Block[2];
end;
Dec(RC5Block[2], S[1]); Dec(RC5Block[1], S[0]); Result := TRUE;
end;
//Realizacja głównych funkcji
function EncryptCopy(DestStream, SourseStream : TStream; Count: Int64; Key : string): Boolean;
var Buffer : TRC5Block; PrCount : Int64; AddCount : Byte;
begin
Result := True; try if Key = '' then
begin
DestStream.CopyFrom(SourseStream, Count); Exit; end;
Initialize(Key); CalculateSubKeys; PrCount := 0;
while Count - PrCount >= 8 do
begin
SourseStream.Read(Buffer, BlockSize); EncipherBlock(Buffer);
DestStream.Write(Buffer, BlockSize); Inc(PrCount, 8); end;
AddCount := Count - PrCount; if Count - PrCount < > 0 then
begin
SourseStream.Read(Buffer, AddCount);
DestStream.Write(Buffer, AddCount);
end; except
Result := False; end;
end;
function DecryptCopy(DestStream, SourseStream : TStream; Count: Int64;Key : string): Boolean;
var Buffer : TRC5Block; PrCount : Int64; AddCount : Byte;
begin
Result := True; try if Key = '' then
begin
DestStream.CopyFrom(SourseStream, Count); Exit; end;
Initialize(Key); CalculateSubKeys; PrCount := 0;
while Count - PrCount >= 8 do
begin
SourseStream.Read(Buffer, BlockSize); DecipherBlock(Buffer);
DestStream.Write(Buffer, BlockSize); Inc(PrCount, 8);
end;
AddCount := Count - PrCount; if Count - PrCount < > 0 then
begin
SourseStream.Read(Buffer, AddCount);
DestStream.Write(Buffer, AddCount);
end;
except Result := False;end;
end;
function EncryptStream(DataStream: TStream; Count: Int64; Key: string): Boolean;
var Buffer : TRC5Block; PrCount : Int64;
begin
Result := True; try if Key = '' then
begin
DataStream.Seek(Count, soFromCurrent); Exit; end;
Initialize(Key); CalculateSubKeys; PrCount := 0;
while Count - PrCount >= 8 do
begin
DataStream.Read(Buffer, BlockSize); EncipherBlock(Buffer);
DataStream.Seek(-BlockSize, soFromCurrent);
DataStream.Write(Buffer, BlockSize); Inc(PrCount, 8);
end;
except Result := False; end;
end;
function DecryptStream(DataStream: TStream; Count: Int64; Key: string): Boolean;
var Buffer : TRC5Block; PrCount : Int64;
begin
Result := True; try if Key = '' then
begin
DataStream.Seek(Count, soFromCurrent); Exit; end;
Initialize(Key); CalculateSubKeys; PrCount := 0;
while Count - PrCount >= 8 do
begin
DataStream.Read(Buffer, BlockSize); DecipherBlock(Buffer);
DataStream.Seek(-BlockSize, soFromCurrent);
DataStream.Write(Buffer, BlockSize); Inc(PrCount, 8); end;
except Result := False; end;
end;
{$R+,Q+}
end.
program Initialize;
uses Forms, Dialogs, Controls, MainFrm in 'MainFrm.pas' {MainForm};
{$R *.RES}
var Password: string;
begin
if InputQuery('Password', 'Enter your password', PassWord) then
if Password = 'D5DG' then
begin
// Other initialization routines can go here.
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end else
MessageDlg('Incorrect Password, terminating program', mtError, [mbok], 0);
end.
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
type TWordTriple = Array[0..2] of Word;
function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function TextEncrypt(const s: string; Key: TWordTriple): string;
function TextDecrypt(const s: string; Key: TWordTriple): string;
function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal;
Key:TWordTriple): boolean;
function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal;
Key:TWordTriple): boolean;
var Form1: TForm1;
implementation
{$R *.dfm}
function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key:
TWordTriple): boolean;
var pIn, pOut: ^byte; i : Cardinal;
begin
if SrcSize = TargetSize then
begin
pIn := Src; pOut := Target; for i := 1 to SrcSize do
begin
pOut^ := pIn^ xor (Key[2] shr 8); Key[2] := Byte(pIn^ + Key[2]) * Key[0] + Key[1];
inc(pIn); inc(pOut); end; Result := True;
end else
Result := False;
end;
function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key:
TWordTriple): boolean;
var pIn, pOut: ^byte; i : Cardinal;
begin
if SrcSize = TargetSize then
begin
pIn := Src; pOut := Target; for i := 1 to SrcSize do
begin
pOut^ := pIn^ xor (Key[2] shr 8); Key[2] := byte(pOut^ + Key[2]) * Key[0] + Key[1];
inc(pIn); inc(pOut); end; Result := True;
end else
Result := False;
end;
function TextCrypt(const s: string; Key: TWordTriple; Encrypt: Boolean): string;
var bOK: Boolean;
begin
SetLength(Result, Length(s)); if Encrypt then
bOK := MemoryEncrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key)
else
bOK := MemoryDecrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key);
if not bOK then Result := '';
end;
function FileCrypt(InFile, OutFile: String; Key: TWordTriple; Encrypt: Boolean): boolean;
var MIn, MOut: TMemoryStream;
begin
MIn := TMemoryStream.Create; MOut := TMemoryStream.Create;
Try
MIn.LoadFromFile(InFile); MOut.SetSize(MIn.Size);
if Encrypt then
Result := MemoryEncrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key)
else
Result := MemoryDecrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key);
MOut.SaveToFile(OutFile);
finally MOut.Free; MIn.Free; end;
end;
function TextEncrypt(const s: string; Key: TWordTriple): string;
begin
Result := TextCrypt(s, Key, True);
end;
function TextDecrypt(const s: string; Key: TWordTriple): string;
begin
Result := TextCrypt(s, Key, False);
end;
function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
Result := FileCrypt(InFile, OutFile, Key, True);
end;
function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
Result := FileCrypt(InFile, OutFile, Key, False);
end;
procedure TForm1.Button1Click(Sender: TObject);
var keyku:TWordTriple;
begin
keyku[0]:=1000; keyku[1]:=9292; keyku[2]:=3333;
Memo2.Lines.Clear;
Memo2.Lines.Add(TextEncrypt(Memo1.Text,keyku));
end;
procedure TForm1.Button2Click(Sender: TObject);
var keyku:TWordTriple;
begin
keyku[0]:=1000; keyku[1]:=9292; keyku[2]:=3333;
Memo4.Lines.Clear;
Memo4.Lines.Add(TextDecrypt(Memo3.Text,keyku));
end;
end.
const StartKey = 471; // Start default key
MultKey = 62142; // Mult default
AddKey = 11719; // Add default key
function Encrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;
var i: Byte;
// jeżeli i dasz nie Byte tylko Integer to można szyfrować długie łańcuchy
begin
Result:=''; for i:=1 to Length(InString) do
begin
Result:=Result+Char(Byte(InString[i]) xor (StartKey shr 8));
StartKey:=(Byte(Result[i])+StartKey)*MultKey+AddKey;
end; end;
procedure TForm1.Button1Click(Sender: TObject); // ten rozkodowuje z Edit2
var s: string;
begin
if Edit2.Text < >'' then
begin
Button1.Enabled:=false; Button2.Enabled:=true;
s:=Encrypt(Edit2.Text, StartKey, MultKey, AddKey);
ShowMessage('Oto tekst rozkodowany: "'+s+'"');
end; end;
function Decrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;
var i: Byte; //integer zamiast Byte i koduje długie łańcuchy ponad 255 znaków
begin
Result:=''; for i:=1 to Length(InString) do
begin
Result:=Result+Char(Byte(InString[i]) xor (StartKey shr 8));
StartKey:=(Byte(InString[i])+StartKey)*MultKey+AddKey;
end; end;
procedure TForm1.Button2Click(Sender: TObject); //przycisk koduj
begin
if Edit1.Text < >'' then //Edit1 - tekst do kodowania Edit2 - zakodowany
begin
Edit2.Text:=Decrypt(Edit1.Text, StartKey, MultKey, AddKey);
Button1.Enabled:=true; Button2.Enabled:=false;
end; end;
Procedura EnDecryptFile jest wspólna dla operacji szyfrowania i dekryptażu; hasło jest liczbą a plik
dowolnego typu.
private { Private declarations }
procedure EnDecryptFile(pathin, pathout: string; Chave: Word);
public { Public declarations }
end;
var EnDeCrypt: TEnDeCrypt;
implementation
{$R *.dfm}
procedure TEnDeCrypt.EnDecryptFile(pathin, pathout: string; Chave: Word);
var InMS, OutMS: TMemoryStream; cnt: Integer; C: byte;
begin
InMS := TMemoryStream.Create; OutMS := TMemoryStream.Create;
try
InMS.LoadFromFile(pathin); InMS.Position := 0; for cnt := 0 to InMS.Size - 1 DO
begin
InMS.Read(C, 1); C := (C xor not (ord(chave shr cnt))); OutMS.Write(C, 1);
end; OutMS.SaveToFile(pathout);
finally InMS.Free; OutMS.Free; end;
end;
procedure TEnDeCrypt.BtnOpenClick(Sender: TObject);//wybór pliku na dysku
begin
OpenDialog1.Execute;
end;
procedure TEnDeCrypt.BtnEnDeClick(Sender: TObject); //to przycisk koduj/rozkoduj
begin
IF MessageDlg('UWAGA'+#13+
'Czy hasło jest właściwe i poprawnie wybrany plik?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes THEN
BEGIN
EnDecryptFile(OpenDialog1.FileName, OpenDialog1.FileName, StrToInt(leKey.Text));
ShowMessage('Operacja przebiegla pomyślnie!'); END;
end;
unit RC4; //oddzielny unit, którego należy dołączyć do swojego projektu.
interface
uses SysUtils;
type TRC4Context = record
D: array[Byte] of Byte;
I,J: Byte;
end;
procedure RC4Init(var RC4: TRC4Context; const Key: String);
procedure RC4Done(var RC4: TRC4Context);
procedure RC4Code(var RC4: TRC4Context; const Source; var Dest; Count: Integer); overload;
function RC4Code(var RC4: TRC4Context; const Value: String): String; overload;
function RC4Code(const Value, Password: String): String; overload;
implementation
procedure RC4Init(var RC4: TRC4Context; const Key: String);
var R,S,T,K: Byte; U,L: Integer;
begin
{$R-} {$Q-} 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 RC4Done(var RC4: TRC4Context);
begin
FillChar(RC4, SizeOf(RC4), 0);
end;
procedure RC4Code(var RC4: TRC4Context; const Source; var Dest; Count: Integer); overload;
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;
function RC4Code(var RC4: TRC4Context; const Value: String): String; overload;
var Count: Integer;
begin
Count := Length(Value); SetLength(Result, Count);
RC4Code(RC4, Value[1], Result[1], Count);
end;
function RC4Code(const Value, Password: String): String; overload;
var RC4: TRC4Context;
begin
RC4Init(RC4, Password); try Result := RC4Code(RC4, Value);
finally RC4Done(RC4); end;
end;
end.
//a tak w swoim projekcie...W przykładzie użyto stałego hasła -''foo'' chociaż można stosować zmienne
hasło,np. z kolejnego TEdit.
.....
implementation
{$R *.dfm}
uses RC4;
procedure TForm1.Button1Click(Sender: TObject); //przycisk szyfruj plik
const BLOCKSIZE: Integer = 1024;
var RC4: TRC4Context; Filename: string; source, dest: TFileStream; Len: Int64;
SourceBuffer, DestBuffer: Pointer;
begin
Filename := 'D:\Tmp\'plik_do_zakodowania.txt';
source := TFileStream.Create(Filename, fmOpenRead);
dest := TFileStream.Create(Filename + '.foo', fmCreate);
try
GetMem(SourceBuffer, BLOCKSIZE); GetMem(DestBuffer, BLOCKSIZE);
try
RC4Init(RC4, 'Foobar'); Progressbar1.Max := source.Size;
while source.Position < source.Size do
begin
if source.Size - source.Position > BLOCKSIZE then Len := BLOCKSIZE
else
Len := source.Size - source.Position;
Progressbar1.Position := source.Position; Progressbar1.Refresh;//to wskaźnik postępu...
source.ReadBuffer(SourceBuffer^, Len);
RC4Code(RC4, SourceBuffer^, DestBuffer^, len);
dest.WriteBuffer(DestBuffer^, Len); end; RC4Done(RC4);
finally FreeMemory(SourceBuffer); FreeMemory(DestBuffer); end;
finally FreeAndNil(source); FreeAndnIl(dest); end;
end;
procedure TForm1.Button2Click(Sender: TObject); //przycisk szyfruj tekst z Edit1
var RC4: TRC4Context; s, s1: String;
begin
s := Edit1.Text; setlength(s1, length(s)); RC4Init(RC4, 'foo');
RC4Code(RC4, s[1], s1[1], length(Edit1.Text)); RC4Done(RC4);
Edit2.Text := s1;//zaszyfrowany tekst widoczny w Edit2
end;
procedure TForm1.Button3Click(Sender: TObject); //przycisk rozszyfruj tekst
var RC4: TRC4Context; s, s1: String;
begin
s := Edit2.Text; //tutaj jest tekst zaszyfrowany
setlength(s1, length(s));
RC4Init(RC4, 'foo');
RC4Code(RC4, s[1], s1[1], length(Edit1.Text)); RC4Done(RC4);
Edit3.Text := s1; //po rozszyfrowaniu tekst widoczny w Edit3
end;
end.