Summary of some encryption algorithms

Comments: Some of them were written when I learned to crack and write the registration machine. Some of them were written by some of my brother's code. If they are not well written, please advise: {===================================================== ===================== learning to crack, write some function sets of the registration machine By: black night rainbow ==================== some of them were written when they learned to crack and write the registration machine, I wrote some of my brother's code, but it is not easy to write:

{===================================================== ======================
Learning to crack and writing some function sets of the registration Machine
By: black night rainbow
========================================================== =====================}
Function wzwgp (s: string): string; // obtain the accumulated value.
Var I, sum: integer;
Begin
Sum: = 0; for I: = 1 to length (s) do
Begin
Sum: = sum ord (s [I]);
End;
Result: = inttostr (sum );
End;

Function ASCII10ADD (s: string): string; // obtain the accumulated value.
Var I, sum: integer;
Begin
Sum: = 0; for I: = 1 to length (s) do
Begin
Sum: = sum ord (s [I]);
End;
Result: = inttostr (sum );
End;

Function ASCII16ADD (s: string): string; // obtain the accumulated value.
Var I, sum: integer;
Begin
Sum: = 0; for I: = 1 to length (s) do
Begin
Sum: = sum ord (s [I]);
End;
Result: = inttohex (sum, 2 );
End;

Function float (a: integer): string;
Var I: integer;
S: Extended;
Begin
S: = 0;
I: = 1;
For I: = 1 to a do
Begin
S: = s 1/I;
End;
Result: = FloatToStr (s );
End;

Function float2 (a: integer): string; // floating point mathematical operation
Var I: integer;
S: Extended;
Begin
S: = 0;
I: = 1;
For I: = 1 to a do
Begin
If I mod 2 <> 0 then
S: = s 1/I
Else
S: = s-1/I;
End;
Result: = FloatToStr (s );
End;

Procedure TForm1.Button2Click (Sender: TObject );
Begin

Edit2.text: = float2 (100 );
End;
{}

Function StrToBack (s: string): string; // reverse the string.
Var I: integer;
Begin
For I: = 1 to length (s) do
Begin
Result: = s [I] result;
End;
End;

{}

Function mdistr (str: string; int: integer): string; // obtain the middle part of the string.
Begin
If int <Length (str) div 2 then
Result: = copy (str, length (str) div 2, int)
Else
Result: = copy (str, Length (str) div 2-(int-Length (str) div 2), int );
End;

{}

Function StrToASCII16 (s: string): string; // string Conversion ascii code hexadecimal
Var I: integer;
Begin
For I: = 1 to length (s) do
Begin
Result: = result IntToHex (ord (s [I]), 2 );
End;
End;

{}

Function StrToASCII10 (s: string): string; // string Conversion ascii code 10
Var I: integer;
Begin
For I: = 1 to length (s) do
Begin
Result: = result inttostr (ord (s [I]);
End;
End;

{}

Function StrToASCII16 (s: string): string; // string Conversion ascii code hexadecimal,
Var I: integer; // such as: black night rainbow = $ BA, $ DA, $ D2, $ B9, $ B2, $ CA, $ BA, $ E7
Begin
For I: = 1 to length (s) do
Begin
Result: = result '$ 'inttohex (ord (s [I]), 2 )',';
End;
Result: = copy (Result, 0, Length (result)-1 );
End;

{}
Function DoubleStr (Str: string): string; // returns the double-digit string.
Var
I: Integer;
Begin
Result: = '';
For I: = 2 to Length (Str) do
If I mod 2 = 0 then
Result: = Result Str [I];
End;

{}

Function WideStr (str: string): String; // extract Chinese characters from the string
Var I: Integer;
Begin
For I: = 1 to Length (WideString (Str) do
If Length (string (WideString (Str) [I]) = 2 then
Result: = result WideString (Str) [I];
End;

{}

Function StrSubCount (const Source, Sub: string): integer; // determines the number of characters in a string.
Var Buf: string;
Len, I: integer;
Begin
Result: = 0;
Buf: = Source;
I: = Pos (Sub, Buf );
Len: = Length (Sub );
While I <> 0 do
Begin
Inc (Result );
Delete (Buf, 1, I Len-1 );
I: = Pos (Sub, Buf );
End;
End;

{}

Function ByteToHex (Src: Byte): String;
Begin
SetLength (Result, 2 );
Asm
Mov edi, [Result]
Mov edi, [EDI]
Mov al, Src
Mov ah, AL // Save to AH
Shr al, 4 // Output High 4 Bits
Add al, '0'
Cmp al, '9'
JBE @ OutCharLo
Add al, 'a'-'9'-1
@ OutCharLo:
And ah, $ f
Add ah, '0'
Cmp ah, '9'
JBE @ OutChar
Add ah, 'a'-'9'-1
@ OutChar:
STOSW
End;
End;

{}

Function ShiftStr (str1, str2: string): string; // shift string
Var I: integer;
Begin
Result: = '';
For I: = 1 to length (str1) do
Begin
Result: = Result str1 [I] str2 [I];
End;
End;

Function SiftStr (Str: string): string; // filter string
Var I, j: integer;
Begin
Result: = '';
J: = Length (str );
For I: = 0 to j do
Begin
If str [I] in ['0'... '9', 'A'... 'F', 'A'... 'F'] then
Result: = Result str [I];
End;
End;

Function IsNum (str: string; int, int2: integer): string;
Var I: integer;
Begin
For I: = 1 to length (str) do
Begin
Result: = inttostr (StrToInt ('$' str [I]) or int) mod int2) result;
End;
End;

{}
Function OpeateStr (const s: string): string; // character-by-bit xor operation
Const
SnLen = 5;
Sn: array [1 .. snLen] of Integer = ($ 0D, $01, $14, $05, $02 );
Var
I, n: integer;
Begin
SetLength (result, Length (s ));
For I: = 1 to Length (s) do begin
N: = I mod snLen;
If n = 0 then
N: = 5;
Result [I]: = char (ord (s [I]) xor sn [n]);
End;
End;

{}

Function StrToEncrypt (Str, ID, Pass: string): string; // sales King inventory _ keygen Algorithm
Var
Username: string;
A, B, c_str, c_hex, d, e, f: string;
I, a_len: Integer;
Begin
Username: = str;
A: = id str;
// B: = 'mraketsoft62095231 ';
B: = pass;
A_len: = Length ();
C_str: = '';
C_hex: = '';
For I: = 1 to a_len do
Begin
C_hex: = c_hex IntToHex (Byte (a [I]) xor Byte (B [I mod Length (B)]), 2 )'';
C_str: = c_str Chr (Byte (a [I]) xor Byte (B [I mod Length (B)]);
End;
D: = '';
For I: = 1 to Length (c_str) do
Begin
If Byte (c_str [I]) in [$01... $09, $ 0A... $ 0F] then
D: = d QuotedStr ('# $' IntToHex (Byte (c_str [I]), 1 ))
Else d: = d c_str [I];
End;
D: = ''' d '''';
E: = '';
For I: = 1 to Length (d) do
Begin
If d [I] in ['0 '.. '9', 'A '.. 'Z', 'A '.. 'Z'] then e: = e d [I];
End;
F: = '';
For I: = 1 to Length (e) do
Begin
F: = f e [I];
If (I mod 4 = 0) and (I <Length (e) {when the registration code is exactly a multiple of 4, the last group adds a horizontal line} then
F: = f '-';
End;
Result: = f;
End;
{}
Function myStrtoHex (s: string): string; // convert the original string to a hexadecimal string
Var tmpstr: string;
I: integer;
Begin
Tmpstr: = '';
For I: = 1 to length (s) do
Begin
Tmpstr: = tmpstr inttoHex (ord (s [I]), 2 );
End;
Result: = tmpstr;
End;

Function myHextoStr (S: string): string; // convert the hexadecimal string to the original string
Var hexS, tmpstr: string;
I: integer;
A: byte;
Begin
HexS: = s; // It should be the string
If length (hexS) mod 2 = 1 then
Begin
HexS: = hexS '0 ';
End;
Tmpstr: = '';
For I: = 1 to (length (hexS) div 2) do
Begin
A: = strtoint ('$' hexS [2 * I-1] hexS [2 * I]);
Tmpstr: = tmpstr chr ();
End;
Result: = tmpstr;
End;

Function encryptstr (const s: string; skey: string): string; // unique or encryption
Var
I, j: integer;
HexS, hexskey, midS, tmpstr: string;
A, B, c: byte;
Begin
HexS: = myStrtoHex (s );
Hexskey: = myStrtoHex (skey );
MidS: = hexS;
For I: = 1 to (length (hexskey) div 2) do
Begin
If I <> 1 then midS: = tmpstr;
Tmpstr: = '';
For j: = 1 to (length (midS) div 2) do
Begin
A: = strtoint ('$' midS [2 * J-1] midS [2 * j]);
B: = strtoint ('$' hexskey [2 * I-1] hexskey [2 * I]);
C: = a xor B;
Tmpstr: = tmpstr myStrtoHex (chr (c ));
End;
End;
Result: = tmpstr;
End;

Function decryptstr (const s: string; skey: string): string; // exclusive or decryption
Var
I, j: integer;
HexS, hexskey, midS, tmpstr: string;
A, B, c: byte;
Begin
HexS: = s; // It should be the string
If length (hexS) mod 2 = 1 then
Begin
Showmessage ('ciphertext error! ');
Exit;
End;
Hexskey: = myStrtoHex (skey );
Tmpstr: = hexS;
MidS: = hexS;
For I: = (length (hexskey) div 2) downto 1 do
Begin
If I <> (length (hexskey) div 2) then midS: = tmpstr;
Tmpstr: = '';
For j: = 1 to (length (midS) div 2) do
Begin
A: = strtoint ('$' midS [2 * J-1] midS [2 * j]);
B: = strtoint ('$' hexskey [2 * I-1] hexskey [2 * I]);
C: = a xor B;
Tmpstr: = tmpstr myStrtoHex (chr (c ));
End;
End;
Result: = myHextoStr (tmpstr );
End;


// Call
Edit2.Text: = encryptstr (Edit1.Text, Editkey. Text );


{}
// XOR encryption/Decryption
Function XorEncDec (AStr: String; Key: Byte): String;
Var
I, n: Integer;
Begin
N: = Length (AStr );
SetLength (Result, n );
For I: = 1 to n do
Result [I]: = Char (Byte (AStr [I]) xor Key );
End;
// Add Encryption
Function AddEnc (AStr: String; Key: Byte): String;
Var
I, n: Integer;
Begin
N: = Length (AStr );
SetLength (Result, n );
For I: = 1 to n do
Result [I]: = Char (Byte (AStr [I]) Key );
End;
// Addition decryption
Function AddDec (AStr: String; Key: Byte): String;
Var
I, n: Integer;
Begin
N: = Length (AStr );
SetLength (Result, n );
For I: = 1 to n do
Result [I]: = Char (Byte (AStr [I])-Key );
End;

The encryption/decryption process of XorEncDec is the same, while the addition encryption and decryption process must be used together.


Procedure TForm1.Button1Click (Sender: TObject );
Begin
Edit2.Text: = XorEncDec (Edit1.Text, 123); // encryption (plaintext is stored in Edit1, and ciphertext is stored in Edit2)
End;
Procedure TForm1.Button2Click (Sender: TObject );
Begin
Edit1.Text: = XorEncDec (Edit2.Text, 123); // decrypt (Edit2 stores ciphertext, and Edit1 stores decrypted plaintext)
End;

// ================================================ ====================
// Question: how many three numbers can be composed of 1, 2, 3, and 4 numbers that are different from each other and have no repeated numbers? What is it?
Function permutation (int: integer): string;
Var
I, j, k: integer;
Begin
For I: = 1 to int do
For j: = 1 to int do
For k: = 1 to int do
Begin
If (I <> j) and (I <> k) and (j <> k) then
Result: = result inttostr (I) inttostr (j) inttostr (k) #13 #10;
End;
End;

Procedure TForm1.Button1Click (Sender: TObject );
Begin
Memo1.Clear;
Memo1.Lines. Add (permutation (4 ));
Label1.Caption: = inttostr (memo1.Lines. Count );
End;

// ============================== Collection function
Function acafeel (Name: string): string;
Var
StrA, strB, strC: string;
Sum, pos: integer;
Begin
If Name = ''then exit;
For pos: = 1 to length (Name) do
If (ord (Name [pos]) <$20) or (ord (Name [pos])> $ 7E) then
Begin
Showmessage ('enter letters or numbers. Chinese characters are not supported! ');
Exit;
End;
Sum: = ord (Name [1]) * length (Name) * $64;
StrA: = ''inttostr (sum) 'noname SwordMan noname ';
StrB: = strA [$12] (strA [$7] strA [$8]) strA [$9] strA [$5] strA [$3]
StrA [$1] (strA [$14] strA [$15] strA [$16] strA [$17] strA [$18])
(StrA [$ D] strA [$ E]) strA [$8];
For pos: = 1 to length (strB) do
If (ord (strB [pos]) <> $20) then strC: = strC strB [pos];
If length (strC) <14 then
Begin
StrC: = strC copy (strA, 7, 23 );
StrC: = copy (strC, 1, 15) 'bywjy ';
End;
Result: = copy (strC, 1, 5) '-'Copy (strC, 5, 4)'-'Copy (strC, 8, 4)
'-'Copy (strC, 11, 4)'-'Copy (strC, 14, 7 );
End;

Function acafeel2 (Name: string): string;
Var
Temp1, temp2, temp3,
TempA, tempB, tempC1, tempC2, tempD1, tempD2,
Pos, posSTR, posADD, posSUB: integer;
Begin
If length (Name) <5 then // if: the length of the registration Name is less than 5 digits
Begin
Showmessage ('the length of the registration name must be greater than 4 digits! ');
Exit;
End;

// If the length of the registration name is greater than or equal to 5 digits and less than or equal to 9 digits
If (5 <= length (Name) and (length (Name) <= 9) then
Begin
{Large Loop 1 }//////////////////////////////////// /// // {Large Loop 1}
// Name: = EditName. Text;
// The First Time
Temp1: = (ord (Name [1]) $ 56B) xor $890428) $18;
Temp2: = (ord (Name [4]) length (Name) xor $54) xor $ 25D;
Temp3: = (ord (Name [1]) $ 56B) * $1024;
TempA: = (temp1 * temp2) $400) temp3;
// The second start cycle
For pos: = 2 to length (Name) do
Begin // get the character ASCII code
Temp1: = temp1 (ord (Name [pos]) $ 56B) xor $890428 );
Temp2: = (ord (Name [4]) length (Name) xor $54) xor $ 25D;
Temp3: = (ord (Name [pos]) $ 56B) * $1024;
TempA: = tempA (temp1 * temp2) temp3;
End;
End;

If length (Name)> 9 then // if the length of the registration Name is greater than 9 digits
Begin
{Large Loop 1 }//////////////////////////////////// /// // {Large Loop 1}
// Name: = EditName. Text;
// The First Time
Temp1: = (ord (Name [1]) $ 56B) xor $890428) $18;
Temp2: = (ord (Name [4]) length (Name) xor $54) xor $ 25D) * $400;
Temp3: = (ord (Name [1]) $ 56B) * $1024) $400;
TempA: = temp3;
// The second start cycle
For pos: = 2 to length (Name) do
Begin // get the character ASCII code
Temp1: = temp1 temp2 (ord (Name [pos]) $ 56B) xor $890428 );
Temp2: = (ord (Name [4]) length (Name) xor $54) xor $ 25D) * temp3;
Temp3: = temp3 (ord (Name [pos]) $ 56B) * $1024 );
TempA: = temp3;
End;
Temp1: = temp1 temp2;
End;

{Small loop 1 }//////////////////////////////////// /// // {small loop 1}
// Name: = EditName. Text;
// The First Time
TempB: = ord (Name [5 1]) $32 $ 134A ;////
{String Reverse Order} // For example, start: aCaFeeL
For posSTR: = length (Name) downto 1 do
Begin
Name: = Name [posSTR];
End;
PosSTR: = length (Name) div 2;
Name: = copy (Name, posSTR 1, posSTR );
{String Reverse Order} // For example, end: LeeFaCa
// The second start cycle
For pos: = 4 downto 1 do
Begin
TempB: = tempB ord (Name [pos 1]) $ 134A ;////
{String Reverse Order}
For posSTR: = length (Name) downto 1 do
Begin
Name: = Name [posSTR];
End;
PosSTR: = length (Name) div 2;
Name: = copy (Name, posSTR 1, posSTR );
{String Reverse Order}
End;

{Small cycle 2 }//////////////////////////////////// /// // {small cycle 2}
// The First Time
TempC1: = ord (Name [1]) tempB $ 134A;
TempC2: = (ord (Name [2]) $23) * $ 25A) temp1;
// The second start cycle
PosADD: = 2;
For pos: = 4 downto 1 do
Begin
PosADD: = posADD 1;
TempC1: = tempC1 ord (Name [1]) $ 134A;
TempC2: = tempC2 (ord (Name [posADD]) $23) * $ 25A );
If (posADD = 4) or (posADD = 5) then
Begin
{String Reverse Order}
For posSTR: = length (Name) downto 1 do
Begin
Name: = Name [posSTR];
End;
PosSTR: = length (Name) div 2;
Name: = copy (Name, posSTR 1, posSTR );
{String Reverse Order}
End;
End;

{Last detected }//////////////////////////////////// /// // {last detection}
// Name: = EditName. Text;
TempD1: = (tempC2 $ 3C) xor ($1337-ord (Name [3]);
TempD2: = (tempC1 tempA) xor ($18-ord (Name [6]);
Result: = 'rhm ''-'inttostr (tempD1) inttostr (tempD2 );
End;


// =================================== Rewrite the registration machine written by johnroot (CM without knowledge of algorithms)
Function johnroot (Name: string): string;
Var
Nameok, gg, gg2, mm, mm2: pchar;
I, j, j2, k: integer;
Begin
Getmem (nameok, $10 );
ZeroMemory (nameok, $10 );
Getmem (mm, 5 );
ZeroMemory (mm, 5 );
Getmem (mm2, 5 );
ZeroMemory (mm2, 5 );

For I: = 0 to (length (name)-1) do
Begin
Nameok [I]: = Name [I];
End;

J: = 0;
For I: = 0 to $ f do
Begin
K: = ord (nameok [I]) xor $82;
J: = j k;
End;
Gg: = pchar (inttostr (j ));

J: = 0;
For I: = 0 to $ f do
Begin
K: = ord (nameok [I]) xor $28;
J2: = j2 k;
End;
Gg2: = pchar (inttostr (j2 ));
If length (gg2) <4 then
Begin
Gg2: = pchar ('0' string (gg2 ));
End;

For I: = 0 to 3 do
Begin
Mm [I]: = char ($69-ord (gg [I]);
End;

For I: = 0 to 3 do
Begin
Mm2 [I]: = char ($69-ord (gg2 [I]);
End;
Result: = string (gg) string (gg2) string (mm) string (mm2 );
End;