Последние записи
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
- wprintf как напечатать кириллицу
- Взаимодействие через командную строку
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
16th
Сен
SHA1-хеширование, реализация на Delphi
Posted by obzor under Delphi, Архив
Мне понадобилось хешировать некоторый текст методом SHA1 (не будем вдаваться в подробности). Для этого я стал искать примеры реализации на Delphi. И нашел… Код я, как смог, доработал (заработал в Delphi 2010, правильный хеш пустой строки).
unit sha1hash;
interface
uses sysutils;
const
HC0 = $67452301;
HC1 = $EFCDAB89;
HC2 = $98BADCFE;
HC3 = $10325476;
HC4 = $C3D2E1F0;
K1 = $5A827999;
K2 = $6ED9EBA1;
K3 = $8F1BBCDC;
K4 = $CA62C1D6;
var
H0, H1, H2, H3, H4: integer;
function sha1(z: RawByteString): string;
implementation
function rol(const x: integer; const y: byte): integer;
// сдвиг числа x на y бит влево
begin
asm
mov eax,x
mov cl, y
rol eax,cl
mov x, eax
end;
Result := x;
end;
procedure INIT; // Инициализация - присвоить переменным значения констант
begin
H0 := HC0; // $67452301;
H1 := HC1; // $EFCDAB89;
H2 := HC2; // $98BADCFE;
H3 := HC3; // $10325476;
H4 := HC4; // $C3D2E1F0;
end;
// добавление одного бита (1000000=128) и добавление нулей до кратности 64 байтам
function PADDING(S: RawByteString; FS: integer): RawByteString;
var
size, i: integer;
begin
size := Length(S) * 8; // size -входной размер в битах
S := S + #$80; // добавление одного бита (1000000=128)
while (Length(S) mod 64) <> 0 do
S := S + #0; // добавление нулей до кратности 64 байтам
IF ((size mod 512) >= 448) then // если хвост превышает 48 байт то добавить пустой блок из 64 нулей
begin
S := S + #0; // добавление нулей до кратности 64
while (Length(S) mod 64) <> 0 do
S := S + #0;
end;
i := Length(S);
size := FS * 8;
while size > 0 do // запись в конец строки её размер
begin
S := ansichar(byte(size)); // получение младшего байта
size := size shr 8; // сдвиг вправо на 8 бит - перенос старшего байта на место младшего
i := i - 1;
end;
Result := S;
end;
Procedure START(const S_IN: RawByteString);
var
A, B, C, D, E, TEMP: integer;
t, i: byte;
W: array [0 .. 79] of integer;
begin
t := 1;
for i := 1 to ((Length(S_IN)) div 4) do
begin
W := (ord(S_IN[t]) shl 24) + (ord(S_IN[t + 1]) shl 16) +
(ord(S_IN[t + 2]) shl 8) + ord(S_IN[t + 3]);
t := t + 4;
end;
For t := 16 to 79 do
W[t] := rol(W[t - 3] XOR W[t - 8] XOR W[t - 14] XOR W[t - 16], 1);
A := H0;
B := H1;
C := H2;
D := H3;
E := H4;
for t := 0 to 19 do
begin
TEMP := rol(A, 5) + ((B AND C) OR ((NOT B) AND D)) + E + K1 + W[t];
E := D;
D := C;
C := rol(B, 30);
B := A;
A := TEMP;
end;
for t := 20 to 39 do
begin
TEMP := rol(A, 5) + (B XOR C XOR D) + E + K2 + W[t];
E := D;
D := C;
C := rol(B, 30);
B := A;
A := TEMP;
end;
for t := 40 to 59 do
begin
TEMP := rol(A, 5) + ((B AND C) OR (B AND D) OR (C AND D)) + E + K3 + W[t];
E := D;
D := C;
C := rol(B, 30);
B := A;
A := TEMP;
end;
for t := 60 to 79 do
begin
TEMP := rol(A, 5) + (B XOR C XOR D) + E + K4 + W[t];
E := D;
D := C;
C := rol(B, 30);
B := A;
A := TEMP;
end;
H0 := A + H0;
H1 := B + H1;
H2 := C + H2;
H3 := D + H3;
H4 := E + H4;
end;
function min(A, B: integer): integer;
begin
Result := (-abs(A - B) + A + B) div 2;
end;
function sha1(z: RawByteString): string;
var
S, s1: RawByteString;
i, L, FS: integer;
begin
S := '';
FS := Length(z);
INIT;
repeat
L := min(65536, Length(z));
S := copy(z, 1, L);
delete(z, 1, L);
IF ((L < 65536) and (L > 0)) then
begin
s1 := PADDING(S, FS);
i := 1;
L := Length(s1);
while i < L do
begin
START(copy(s1, i, 64));
i := i + 64;
end;
end;
if L = 0 then
begin
s1 := PADDING(S, FS);
START(copy(s1, 1, 64));
end;
IF L = 65536 then
begin
i := 1;
L := Length(s1);
while i < L do
begin
START(copy(s1, i, 64));
i := i + 64;
end;
end;
until Length(z) = 0;
Result := IntToHex(H0, 8) + IntToHex(H1, 8) + IntToHex(H2, 8) + IntToHex(H3,
8) + IntToHex(H4, 8);
end;
end.
Случайные статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)