Mega Code Archive
Simple But Powerful Encryption
<![CDATA[
Title: Simple But Powerful Encryption
Question: How do I make a simple encryption with a password?
Answer:
It's actually quite simple. Use the ORD function to get the ASCII code of a character and put it into a loop. Then you take the ASCII of their text and mix the 2. It is a little advanced but works quite well! Here is an example (where Memo1 is the main text box and Edit1 is the password):
{ Needed functions imported from Visual Basic }
function VBRight(Str: string; Val: integer): string; {Get certain amount of characters at the right of the string}
function FSI(N: Longint; W: byte): string; {Turns Longint to string}
function VBMid(Str: string; Start, Len: integer): string; {Finds a character somewhere in the middle of a string}
function Replace(const sData: string; const sFind: String; const sReplace: string): string; {Replaces something in a string to something else}
function InStr(sStart: integer; const sData: string; const sFind: string): integer; {Checks if something is in the string}
function mid(const sData: string; nStart: integer): string; overload; {Same as VBMid but with different paramaters}
{Some variables}
var
Form1: TForm1;
Tmp : string;
Tmp2 : string;
Tmp3 : integer;
Tmp4 : integer;
Tmp5 : integer;
Tmp6 : string;
{The functions from above}
function mid(const sData: string; nStart: integer; nLength: integer): string; overload;
begin
Result := copy(sData, nStart, nLength);
end;
function mid(const sData: string; nStart: integer): string; overload;
begin
Result := copy(sData, nStart, Length(sData) - (nStart - 1));
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 Replace(const sData: string; const sFind: String; const sReplace: string): string;
var
c: integer;
sTemp, sTemp2: string;
begin
sTemp := sData;
c := InStr(1, sTemp, sFind);
while c 0 do
begin
sTemp2 := copy(sTemp, 1, c - 1) + sReplace + Mid(sTemp, c + length(sFind));
sTemp := sTemp2;
c := InStr(c + length(sReplace), sTemp, sFind);
end;
Result := sTemp;
end;
function VBRight(Str: string; Val: integer): string;
begin
VBRight := Copy(Str, Length(Str)-Val+1, Val);
end;
function VBMid(Str: string; Start, Len: integer): string;
begin
VBMid:= Copy(Str, Start, Len);
end;
function FSI(N: Longint; W: byte): string;
var
S : string;
begin
Str(N, S);
FSI := S;
end;
//Main encryption : Goes into a button
procedure TForm1.Button1Click(Sender: TObject);
var
ln : integer;
whr : integer;
Label FoundIt;
begin
Tmp := '';
Tmp2 := '';
whr := 0;
If Instr(1, Memo1.Text, '&%&') 0 Then
begin
Application.MessageBox('You must not have the string "&%&" in your text!','Error',MB_OK);
GoTo FoundIt;
end;
Memo1.Text := Replace(Memo1.Text, #13#10, '&%&');
If Length(Edit1.Text) = Length(Memo1.Text) Then
begin
Edit1.Text := VBRight(Edit1.Text, Length(Memo1.Text)-1)
end;
try
For ln := 1 To Length(Memo1.Text) do
begin
whr := whr + 1;
If whr Length(Edit1.Text) Then whr := 1;
Tmp3 := Ord(Memo1.Text[ln]);
Tmp4 := -1;
If Edit1.Text[whr] = '0' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '1' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '2' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '3' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '4' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '5' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '6' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '7' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '8' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '9' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Tmp4 = -1 Then Tmp4 := StrToInt(VBRight(FSI(Ord(Edit1.Text[whr]),0),1));
Tmp := Tmp + Chr(Tmp3-Tmp4);
end;
Memo1.Text := Tmp
except
MessageDlg('An error has occured! If it continues, please contact me at SordOnline@Yahoo.com!', mtError, [mbOk], 0);
end;
FoundIt:
end;
//And the main decryption
procedure TForm1.Button2Click(Sender: TObject);
var
ln : integer;
whr : integer;
begin
Tmp := '';
Tmp2 := '';
whr := 0;
If Length(Edit1.Text) = Length(Memo1.Text) Then
begin
Edit1.Text := VBRight(Edit1.Text, Length(Memo1.Text)-1)
end;
try
If Length(Edit1.Text) For ln := 1 To Length(Memo1.Text) do
begin
whr := whr + 1;
If whr Length(Edit1.Text) Then whr := 1;
Tmp3 := Ord(Memo1.Text[ln]);
Tmp4 := -1;
If Edit1.Text[whr] = '0' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '1' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '2' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '3' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '4' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '5' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '6' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '7' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '8' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Edit1.Text[whr] = '9' Then Tmp4 := StrToInt(Edit1.Text[whr]) + 3;
If Tmp4 = -1 Then Tmp4 := StrToInt(VBRight(FSI(Ord(Edit1.Text[whr]),0),1));
Tmp := Tmp + Chr(Tmp3+Tmp4);
end;
Tmp := Replace(Tmp, '&%&', #13#10);
Memo1.Text := Tmp
except
MessageDlg('An error has occured! If it continues, please contact me at SordOnline@Yahoo.com!', mtError, [mbOk], 0);
end;
end;
procedure TForm1.About1Click(Sender: TObject);
begin
Application.MessageBox('Text Encryption made by R in Delphi 5!','About',MB_OK);
end;
]]>