Delphi md5 UTF8 ANSI

Запись от Alex_pac размещена 23.07.2012 в 01:39

Показов 15752 Комментарии 9

Метки delphi

модуль для расчета MD5

кодировки UTF8 ANSI

протестирован : delphi 7, 10, 15 XE . Результаты расчета идентичны php md5

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
unit md5Hash;
 
// Optimized version MD5 by Shade & Arigato, 2005.
// repack by Alex_pac 2012
 
interface
 
uses Windows, SysUtils;
 
function md5UTF8 (buf: UTF8String): AnsiString;
function md5 (buf: AnsiString): AnsiString;
 
implementation
 
type
  tdata = array [0..15] of DWORD;
  tcur = array[0..3] of DWord;
 
var HEX: array[Word] of AnsiString;
 
function LRot32 (a, b: LongWord): LongWord;
asm
  mov  ecx, edx
  rol  eax, cl
end; {func LRot32}
 
procedure md5calculate(var A, B, C, D: DWord; var data: tdata; var CurrentHash: tcur);
begin
  CurrentHash[0] := $67452301;
  CurrentHash[1] := $efcdab89;
  CurrentHash[2] := $98badcfe;
  CurrentHash[3] := $10325476;
 
  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);
end;
 
function md5 (buf: AnsiString): AnsiString;
type
  pint = ^Integer;
  tbyte = array [0..15] of byte;
  //tdata = array [0..15] of DWORD;
  pdata = ^tdata;
  pbyte = ^tbyte;
var
  i, Len: Integer;
  data: pdata;
  CurrentHash: tcur;
  P: array[0..7] of Word absolute CurrentHash;
  A, B, C, D: DWord;
begin
  Len := Length (buf);
  SetLength (buf, 64);
  buf[Len+1] := #$80;
  FillChar (buf[Len+2], 63 - Len, 0);
  pint (@buf[57])^ := Len * 8;
 
  data := addr (buf[1]);
 
  md5calculate(a,b,c,d,data^,CurrentHash);
 
  Result := HEX[P[0]];
  for i := 1 to 7 do
    Result := Concat (Result, HEX[P[i]]);
end; {func md5}
 
function md5UTF8 (buf: UTF8String): AnsiString;
type
  pint = ^Integer;
  tbyte = array [0..15] of byte;
  //tdata = array [0..15] of DWORD;
  pdata = ^tdata;
  pbyte = ^tbyte;
var
  i, Len: Integer;
  data: pdata;
  CurrentHash: tcur;
  P: array[0..7] of Word absolute CurrentHash;
  A, B, C, D: DWord;
begin
  {$IFDEF UNICODE}{$ELSE}
  buf:= UTF8ToAnsi(buf);
  {$EndIf}
  Len := Length (buf);
  SetLength (buf, 64);
  buf[Len+1] := #$80;
  FillChar (buf[Len+2], 63 - Len, 0);
  pint (@buf[57])^ := Len * 8;
 
  data := addr (buf[1]);
 
  md5calculate(a,b,c,d,data^,CurrentHash);
 
  Result := HEX[P[0]];
  for i := 1 to 7 do
    Result := Concat (Result, HEX[P[i]]);
end; {func md5}
 
var DEC, Tmp: Integer;
    LH: string;
 
initialization
 
for DEC := 0 to $ffff do
begin
  Tmp := DEC and $ff;
  LH := IntToHex (Tmp, 2);
  Tmp := DEC shr 8;
  HEX[DEC] := Concat (LH, IntToHex (Tmp, 2));
end; {for}
 
end.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
// пример кода, код совместим c delphi 7,10,15
procedure TForm1.Button1Click(Sender: TObject);
begin
  edit1.Text:=md5UTF8(trim(memo1.Text));
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  edit1.Text:=md5(trim(memo1.Text));
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Text:='hello worldя';
end;

Нажмите на изображение для увеличения
Название: Безымянный.png
Просмотров: 1354
Размер: 24.0 Кб
ID: 998

delphi_md5.zip << скачать пример

Метки delphi

Размещено в Без категории

« Delphi запуск JavaScript [jsWebBrowser 3] Главная страница Delphi генератор TList списков »

Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.

Всего комментариев 9

Комментарии

	Автору респект)))) Исходник забираю)))):)
	Запись от БогДелфей размещена 27.07.2012 в 01:23

	Спасибо!
	Запись от MrOnlineCoder размещена 23.07.2013 в 19:42

	Спасибо
	Запись от srgSoft размещена 04.01.2016 в 16:56

В delphi 7, 10, 15 XE

Мм это вы про какие версии?
В новых версиях можно использовать IdHashMessageDigest

Запись от Avazart размещена 04.01.2016 в 18:53 Avazart вне форума

	а попробуйте стандартными функциями посчитать хеш от строки в кириллице
	Запись от srgSoft размещена 04.01.2016 в 19:09

Ну и нормально работает:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
uses
  IdGlobal,  // TIdTextEncoding
  IdHashMessageDigest;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  IdHashMessageDigest5: TIdHashMessageDigest5;
  Md5: String;
begin
  IdHashMessageDigest5 := TIdHashMessageDigest5.Create;
  try
    Md5 := IdHashMessageDigest5.HashStringAsHex(
       'Привет мир!',
       TIdTextEncoding.UTF8);
 
    ShowMessage(Md5);
  finally
    FreeAndNil(IdHashMessageDigest5);
  end;
end;

Для проверки http://www.md5.cz/

Скриншот

Запись от Avazart размещена 04.01.2016 в 19:47 Avazart вне форума

	IdHashMessageDigest5 не захотел считать сигнатуру для подписи обращения АПИ ОК вот я и полез искать варианты. если без кириллицы ок а с кириллицей лажа инвалид сигнатуре и хоть ты в него стреляй. Но вопрос уже решенный
	Запись от srgSoft размещена 04.01.2016 в 19:50

IdHashMessageDigest5 не захотел считать сигнатуру

Может у него был обеденный перерыв?

Запись от Avazart размещена 04.01.2016 в 20:03 Avazart вне форума

Добавляем в разделе

Delphi
1
uses ... idHashMessageDigest ;

затем

Delphi
1
2
3
var
  // функция получения МД5 хэш суммы из логина и пароля
  function md5Hash(str1, str2: string):string;

создаём саму функцию

Delphi
1
2
3
4
5
6
7
8
9
10
11
function md5Hash(str1, str2: string):string;
var
  str: string;
begin
  result := '';
  str := str1+ str2;
  with TIdHashMessageDigest5.Create
  do begin
    Result := AnsiLowerCase(AsHex(HashValue(str)));
  end;
end;

и вызываем функцию с передачей в неё нужных строк

Запись от ste1n88 размещена 11.12.2019 в 11:37 ste1n88 вне форума

Новые блоги и статьи Все статьи Все блоги /
Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .	Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм anaschu 30.08.2026 Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .

Сообщение форума

Отменить изменения