开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
swfmd5.pas
资源名称：DelphiSWFSDK2[1].4.rar　[点击查看]
上传用户：raido2005
上传日期：2022-06-22
资源大小：5044k
文件大小：12k
源码类别：

Delphi控件源码

开发平台：

Delphi

swfmd5.pas：源码内容
  1. //*******************************************************//
  2. //                                                       //
  3. //                      DelphiFlash.com                  //
  4. //              Copyright (c) 2004 FeatherySoft, Inc.    //
  5. //                    info@delphiflash.com               //
  6. //                                                       //
  7. //*******************************************************//
  9. //  Description:  MD5
  10. //  Last update:  15 may 2005
  12. Unit SWFmd5;
  14. Interface
  15. uses Windows;
  17. type
  18. MD5Count = array[0..1] of DWORD;
  19. MD5State = array[0..3] of DWORD;
  20. MD5Block = array[0..15] of DWORD;
  21. MD5CBits = array[0..7] of byte;
  22. MD5Digest = array[0..15] of byte;
  23. MD5Buffer = array[0..63] of byte;
  24. MD5Context = record
  25. State: MD5State;
  26. Count: MD5Count;
  27. Buffer: MD5Buffer;
  28. end;
  30. procedure MD5Init(var Context: MD5Context);
  31. procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
  32. procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
  34. function MD5String(M: string): MD5Digest;
  35. function MD5Print(D: MD5Digest): string;
  37. Function Cript_MD5(Passw, Salt: string): string;
  39. function MD5Match(D1, D2: MD5Digest): boolean;
  41. Implementation
  43. var
  44. PADDING: MD5Buffer = (
  45. $80, $00, $00, $00, $00, $00, $00, $00,
  46. $00, $00, $00, $00, $00, $00, $00, $00,
  47. $00, $00, $00, $00, $00, $00, $00, $00,
  48. $00, $00, $00, $00, $00, $00, $00, $00,
  49. $00, $00, $00, $00, $00, $00, $00, $00,
  50. $00, $00, $00, $00, $00, $00, $00, $00,
  51. $00, $00, $00, $00, $00, $00, $00, $00,
  52. $00, $00, $00, $00, $00, $00, $00, $00
  53. );
  55. function F(x, y, z: DWORD): DWORD;
  56. begin
  57. Result := (x and y) or ((not x) and z);
  58. end;
  60. function G(x, y, z: DWORD): DWORD;
  61. begin
  62. Result := (x and z) or (y and (not z));
  63. end;
  65. function H(x, y, z: DWORD): DWORD;
  66. begin
  67. Result := x xor y xor z;
  68. end;
  70. function I(x, y, z: DWORD): DWORD;
  71. begin
  72. Result := y xor (x or (not z));
  73. end;
  75. procedure rot(var x: DWORD; n: BYTE);
  76. begin
  77. x := (x shl n) or (x shr (32 - n));
  78. end;
  80. procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  81. begin
  82. inc(a, F(b, c, d) + x + ac);
  83. rot(a, s);
  84. inc(a, b);
  85. end;
  87. procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  88. begin
  89. inc(a, G(b, c, d) + x + ac);
  90. rot(a, s);
  91. inc(a, b);
  92. end;
  94. procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  95. begin
  96. inc(a, H(b, c, d) + x + ac);
  97. rot(a, s);
  98. inc(a, b);
  99. end;
  101. procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
  102. begin
  103. inc(a, I(b, c, d) + x + ac);
  104. rot(a, s);
  105. inc(a, b);
  106. end;
  108. // -----------------------------------------------------------------------------------------------
  110. // Encode Count bytes at Source into (Count / 4) DWORDs at Target
  111. procedure Encode(Source, Target: pointer; Count: longword);
  112. var
  113. S: PByte;
  114. T: PDWORD;
  115. I: longword;
  116. begin
  117. S := Source;
  118. T := Target;
  119. for I := 1 to Count div 4 do begin
  120. T^ := S^;
  121. inc(S);
  122. T^ := T^ or (S^ shl 8);
  123. inc(S);
  124. T^ := T^ or (S^ shl 16);
  125. inc(S);
  126. T^ := T^ or (S^ shl 24);
  127. inc(S);
  128. inc(T);
  129. end;
  130. end;
  132. // Decode Count DWORDs at Source into (Count * 4) Bytes at Target
  133. procedure Decode(Source, Target: pointer; Count: longword);
  134. var
  135. S: PDWORD;
  136. T: PByte;
  137. I: longword;
  138. begin
  139. S := Source;
  140. T := Target;
  141. for I := 1 to Count do begin
  142. T^ := S^ and $ff;
  143. inc(T);
  144. T^ := (S^ shr 8) and $ff;
  145. inc(T);
  146. T^ := (S^ shr 16) and $ff;
  147. inc(T);
  148. T^ := (S^ shr 24) and $ff;
  149. inc(T);
  150. inc(S);
  151. end;
  152. end;
  154. // Transform State according to first 64 bytes at Buffer
  155. procedure Transform(Buffer: pointer; var State: MD5State);
  156. var
  157. a, b, c, d: DWORD;
  158. Block: MD5Block;
  159. begin
  160. Encode(Buffer, @Block, 64);
  161. a := State[0];
  162. b := State[1];
  163. c := State[2];
  164. d := State[3];
  165. FF (a, b, c, d, Block[ 0],  7, $d76aa478);
  166. FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
  167. FF (c, d, a, b, Block[ 2], 17, $242070db);
  168. FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
  169. FF (a, b, c, d, Block[ 4],  7, $f57c0faf);
  170. FF (d, a, b, c, Block[ 5], 12, $4787c62a);
  171. FF (c, d, a, b, Block[ 6], 17, $a8304613);
  172. FF (b, c, d, a, Block[ 7], 22, $fd469501);
  173. FF (a, b, c, d, Block[ 8],  7, $698098d8);
  174. FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
  175. FF (c, d, a, b, Block[10], 17, $ffff5bb1);
  176. FF (b, c, d, a, Block[11], 22, $895cd7be);
  177. FF (a, b, c, d, Block[12],  7, $6b901122);
  178. FF (d, a, b, c, Block[13], 12, $fd987193);
  179. FF (c, d, a, b, Block[14], 17, $a679438e);
  180. FF (b, c, d, a, Block[15], 22, $49b40821);
  181. GG (a, b, c, d, Block[ 1],  5, $f61e2562);
  182. GG (d, a, b, c, Block[ 6],  9, $c040b340);
  183. GG (c, d, a, b, Block[11], 14, $265e5a51);
  184. GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
  185. GG (a, b, c, d, Block[ 5],  5, $d62f105d);
  186. GG (d, a, b, c, Block[10],  9,  $2441453);
  187. GG (c, d, a, b, Block[15], 14, $d8a1e681);
  188. GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
  189. GG (a, b, c, d, Block[ 9],  5, $21e1cde6);
  190. GG (d, a, b, c, Block[14],  9, $c33707d6);
  191. GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
  192. GG (b, c, d, a, Block[ 8], 20, $455a14ed);
  193. GG (a, b, c, d, Block[13],  5, $a9e3e905);
  194. GG (d, a, b, c, Block[ 2],  9, $fcefa3f8);
  195. GG (c, d, a, b, Block[ 7], 14, $676f02d9);
  196. GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
  197. HH (a, b, c, d, Block[ 5],  4, $fffa3942);
  198. HH (d, a, b, c, Block[ 8], 11, $8771f681);
  199. HH (c, d, a, b, Block[11], 16, $6d9d6122);
  200. HH (b, c, d, a, Block[14], 23, $fde5380c);
  201. HH (a, b, c, d, Block[ 1],  4, $a4beea44);
  202. HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
  203. HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
  204. HH (b, c, d, a, Block[10], 23, $bebfbc70);
  205. HH (a, b, c, d, Block[13],  4, $289b7ec6);
  206. HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
  207. HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
  208. HH (b, c, d, a, Block[ 6], 23,  $4881d05);
  209. HH (a, b, c, d, Block[ 9],  4, $d9d4d039);
  210. HH (d, a, b, c, Block[12], 11, $e6db99e5);
  211. HH (c, d, a, b, Block[15], 16, $1fa27cf8);
  212. HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
  213. II (a, b, c, d, Block[ 0],  6, $f4292244);
  214. II (d, a, b, c, Block[ 7], 10, $432aff97);
  215. II (c, d, a, b, Block[14], 15, $ab9423a7);
  216. II (b, c, d, a, Block[ 5], 21, $fc93a039);
  217. II (a, b, c, d, Block[12],  6, $655b59c3);
  218. II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
  219. II (c, d, a, b, Block[10], 15, $ffeff47d);
  220. II (b, c, d, a, Block[ 1], 21, $85845dd1);
  221. II (a, b, c, d, Block[ 8],  6, $6fa87e4f);
  222. II (d, a, b, c, Block[15], 10, $fe2ce6e0);
  223. II (c, d, a, b, Block[ 6], 15, $a3014314);
  224. II (b, c, d, a, Block[13], 21, $4e0811a1);
  225. II (a, b, c, d, Block[ 4],  6, $f7537e82);
  226. II (d, a, b, c, Block[11], 10, $bd3af235);
  227. II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
  228. II (b, c, d, a, Block[ 9], 21, $eb86d391);
  229. inc(State[0], a);
  230. inc(State[1], b);
  231. inc(State[2], c);
  232. inc(State[3], d);
  233. end;
  235. // -----------------------------------------------------------------------------------------------
  237. // Initialize given Context
  238. procedure MD5Init(var Context: MD5Context);
  239. begin
  240. with Context do begin
  241. State[0] := $67452301;
  242. State[1] := $efcdab89;
  243. State[2] := $98badcfe;
  244. State[3] := $10325476;
  245. Count[0] := 0;
  246. Count[1] := 0;
  247. ZeroMemory(@Buffer, SizeOf(MD5Buffer));
  248. end;
  249. end;
  251. // Update given Context to include Length bytes of Input
  252. procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
  253. var
  254. Index: longword;
  255. PartLen: longword;
  256. I: longword;
  257. begin
  258. with Context do begin
  259. Index := (Count[0] shr 3) and $3f;
  260. inc(Count[0], Length shl 3);
  261. if Count[0] < (Length shl 3) then inc(Count[1]);
  262. inc(Count[1], Length shr 29);
  263. end;
  264. PartLen := 64 - Index;
  265. if Length >= PartLen then begin
  266. CopyMemory(@Context.Buffer[Index], Input, PartLen);
  267. Transform(@Context.Buffer, Context.State);
  268. I := PartLen;
  269. while I + 63 < Length do begin
  270. Transform(@Input[I], Context.State);
  271. inc(I, 64);
  272. end;
  273. Index := 0;
  274. end else I := 0;
  275. CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
  276. end;
  278. // Finalize given Context, create Digest and zeroize Context
  279. procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
  280. var
  281. Bits: MD5CBits;
  282. Index: longword;
  283. PadLen: longword;
  284. begin
  285. Decode(@Context.Count, @Bits, 2);
  286. Index := (Context.Count[0] shr 3) and $3f;
  287. if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
  288. MD5Update(Context, @PADDING, PadLen);
  289. MD5Update(Context, @Bits, 8);
  290. Decode(@Context.State, @Digest, 4);
  291. ZeroMemory(@Context, SizeOf(MD5Context));
  292. end;
  294. // -----------------------------------------------------------------------------------------------
  296. // Create digest of given Message
  297. function MD5String(M: string): MD5Digest;
  298. var
  299. Context: MD5Context;
  300. begin
  301. MD5Init(Context);
  302. MD5Update(Context, pChar(M), length(M));
  303. MD5Final(Context, Result);
  304. end;
  306. // Create hex representation of given Digest
  307. function MD5Print(D: MD5Digest): string;
  308. var
  309. I: byte;
  310. const
  311.   Digits: pchar = '01234567890abcdef';
  312. begin
  313. Result := '';
  314. for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
  315. end;
  317. const
  318.  itoa64: pchar = './0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  320. Function crypt_to64(v: dword; n: integer): string;
  321. begin
  322.   Result := '';
  323.   while (n > 0) do
  324.     begin
  325.        Result := Result + itoa64[v and $3f];
  326.        v := v shr 6;
  327.        dec(n);
  328.     end;
  330. end;
  332. // -----------------------------------------------------------------------------------------------
  334. Function Cript_MD5(Passw, Salt: string): string;
  335.  const
  336.    magic: pchar = '$1$';
  337.  var
  338.    sp: string;
  339.    ctx, ctx1: MD5Context;
  340.    il: byte;
  341.    il2: integer;
  342.    Dig: MD5Digest;
  343.    DigPch: array [0..15] of char absolute Dig;
  344.    DW: DWord;
  345. begin
  346.   sp := Salt;
  348.   if 1 = Pos(magic, sp) then Delete(sp, 1 , 3);
  349. //  il := Pos('$', sp);
  350. // default using:
  351. //  if 8 < il then Delete(sp, 9, Length(sp)) else
  352. //    if il > 0 then Delete(sp, il, Length(sp));
  354. // Flash using:
  355.   if length(sp) < 2 then
  356.     begin
  357.       sp := '  ';
  358.       sp[1] := Char(Random(Length(itoa64)));
  359.       sp[2] := Char(Random(Length(itoa64)));
  360.     end else
  361.     begin
  362.       Delete(sp, 3, Length(sp)-2);
  363.     end;
  365.   MD5Init(ctx);
  366. MD5Update(ctx, pChar(Passw), length(Passw));
  367.   MD5Update(ctx, pChar(magic), length(magic));
  368.   MD5Update(ctx, pChar(sp), length(sp));
  370.   MD5Init(ctx1);
  371.   MD5Update(ctx1, pChar(Passw), length(Passw));
  372.   MD5Update(ctx1, pChar(sp), length(sp));
  373.   MD5Update(ctx1, pChar(Passw), length(Passw));
  374.   MD5Final(ctx1, Dig);
  376.   il2 := length(Passw);
  377.   While il2 > 0 do
  378.     begin
  379.       if il2>16
  380.         then MD5Update(ctx, DigPCh, 16)
  381.         else MD5Update(ctx, DigPCh, il2);
  382.        dec(il2, 16);
  383.     end;
  385.   FillChar(Dig, 16, 0); 
  386.   il := length(passw);
  387.   While il > 0 do
  388.    begin
  389. if (il and 1) = 1 then
  390.     MD5Update(ctx, #0, 1)
  391. else
  392.     MD5Update(ctx, pchar(passw), 1);
  393.     il := il shr 1;
  394.    end;
  396. MD5Final(ctx, Dig);
  397.   Move(Dig, DigPCh, 16);
  399.   for il2:=0 to 999 do
  400.   begin
  401.     MD5Init(ctx1);
  402.     if (il2 and 1) = 1 then
  403.        MD5Update(ctx1, PChar(passw), length(passw))
  404.       else
  405.        MD5Update(ctx1, DigPCh, 16);
  407.     if (il2 mod 3) > 0
  408.       then
  409.        MD5Update( ctx1, PChar(sp), length(sp));
  411.     if (il2 mod 7) > 0
  412.       then
  413.        MD5Update( ctx1, PChar(passw), length(passw));
  415.     if (il2 and 1) = 1
  416.       then
  417.         MD5Update(  ctx1, DigPCh, 16)
  418.       else
  419.         MD5Update(  ctx1, PChar(passw), length(passw));
  420.     MD5Final(ctx1, Dig);
  421.   end;
  424.   DW := (Dig[0] shl 16) or (Dig[6] shl 8) or Dig[12];
  425.   Result := crypt_to64(DW, 4);
  426.   DW := (Dig[1] shl 16) or (Dig[7] shl 8) or Dig[13];
  427.   Result := Result + crypt_to64(DW, 4);
  428.   DW := (Dig[2] shl 16) or (Dig[8] shl 8) or Dig[14];
  429.   Result := Result + crypt_to64(DW, 4);
  430.   DW := (Dig[3] shl 16) or (Dig[9] shl 8) or Dig[15];
  431.   Result := Result + crypt_to64(DW, 4);
  432.   DW := (Dig[4] shl 16) or (Dig[10] shl 8) or Dig[5];
  433.   Result := Result + crypt_to64(DW, 4);
  434.   DW := Dig[11];
  435.   Result := Result + crypt_to64(DW, 2);
  437.   Result := magic + sp + '$' + Result;
  438. end;
  440. // Compare two Digests
  441. function MD5Match(D1, D2: MD5Digest): boolean;
  442. var
  443. I: byte;
  444. begin
  445. I := 0;
  446. Result := TRUE;
  447. while Result and (I < 16) do begin
  448. Result := D1[I] = D2[I];
  449. inc(I);
  450. end;
  451. end;
  453. end.