Mega Code Archive
WL Encryption
<![CDATA[
Title: WL Encryption
Question: This is a MUCH better and enhanced encryption than my previous encryption. After much thinking and studying, I can up with this encryption.
Answer:
This is a MUCH better and enhanced encryption than my previous encryption. After much thinking and studying, I can up with this encryption. This does not use any sort of "xor", "and", or "or" bit encryption. I appologize for not commenting the code, but it should be pretty self explanitory! On the web site with the code, the code is in a WinRAR Executable file to extract the code. Feel free to do virus scanning, but I assure you there is none!
---------------------------------------------------------------
To initialize the code, run this procedure (preferably at creation)
InitTable;
Sometimes the encryption and decryption fails, so here is my code for those!
procedure TForm1.DoEncrypt(Sender: TObject);
var
i : longint;
d : longint;
Tmp : string;
Tmp2: string;
Text: string;
Quit: boolean;
Fini: boolean;
begin
d := 0;
Text := Memo1.Lines.Text;
repeat
d := d + 1;
Memo1.Lines.Text := Text;
Fini := True;
repeat
Quit := False;
Tmp := WLEnc(Memo1.Lines.Text, Edit1.Text);
Edit2.Text := IntToStr(RevCode);
Tmp2:= WLDec(Tmp, Edit1.Text, StrToInt(Edit2.Text));
Edit2.Text := IntToStr(RevCode);
if Tmp2 = Memo1.Lines.Text then
if RevCode 0 then
Quit := True;
until Quit = True;
i := 0;
repeat
Memo1.Lines.Text := Tmp;
i := i + 1;
until (Memo1.Lines.Text = Tmp) or (i 2);
if (i 2) and (Memo1.Lines.Text Tmp) then
Fini := False;
until (Fini = True) or (d = 100);
if d = 100 then
begin
Memo1.Lines.Text := Text;
Application.MessageBox('Sorry, but this text has been tried 100 times unsuccesfully! Quiting!', 'Sorry', MB_OK);
end;
end;
procedure TForm1.DoDecrypt(Sender: TObject);
begin
RevCode := StrToInt(Edit2.Text);
Memo1.Lines.Text := WLDec(Memo1.Lines.Text, Edit1.Text, StrToInt(Edit2.Text));
end;
---------------------------------------------------------------
Enjoy!
---------------------------------------------------------------
const
WLEncTable = 'bcAIXMiperlNWqJdQzmoHUOkjxPZDfKTYSEnsVCGuaghvBtyLRFw';
WLEncTable2= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
var
RevCode : longint;
WLTable : Array[1..52] of integer;
function DecimDec(Code : string) : char;
var
CodeL : longint;
CodeL2: longint;
begin
CodeL2 := StrToInt(Code);
CodeL := StrToInt(RmDec(IntToStr(CodeL2 * 2 div 3 * 4 * 2)));
DecimDec:= IntToStr(CodeL)[1];
end;
function DoubleProcess(Code : string) : string;
var
i : longint;
Final : string;
begin
for i := 1 to Length(Code) do
Final := Final + Code[i] + IntToStr(Ord(Code[i]))[2];
DoubleProcess := Final;
end;
function InitiateTEC(Code : longint) : longint;
var
i : longint;
CodeS : string;
Final : string;
begin
CodeS := IntToStr(Code);
for i := 1 to Length(CodeS) do
Final := Final + DecimDec(CodeS[i]);
InitiateTEC := StrToInt(Final);
end;
function RmDec(What : string) : string;
var
i : longint;
d : longint;
What2 : string;
begin
What2 := What;
for i := 1 to Length(What) do
if What[i] = '.' then
for d := 1 to Length(What) do
if d i then What2 := What2 + What[i];
RmDec := What;
end;
function TECStart(Code : string; Length1 : integer) : string;
var
i : longint;
CodeL : longint;
CodeS : string;
Final : string;
begin
for i := 1 to Length(Code) do
begin
CodeL := StrToInt(IntToStr(Ord(Code[i]))[2]);
CodeS := IntToStr(InitiateTEC(CodeL));
CodeS := DoubleProcess(CodeS);
Final := Final + TrimTEC(CodeS);
end;
TECStart := Final;
end;
function TrimTEC(Code : string) : string;
var
i : longint;
begin
i := Length(Code);
if i mod 2 0 then i := i + 1;
if (i = 2) or (i = 1) then
TrimTEC := Code
else
TrimTEC := Code[i div 2] + Code[(i div 2) + 1];
end;
function WLDec(Text : string; Password : string; TECLength : longint) : string;
var
d : longint;
e : longint;
f : longint;
g : longint;
i : longint;
Tmp : string;
Tmp2 : longint;
Orig : string;
Pw1TEC : string;
Password2 : string;
TextLength : longint;
TextLength2 : string;
begin
Tmp2 := 0;
Orig := Text;
Password := FixPassword(Password);
Password2:= InitPwTable(Password);
Pw1TEC := IntToStr(TECLength) + TECStart(Password, TECLength);
TextLength := Length(Text);
TextLength2:= IntToStr(TextLength);
TextLength := 0;
d := 0;
for i := 1 to Length(TextLength2) do
begin
d := d + 1;
if d Length(Password) then d := 1;
TextLength := TextLength + StrToInt(TextLength2[i]) + StrToInt(TECStart(Password[d], 7));
end;
TextLength2 := IntToStr(TextLength) + IntToStr(TECLength);
for i := 1 to length(Password) do
begin
if i mod 2 = 0 then
Tmp2 := Tmp2 + Ord(Password[i])
else
Tmp2 := Tmp2 - Ord(Password[i]);
end;
if Tmp2 if Tmp2 = 0 then Tmp2 := StrToInt(TECStart(Password, 1));
d := 0;
e := 0;
f := 0;
g := 0;
Form1.Caption := 'WL Encryption';
for i := 1 to Length(Text) do
begin
d := d + 1;
e := e + 1;
f := f + 1;
g := g + 1;
if d Length(Pw1TEC) then d := 1;
if e Length(Password) then e := 1;
if f Length(TextLength2) then f := 1;
if g Length(Password2) then g := 1;
Tmp := Tmp + Chr(Ord(Text[i]) - StrToInt(Pw1TEC[d]) + Tmp2 + Ord(Password[e]) - StrToInt(TextLength2[f]) - Ord(Password2[g]));
end;
WLDec := Tmp;
end;
function WLEnc(Text : string; Password : string) : string;
var
d : longint;
e : longint;
f : longint;
g : longint;
i : longint;
Tmp : string;
Tmp2 : longint;
Orig : string;
Pw1TEC : string;
Password2 : string;
TECLength : longint;
TextLength : longint;
TextLength2 : string;
begin
Orig := Text;
Tmp2 := 0;
TECLength := StrToInt(TECStart(Password, 10)[2]) + StrToInt(TECStart(Password, 10)[1]);
Randomize;
RevCode := TECLength * ((2 * 4 * 3 + 4) - (Random(90) + 1)) * 10 * 2;
if RevCode if Form1.CheckBox2.Checked = True then
RevCode := StrToInt(Form1.Edit2.Text);
Password := FixPassword(Password);
Password2:= InitPwTable(Password);
Pw1TEC := IntToStr(RevCode) + TECStart(Password, TECLength);
TextLength := Length(Text);
TextLength2:= IntToStr(TextLength);
TextLength := 0;
d := 0;
for i := 1 to Length(TextLength2) do
begin
d := d + 1;
if d Length(Password) then d := 1;
TextLength := TextLength + StrToInt(TextLength2[i]) + StrToInt(TECStart(Password[d], 7));
end;
TextLength2 := IntToStr(TextLength) + IntToStr(RevCode);
for i := 1 to Length(Password) do
begin
if i mod 2 = 0 then
Tmp2 := Tmp2 + Ord(Password[i])
else
Tmp2 := Tmp2 - Ord(Password[i]);
end;
if Tmp2 if Tmp2 = 0 then Tmp2 := StrToInt(TECStart(Password, 1));
d := 0;
e := 0;
f := 0;
g := 0;
Form1.Caption := 'WL Encryption';
for i := 1 to Length(Text) do
begin
d := d + 1;
e := e + 1;
f := f + 1;
g := g + 1;
if d Length(Pw1TEC) then d := 1;
if e Length(Password) then e := 1;
if f Length(TextLength2) then f := 1;
if g Length(Password2) then g := 1;
Tmp := Tmp + Chr(Ord(Text[i]) + StrToInt(Pw1TEC[d]) - Tmp2 - Ord(Password[e]) + StrToInt(TextLength2[f]) + Ord(Password2[g]));
end;
WLEnc := Tmp;
end;
function FixPassword(Password : string) : string;
var
i : longint;
Password2 : string;
begin
for i := 1 to Length(Password) do
begin
if (Ord(Password[i]) 64) and (Ord(Password[i]) Password2 := Password2 + Password[i];
if (Ord(Password[i]) 96) and (Ord(Password[i]) Password2 := Password2 + Password[i];
end;
FixPassword := Password2;
end;
function InitPwTable(Password : string) : string;
var
i : longint;
Password2 : string;
begin
for i := 1 to Length(Password) do
Password2 := Password2 + WLEncTable[WLTable[Process(Password[i])]];
InitPwTable := Password2;
end;
procedure InitTable;
var
i : longint;
begin
for i := 1 to 52 do
WLTable[i] := InStr(1, WLEncTable2, WLEncTable[i]); //??
end;
function InStr(sStart: integer; const sData: string; const sFind: string): integer;
var
c: integer;
label
SkipFind;
begin
c := sStart - 1;
repeat
if c length(sData) then
begin
c := 0;
goto SkipFind;
end;
inc(c);
until copy(sData, c, length(sFind)) = sFind;
SkipFind:
Result := c;
end;
function Process(Tmp : char) : integer;
begin
if (Ord(Tmp) 64) and (Ord(Tmp) Process := Ord(Tmp) - 64
else
Process := Ord(Tmp) - 96;
end;
]]>