diff options
Diffstat (limited to 'Dbx_mmap_SA/Cryptors/Athena')
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/UAthena.pas | 172 | ||||
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/athena.cfg | 38 | ||||
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/athena.dof | 136 | ||||
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/athena.dpr | 114 | ||||
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/athena.rc | 28 | ||||
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/athena.res | bin | 0 -> 916 bytes | |||
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/md5_mod256_unit.pas | 64 | ||||
| -rw-r--r-- | Dbx_mmap_SA/Cryptors/Athena/md5_unit.pas | 406 | 
8 files changed, 958 insertions, 0 deletions
| diff --git a/Dbx_mmap_SA/Cryptors/Athena/UAthena.pas b/Dbx_mmap_SA/Cryptors/Athena/UAthena.pas new file mode 100644 index 0000000..23cb283 --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/UAthena.pas @@ -0,0 +1,172 @@ +unit UAthena;
 +{
 +  Athena: cryptor module for Miranda SecuredMMAP Database driver
 +  Copyright 2007-2008 Klyde
 +
 +  This program is free software; you can redistribute it and/or
 +  modify it under the terms of the GNU General Public License
 +  as published by the Free Software Foundation; either version 2
 +  of the License, or (at your option) any later version.
 +
 +  This program is distributed in the hope that it will be useful,
 +  but WITHOUT ANY WARRANTY; without even the implied warranty of
 +  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 +  GNU General Public License for more details.
 +
 +  You should have received a copy of the GNU General Public License
 +  along with this program; if not, write to the Free Software
 +  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
 +}
 +
 +
 +interface
 +uses
 +   SysUtils, md5_unit, windows;
 +Type
 +   Arr  = array of byte;
 +   PArr = ^Arr;
 +   
 +   Function MD5_Mod(s: string; block_count: byte): string;
 +   Procedure MakeKey(key: PArr; len: word; pwd: string);
 +   Procedure EncryptData(key: PArr; data: PByte; size: LongWord);
 +   Procedure DecryptData(key: PArr; data: PByte; size: LongWord);
 +
 +implementation
 +//==============================================================================
 +Function str_back(s: string): string;
 +Var
 +   i: integer;
 +Begin
 +   result := '';
 +   for i := Length(s) downto 1 do result := result + s[i];
 +end;
 +//==============================================================================
 +Function MD5_Mod(s: string; block_count: byte): string;
 +Var
 +   s1, s2, sb : String;
 +   k          : word;
 +Begin
 +   sb := str_back(s);
 +   s2 := '';
 +   For k := 1 to block_count do
 +   Begin
 +      s1 := md5(s + sb);
 +      s2 := str_back(s2 + md5(s1+sb+s2));
 +   End;
 +   result := s2;
 +end;
 +//==============================================================================
 +Procedure MakeKey(key: PArr; len: word; pwd: string);
 +Var
 +   s : string;
 +   i : word;
 +Begin
 +   if len > 64 then Len := ((Len div 16) + 1)*16 else Len := 64;
 +   SetLength(key^, Len);
 +   s := MD5_mod(pwd, len div 16);
 +   for i := 1 to length(s) div 2 do key^[i-1] := strtoint('$' + copy(s, i*2 - 1, 2));
 +end;
 +//==============================================================================
 +Procedure GetNENum(key: arr; var n1, n2: LongWord);
 +Var
 +   i: LongWord;
 +Begin
 +   n1 := 0;
 +   n2 := 0;
 +   for i := 0 to Length(key) - 1 do
 +   Begin
 +      n1 := n1 + key[i] + (i + 1)*(n1+1);
 +      n2 := n2 + key[i] - (i + 1)*(n2+1);
 +   end;
 +   n1 := n1*2 + 1;
 +   n2 := n2*2 + 3;
 +end;
 +
 +//==============================================================================
 +Procedure SimGamm(key: PArr; data: PByte; size: LongWord);
 +Var
 +   kg : Arr;
 +   i, n1, n2 : LongWord;
 +   lk, k1, k2 : word;
 +Begin
 +   lk := Length(key^);
 +   SetLength(kg, lk);
 +   for i := 0 to lk - 1 do kg[i] := key^[i];
 +   GetNENum(kg, n1, n2);
 +   For i := 1 to size - 1 do
 +   Begin
 +      if (i mod lk) = 0 then GetNENum(kg, n1, n2);
 +      k1 := (i+n1+7)*n2 mod lk;
 +      k2 := (i+n2+3)*n1 mod lk;
 +
 +      PByte(LongWord(data)+i)^ := PByte(LongWord(data)+i)^ xor kg[k1] xor kg[k2];
 +
 +      kg[k1] := kg[k1]*k1 + kg[k2] + i*k2;
 +      kg[k2] := kg[k2]*k2 + kg[k1] + i*k1;
 +   end;
 +end;
 +//==============================================================================
 +Procedure Left(key: PArr; data: PByte; size: LongWord);
 +Var
 +   k : Arr;
 +   i, n1, n2 : LongWord;
 +   lk, k1, k2 : word;
 +
 +Begin
 +   lk := Length(key^);
 +
 +   SetLength(k, lk);
 +   for i := 0 to lk - 1 do k[i] := key^[i];
 +   GetNENum(k, n1, n2);
 +   //---------------------------------------------------------------------------
 +   k1 := (n2 + lk)*n1 mod lk;
 +   k2 := (n1 + lk)*n2 mod lk;
 +   data^ := data^ xor k[k1] xor k[k2];
 +
 +   //---------------------------------------------------------------------------
 +   For i := 1 to size - 1 do
 +   Begin
 +      k1 := (i+n1)*n2 mod lk;
 +      k2 := (i+n2)*n1 mod lk;
 +
 +      PByte(LongWord(data)+i)^ := PByte(LongWord(data)+i)^ xor ((PByte(LongWord(data)+i-1)^ xor k[k1]) xor k[k2]);
 +   end;
 +end;
 +//==============================================================================
 +Procedure Right(key: PArr; data: PByte; size: LongWord);
 +Var
 +   k : Arr;
 +   i, n1, n2 : LongWord;
 +   lk, k1, k2 : word;
 +Begin
 +   lk := Length(key^);
 +   SetLength(k, lk);
 +   for i := 0 to lk - 1 do k[i] := key^[i];
 +   GetNENum(k, n1, n2);
 +   //---------------------------------------------------------------------------
 +   For i := size - 1 downto 1 do
 +   Begin
 +      k1 := (i+n1)*n2 mod lk;
 +      k2 := (i+n2)*n1 mod lk;
 +      PByte(LongWord(data) + i)^ := PByte(LongWord(data)+i)^ xor ((PByte(LongWord(data) + i - 1)^ xor k[k1]) xor k[k2]);
 +   end;
 +   //---------------------------------------------------------------------------
 +   k1 := (n2 + lk)*n1 mod lk;
 +   k2 := (n1 + lk)*n2 mod lk;
 +   data^ := data^ xor k[k1] xor k[k2];
 +end;
 +//==============================================================================
 +Procedure EncryptData(key: PArr; data: PByte; size: LongWord);
 +Begin
 +   Left(key, data, size);
 +   SimGamm(key, data, size);
 +end;
 +//==============================================================================
 +Procedure DecryptData(key: PArr; data: PByte; size: LongWord);
 +Begin
 +   SimGamm(key, data, size);
 +   Right(key, data, size);
 +end;
 +//==============================================================================
 +end.
 +
 diff --git a/Dbx_mmap_SA/Cryptors/Athena/athena.cfg b/Dbx_mmap_SA/Cryptors/Athena/athena.cfg new file mode 100644 index 0000000..273efb4 --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/athena.cfg @@ -0,0 +1,38 @@ +-$A8
 +-$B-
 +-$C+
 +-$D+
 +-$E-
 +-$F-
 +-$G+
 +-$H+
 +-$I+
 +-$J-
 +-$K-
 +-$L+
 +-$M-
 +-$N+
 +-$O+
 +-$P+
 +-$Q-
 +-$R-
 +-$S-
 +-$T-
 +-$U-
 +-$V+
 +-$W-
 +-$X+
 +-$YD
 +-$Z1
 +-cg
 +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
 +-H+
 +-W+
 +-M
 +-$M16384,1048576
 +-K$00400000
 +-LE"d:\program files\borland\delphi7\Projects\Bpl"
 +-LN"d:\program files\borland\delphi7\Projects\Bpl"
 +-w-UNSAFE_TYPE
 +-w-UNSAFE_CODE
 +-w-UNSAFE_CAST
 diff --git a/Dbx_mmap_SA/Cryptors/Athena/athena.dof b/Dbx_mmap_SA/Cryptors/Athena/athena.dof new file mode 100644 index 0000000..d43219d --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/athena.dof @@ -0,0 +1,136 @@ +[FileVersion]
 +Version=7.0
 +[Compiler]
 +A=8
 +B=0
 +C=1
 +D=1
 +E=0
 +F=0
 +G=1
 +H=1
 +I=1
 +J=0
 +K=0
 +L=1
 +M=0
 +N=1
 +O=1
 +P=1
 +Q=0
 +R=0
 +S=0
 +T=0
 +U=0
 +V=1
 +W=0
 +X=1
 +Y=1
 +Z=1
 +ShowHints=1
 +ShowWarnings=1
 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
 +NamespacePrefix=
 +SymbolDeprecated=1
 +SymbolLibrary=1
 +SymbolPlatform=1
 +UnitLibrary=1
 +UnitPlatform=1
 +UnitDeprecated=1
 +HResultCompat=1
 +HidingMember=1
 +HiddenVirtual=1
 +Garbage=1
 +BoundsError=1
 +ZeroNilCompat=1
 +StringConstTruncated=1
 +ForLoopVarVarPar=1
 +TypedConstVarPar=1
 +AsgToTypedConst=1
 +CaseLabelRange=1
 +ForVariable=1
 +ConstructingAbstract=1
 +ComparisonFalse=1
 +ComparisonTrue=1
 +ComparingSignedUnsigned=1
 +CombiningSignedUnsigned=1
 +UnsupportedConstruct=1
 +FileOpen=1
 +FileOpenUnitSrc=1
 +BadGlobalSymbol=1
 +DuplicateConstructorDestructor=1
 +InvalidDirective=1
 +PackageNoLink=1
 +PackageThreadVar=1
 +ImplicitImport=1
 +HPPEMITIgnored=1
 +NoRetVal=1
 +UseBeforeDef=1
 +ForLoopVarUndef=1
 +UnitNameMismatch=1
 +NoCFGFileFound=1
 +MessageDirective=1
 +ImplicitVariants=1
 +UnicodeToLocale=1
 +LocaleToUnicode=1
 +ImagebaseMultiple=1
 +SuspiciousTypecast=1
 +PrivatePropAccessor=1
 +UnsafeType=0
 +UnsafeCode=0
 +UnsafeCast=0
 +[Linker]
 +MapFile=0
 +OutputObjs=0
 +ConsoleApp=1
 +DebugInfo=0
 +RemoteSymbols=0
 +MinStackSize=16384
 +MaxStackSize=1048576
 +ImageBase=4194304
 +ExeDescription=
 +[Directories]
 +OutputDir=
 +UnitOutputDir=
 +PackageDLLOutputDir=
 +PackageDCPOutputDir=
 +SearchPath=
 +Packages=
 +Conditionals=
 +DebugSourceDirs=
 +UsePackages=0
 +[Parameters]
 +RunParams=
 +HostApplication=
 +Launcher=
 +UseLauncher=0
 +DebugCWD=
 +[Language]
 +ActiveLang=
 +ProjectLang=
 +RootDir=
 +[Version Info]
 +IncludeVerInfo=0
 +AutoIncBuild=0
 +MajorVer=1
 +MinorVer=0
 +Release=0
 +Build=0
 +Debug=0
 +PreRelease=0
 +Special=0
 +Private=0
 +DLL=0
 +Locale=1049
 +CodePage=1251
 +[Version Info Keys]
 +CompanyName=
 +FileDescription=
 +FileVersion=1.0.0.0
 +InternalName=
 +LegalCopyright=
 +LegalTrademarks=
 +OriginalFilename=
 +ProductName=
 +ProductVersion=1.0.0.0
 +Comments=
 diff --git a/Dbx_mmap_SA/Cryptors/Athena/athena.dpr b/Dbx_mmap_SA/Cryptors/Athena/athena.dpr new file mode 100644 index 0000000..00b95c2 --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/athena.dpr @@ -0,0 +1,114 @@ +library athena;
 +
 +{
 +  Athena: cryptor module for Miranda SecuredMMAP Database driver
 +  Copyright 2007-2008 Klyde
 +
 +  This program is free software; you can redistribute it and/or
 +  modify it under the terms of the GNU General Public License
 +  as published by the Free Software Foundation; either version 2
 +  of the License, or (at your option) any later version.
 +
 +  This program is distributed in the hope that it will be useful,
 +  but WITHOUT ANY WARRANTY; without even the implied warranty of
 +  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 +  GNU General Public License for more details.
 +
 +  You should have received a copy of the GNU General Public License
 +  along with this program; if not, write to the Free Software
 +  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
 +}
 +
 +uses
 +  SysUtils,
 +  Classes,
 +  UAthena,
 +  WIndows;
 +
 +{$R *.res}
 +
 +type
 +  TGenerateKey = function(key: PChar): PArr; stdcall;
 +  TFreeKey = procedure(key: PArr); stdcall;
 +  TEncryptMem = procedure(data: PByte; size: LongWord; key: PArr); stdcall;
 +
 +  PCryptorInfo = ^TCryptorInfo;
 +  TCryptorInfo = record
 +    GenerateKey: TGenerateKey;
 +    FreeKey: TFreeKey;
 +
 +    EncryptMem: TEncryptMem;
 +    DecryptMem: TEncryptMem;
 +
 +    Name: PChar;
 +    Info: PChar;
 +    Author: PChar;
 +    Site: PChar;
 +    Email: PChar;
 +
 +    version: dword;
 +
 +    uid: word;
 +  end;
 +
 +var
 +  Info: TCryptorInfo;
 +
 +
 +function PLUGIN_MAKE_VERSION(a,b,c,d: Cardinal): integer;
 +begin
 +  Result := (a shl 24) or (b shl 16) or (c shl 8) or d;
 +end;
 +
 +function GenerateKey(pwd: PChar): PArr; stdcall;
 +var
 +  a: PArr;
 +begin
 +
 +  new(a);
 +  MakeKey(a, 512, pwd);
 +  result := a;
 +
 +end;
 +
 +procedure FreeKey(key: PArr); stdcall;
 +begin
 +  FreeMem(key);
 +end;
 +
 +procedure EncryptMem(data: PByte; size: LongWord; key: PArr); stdcall;
 +begin
 +  if size <= 0 then exit;
 +  EncryptData(key, data, size);
 +end;
 +
 +procedure DecryptMem(data: PByte; size: LongWord; key: PArr); stdcall;
 +begin
 +  if size <= 0 then exit;
 +  DecryptData(key, data, size);
 +end;
 +
 +function GetCryptor: PCryptorInfo; stdcall;
 +begin
 +  Info.Name := 'Athena';
 +  Info.Author := 'Klyde';
 +  Info.Site := 'http://cityopen.ru/forum/journal.php?user=151';
 +  Info.Email := 'xxxmara@mail.ru';
 +  Info.Info := 'Secure alghoritm developed in russian universities';
 +
 +  Info.version := PLUGIN_MAKE_VERSION(0,0,3,0);
 +
 +  Info.UID := $FEA8;
 +
 +  Info.GenerateKey := GenerateKey;
 +  Info.FreeKey := FreeKey;
 +  Info.EncryptMem := EncryptMem;
 +  Info.DecryptMem := DecryptMem;
 +
 +  result := @Info;
 +end;
 +
 +exports GetCryptor;
 +
 +begin
 +end.
 diff --git a/Dbx_mmap_SA/Cryptors/Athena/athena.rc b/Dbx_mmap_SA/Cryptors/Athena/athena.rc new file mode 100644 index 0000000..bc035ab --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/athena.rc @@ -0,0 +1,28 @@ +VS_VERSION_INFO VERSIONINFO
 + FILEVERSION 0,0,3,0
 + PRODUCTVERSION 0,0,3,0
 + FILEFLAGSMASK $3F
 + FILEOS 4
 + FILETYPE 2
 + FILESUBTYPE 0
 +BEGIN
 +  BLOCK "StringFileInfo"
 +  BEGIN
 +    BLOCK "000004b0"
 +    BEGIN
 +      VALUE "CompanyName",""
 +      VALUE "Comments", "Secure alghoritm developed in russian universities"0
 +      VALUE "FileDescription", "Secure alghoritm developed in russian universities"0
 +      VALUE "FileVersion", "0, 0, 3, 0 "0
 +      VALUE "InternalName", "Athena"0
 +      VALUE "OriginalFilename", "Athena.dll"0
 +      VALUE "ProductName", "Athena"0
 +      VALUE "ProductVersion", "0, 0, 3, 0 "0
 +      VALUE "SpecialBuild", ".04.2010 "0
 +    END
 +  END
 +  BLOCK "VarFileInfo"
 +  BEGIN
 +      VALUE "Translation",0,1200
 +  END
 +END
\ No newline at end of file diff --git a/Dbx_mmap_SA/Cryptors/Athena/athena.res b/Dbx_mmap_SA/Cryptors/Athena/athena.resBinary files differ new file mode 100644 index 0000000..908733f --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/athena.res diff --git a/Dbx_mmap_SA/Cryptors/Athena/md5_mod256_unit.pas b/Dbx_mmap_SA/Cryptors/Athena/md5_mod256_unit.pas new file mode 100644 index 0000000..53b2d99 --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/md5_mod256_unit.pas @@ -0,0 +1,64 @@ +unit md5_mod256_unit;
 +interface
 +
 +Uses
 +   MD5_Unit, sysutils, classes, windows;
 +Const
 +   MSize = 256;
 +Type
 +   tiAr = array [0..255] of integer;
 +
 +Function MD5_Mod(s: String): String;
 +Function MD5_Matrix(s: string): tArr;
 +Function str_back(s: String): String;
 +
 +implementation
 +//==============================================================================
 +Function str_back(s: String): String;
 +Var
 +   i: integer;
 +Begin
 +   result := '';
 +   for i := Length(s) downto 1 do result := result + s[i];
 +end;
 +//==============================================================================
 +Function MD5_Mod_back(s: String): String;
 +Var
 +   s1, s2 : String;
 +   k      : word;
 +Begin
 +   s1 := str_back(s)+s;
 +   s2 := md5(str_back(s)+str_back(md5(s))+
 +             str_back(md5(s+s))+
 +             str_back(md5(s+s+s))+
 +             str_back(md5(s+s+s+s))+
 +             str_back(md5(s+s+s+'asddsa'+s)));
 +   For k:=1 to trunc(sqrt(MSize))-1 do
 +   Begin
 +      s1 := md5(s1 + s2 + md5(s1+s1+s2+s) + md5(s2+s2+s1+s) + s);
 +      s2 := str_back(s2 + str_back(md5(s1+s2+md5(s))));
 +   End;
 +   result:=s2;
 +end;
 +//==============================================================================
 +Function MD5_Mod(s: String): String;
 +Var
 +   s1, s2 : String;
 +   k      : word;
 +Begin
 +   s1 := s + AnsiUpperCase(s) + AnsiLowerCase(s);
 +   s2 := md5(s+md5(s)+md5(s+s)+md5(s+AnsiUpperCase(s)+s)+md5(s+AnsiLowerCase(s+s)+s)+md5(s+s+str_back(s+s+'qweewq')));
 +   For k:=1 to trunc(sqrt(MSize))-1 do
 +   Begin
 +      s1 := md5(s1 + str_back(s2) + md5(s1+s1+s2+s) + str_back(md5(s2+s2+s1+s)) + s);
 +      s2 := str_back(s2 + md5(s1+AnsiUpperCase(s2+md5(s))));
 +   End;
 +   result:=s2;
 +end;
 +//==============================================================================
 +
 +//==============================================================================
 +end.
 +
 +
 +
 diff --git a/Dbx_mmap_SA/Cryptors/Athena/md5_unit.pas b/Dbx_mmap_SA/Cryptors/Athena/md5_unit.pas new file mode 100644 index 0000000..d09c086 --- /dev/null +++ b/Dbx_mmap_SA/Cryptors/Athena/md5_unit.pas @@ -0,0 +1,406 @@ +unit md5_unit;
 +
 +interface
 +
 +uses
 +   Windows, SysUtils;
 +Type
 +   TMD5 = Array [0..15] of byte;
 +
 +function MD5(s: string): string;
 +function MD5_arr(s: string): TMD5;
 +
 +implementation
 +//==============================================================================
 +function Int2Hex( Value : DWord; Digits : Integer ) : String;
 +asm
 +        PUSH      0
 +        ADD       ESP, -0Ch
 +
 +        PUSH      EBX
 +        PUSH      ECX
 +
 +        LEA       EBX, [ESP+8+0Fh]  // EBX := @Buf[ 15 ]
 +        AND       EDX, $F
 +
 +@@loop: DEC       EBX
 +        DEC       EDX
 +
 +        PUSH      EAX
 +        {$IFDEF PARANOIA}
 +        DB $24, $0F
 +        {$ELSE}
 +        AND       AL, 0Fh
 +        {$ENDIF}
 +        {$IFDEF PARANOIA}
 +        DB $3C, 9
 +        {$ELSE}
 +        CMP       AL, 9
 +        {$ENDIF}
 +        JA        @@10
 +        {$IFDEF PARANOIA}
 +        DB $04, 30h-41h+0Ah
 +        {$ELSE}
 +        ADD       AL,30h-41h+0Ah
 +        {$ENDIF}
 +@@10:
 +        {$IFDEF PARANOIA}
 +        DB $04, 41h-0Ah
 +        {$ELSE}
 +        ADD       AL,41h-0Ah
 +        {$ENDIF}
 +        MOV       byte ptr [EBX], AL
 +        POP       EAX
 +        SHR       EAX, 4
 +
 +        JNZ       @@loop
 +
 +        TEST      EDX, EDX
 +        JG        @@loop
 +
 +        POP       EAX      // EAX = @Result
 +        MOV       EDX, EBX // EDX = @resulting string
 +        CALL      System.@LStrFromPChar
 +
 +        POP       EBX
 +        ADD       ESP, 10h
 +
 +end;                     
 +//==============================================================================
 +function MD5(s: string): string;
 +var
 +   a : TMD5;
 +   i : integer;
 +   LenHi, LenLo: longword;
 +   Index: DWord;
 +   HashBuffer  : array[0..63] of byte;
 +   CurrentHash : array[0..3] of DWord;
 +
 +   procedure Burn;
 +   begin
 +      LenHi:= 0; LenLo:= 0;
 +      Index:= 0;
 +      FillChar(HashBuffer,Sizeof(HashBuffer),0);
 +      FillChar(CurrentHash,Sizeof(CurrentHash),0);
 +   end;
 +
 +   procedure Init;
 +   begin
 +      Burn;
 +      CurrentHash[0]:= $67452301;
 +      CurrentHash[1]:= $efcdab89;
 +      CurrentHash[2]:= $98badcfe;
 +      CurrentHash[3]:= $10325476;
 +   end;
 +
 +   function LRot32(a, b: longword): longword;
 +   begin
 +      Result:= (a shl b) or (a shr (32-b));
 +   end;
 +
 +   procedure Compress;
 +   var
 +      Data : array[0..15] of dword;
 +      A, B, C, D: dword;
 +   begin
 +      Move(HashBuffer,Data,Sizeof(Data));
 +      A:= CurrentHash[0];
 +      B:= CurrentHash[1];
 +      C:= CurrentHash[2];
 +      D:= CurrentHash[3];
 +
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 0] + $d76aa478,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 1] + $e8c7b756,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 2] + $242070db,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 3] + $c1bdceee,22);
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 4] + $f57c0faf,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 5] + $4787c62a,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 6] + $a8304613,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 7] + $fd469501,22);
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 8] + $698098d8,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 9] + $8b44f7af,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[10] + $ffff5bb1,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[11] + $895cd7be,22);
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[12] + $6b901122,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[13] + $fd987193,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[14] + $a679438e,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[15] + $49b40821,22);
 +    
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 1] + $f61e2562,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 6] + $c040b340,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[11] + $265e5a51,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 0] + $e9b6c7aa,20);
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 5] + $d62f105d,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[10] + $02441453,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[15] + $d8a1e681,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 4] + $e7d3fbc8,20);
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 9] + $21e1cde6,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[14] + $c33707d6,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 3] + $f4d50d87,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 8] + $455a14ed,20);
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[13] + $a9e3e905,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 2] + $fcefa3f8,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 7] + $676f02d9,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[12] + $8d2a4c8a,20);
 +    
 +      A:= B + LRot32(A + (B xor C xor D) + Data[ 5] + $fffa3942,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[ 8] + $8771f681,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[11] + $6d9d6122,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[14] + $fde5380c,23);
 +      A:= B + LRot32(A + (B xor C xor D) + Data[ 1] + $a4beea44,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[ 4] + $4bdecfa9,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[ 7] + $f6bb4b60,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[10] + $bebfbc70,23);
 +      A:= B + LRot32(A + (B xor C xor D) + Data[13] + $289b7ec6,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[ 0] + $eaa127fa,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[ 3] + $d4ef3085,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[ 6] + $04881d05,23);
 +      A:= B + LRot32(A + (B xor C xor D) + Data[ 9] + $d9d4d039,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[12] + $e6db99e5,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[15] + $1fa27cf8,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[ 2] + $c4ac5665,23);
 +    
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 0] + $f4292244,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 7] + $432aff97,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[14] + $ab9423a7,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 5] + $fc93a039,21);
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[12] + $655b59c3,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 3] + $8f0ccc92,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[10] + $ffeff47d,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 1] + $85845dd1,21);
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 8] + $6fa87e4f,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[15] + $fe2ce6e0,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 6] + $a3014314,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[13] + $4e0811a1,21);
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 4] + $f7537e82,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[11] + $bd3af235,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 2] + $2ad7d2bb,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 9] + $eb86d391,21);
 +    
 +      Inc(CurrentHash[0],A);
 +      Inc(CurrentHash[1],B);
 +      Inc(CurrentHash[2],C);
 +      Inc(CurrentHash[3],D);
 +      Index:= 0;
 +      FillChar(HashBuffer,Sizeof(HashBuffer),0);
 +   end;
 +
 +procedure Update(const Buffer; Size: longword);
 +var
 +   PBuf: ^byte;
 +begin
 +   Inc(LenHi,Size shr 29);
 +   Inc(LenLo,Size*8);
 +   if LenLo < (Size*8) then  Inc(LenHi);
 +   PBuf:= @Buffer;
 +   while Size> 0 do
 +   begin
 +      if (Sizeof(HashBuffer)-Index)<= DWord(Size) then
 +      begin
 +         Move(PBuf^,HashBuffer[Index],Sizeof(HashBuffer)-Index);
 +         Dec(Size,Sizeof(HashBuffer)-Index);
 +         Inc(PBuf,Sizeof(HashBuffer)-Index);
 +         Compress;
 +       end else
 +       begin
 +          Move(PBuf^,HashBuffer[Index],Size);
 +          Inc(Index,Size);
 +          Size:= 0;
 +       end;
 +   end;
 +end;
 +
 +procedure Final(var Digest);
 +begin
 +  HashBuffer[Index] := $80;
 +  if Index>= 56 then Compress;
 +  PDWord(@HashBuffer[56])^ := LenLo;
 +  PDWord(@HashBuffer[60])^ := LenHi;
 +  Compress;
 +  Move(CurrentHash, Digest, Sizeof(CurrentHash));
 +  Burn;
 +end;
 +
 +begin
 +   Init;
 +   Update(s[1], Length(s));
 +   Final(a);
 +   result := '';
 +   for i := 0 to 15 do result := result + Int2Hex(a[i], 2);
 +   Burn;
 +end;
 +//==============================================================================
 +function MD5_arr(s: string): TMD5;
 +var
 +   a : TMD5;
 +   LenHi, LenLo: longword;
 +   Index: DWord;
 +   HashBuffer  : array[0..63] of byte;
 +   CurrentHash : array[0..3] of DWord;
 +
 +   procedure Burn;
 +   begin
 +      LenHi:= 0; LenLo:= 0;
 +      Index:= 0;
 +      FillChar(HashBuffer,Sizeof(HashBuffer),0);
 +      FillChar(CurrentHash,Sizeof(CurrentHash),0);
 +   end;
 +
 +   procedure Init;
 +   begin
 +      Burn;
 +      CurrentHash[0]:= $67452301;
 +      CurrentHash[1]:= $efcdab89;
 +      CurrentHash[2]:= $98badcfe;
 +      CurrentHash[3]:= $10325476;
 +   end;
 +
 +   function LRot32(a, b: longword): longword;
 +   begin
 +      Result:= (a shl b) or (a shr (32-b));
 +   end;
 +
 +   procedure Compress;
 +   var
 +      Data : array[0..15] of dword;
 +      A, B, C, D: dword;
 +   begin
 +      Move(HashBuffer,Data,Sizeof(Data));
 +      A:= CurrentHash[0];
 +      B:= CurrentHash[1];
 +      C:= CurrentHash[2];
 +      D:= CurrentHash[3];
 +
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 0] + $d76aa478,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 1] + $e8c7b756,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 2] + $242070db,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 3] + $c1bdceee,22);
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 4] + $f57c0faf,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 5] + $4787c62a,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 6] + $a8304613,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 7] + $fd469501,22);
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 8] + $698098d8,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 9] + $8b44f7af,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[10] + $ffff5bb1,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[11] + $895cd7be,22);
 +      A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[12] + $6b901122,7);
 +      D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[13] + $fd987193,12);
 +      C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[14] + $a679438e,17);
 +      B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[15] + $49b40821,22);
 +    
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 1] + $f61e2562,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 6] + $c040b340,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[11] + $265e5a51,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 0] + $e9b6c7aa,20);
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 5] + $d62f105d,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[10] + $02441453,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[15] + $d8a1e681,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 4] + $e7d3fbc8,20);
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 9] + $21e1cde6,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[14] + $c33707d6,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 3] + $f4d50d87,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 8] + $455a14ed,20);
 +      A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[13] + $a9e3e905,5);
 +      D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 2] + $fcefa3f8,9);
 +      C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 7] + $676f02d9,14);
 +      B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[12] + $8d2a4c8a,20);
 +    
 +      A:= B + LRot32(A + (B xor C xor D) + Data[ 5] + $fffa3942,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[ 8] + $8771f681,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[11] + $6d9d6122,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[14] + $fde5380c,23);
 +      A:= B + LRot32(A + (B xor C xor D) + Data[ 1] + $a4beea44,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[ 4] + $4bdecfa9,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[ 7] + $f6bb4b60,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[10] + $bebfbc70,23);
 +      A:= B + LRot32(A + (B xor C xor D) + Data[13] + $289b7ec6,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[ 0] + $eaa127fa,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[ 3] + $d4ef3085,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[ 6] + $04881d05,23);
 +      A:= B + LRot32(A + (B xor C xor D) + Data[ 9] + $d9d4d039,4);
 +      D:= A + LRot32(D + (A xor B xor C) + Data[12] + $e6db99e5,11);
 +      C:= D + LRot32(C + (D xor A xor B) + Data[15] + $1fa27cf8,16);
 +      B:= C + LRot32(B + (C xor D xor A) + Data[ 2] + $c4ac5665,23);
 +    
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 0] + $f4292244,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 7] + $432aff97,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[14] + $ab9423a7,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 5] + $fc93a039,21);
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[12] + $655b59c3,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 3] + $8f0ccc92,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[10] + $ffeff47d,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 1] + $85845dd1,21);
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 8] + $6fa87e4f,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[15] + $fe2ce6e0,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 6] + $a3014314,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[13] + $4e0811a1,21);
 +      A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 4] + $f7537e82,6);
 +      D:= A + LRot32(D + (B xor (A or (not C))) + Data[11] + $bd3af235,10);
 +      C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 2] + $2ad7d2bb,15);
 +      B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 9] + $eb86d391,21);
 +    
 +      Inc(CurrentHash[0],A);
 +      Inc(CurrentHash[1],B);
 +      Inc(CurrentHash[2],C);
 +      Inc(CurrentHash[3],D);
 +      Index:= 0;
 +      FillChar(HashBuffer,Sizeof(HashBuffer),0);
 +   end;
 +
 +procedure Update(const Buffer; Size: longword);
 +var
 +   PBuf: ^byte;
 +begin
 +   Inc(LenHi,Size shr 29);
 +   Inc(LenLo,Size*8);
 +   if LenLo < (Size*8) then  Inc(LenHi);
 +   PBuf:= @Buffer;
 +   while Size> 0 do
 +   begin
 +      if (Sizeof(HashBuffer)-Index)<= DWord(Size) then
 +      begin
 +         Move(PBuf^,HashBuffer[Index],Sizeof(HashBuffer)-Index);
 +         Dec(Size,Sizeof(HashBuffer)-Index);
 +         Inc(PBuf,Sizeof(HashBuffer)-Index);
 +         Compress;
 +       end else
 +       begin
 +          Move(PBuf^,HashBuffer[Index],Size);
 +          Inc(Index,Size);
 +          Size:= 0;
 +       end;
 +   end;
 +end;
 +
 +procedure Final(var Digest);
 +begin
 +   HashBuffer[Index] := $80;
 +   if Index >= 56 then Compress;
 +   PDWord(@HashBuffer[56])^ := LenLo;
 +   PDWord(@HashBuffer[60])^ := LenHi;
 +   Compress;
 +   Move(CurrentHash, Digest, Sizeof(CurrentHash));
 +   Burn;
 +end;
 +
 +begin
 +   Init;
 +   Update(s[1], Length(s));
 +   Final(a);
 +   result := a;
 +   Burn;
 +end;
 +
 +end.
 +
 +
 +
 +
 +
 +
 +
 +
 +
 +
 +
 +
 | 
