ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / BASE64-HMAC-SHA384
66 сообщений из 66, показаны все 3 страниц
  все  
BASE64-HMAC-SHA384
    #39500075
Barney83
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Barney83
Гость
Необходимо очень получить хэш строки, данным алгоритмом
есть куча примеров SHA 256,512, но не 384.
Кто-нибудь реализовывал или есть алгоритм?
...
Рейтинг: 0 / 0
04.08.2017, 09:02:14
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500091
Фотография krapotkin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
krapotkin
Участник
http://docwiki.embarcadero.com/Libraries/Tokyo/en/System.Hash.THashSHA2

http://www.cityinthesky.co.uk/opensource/dcpcrypt/
...
Рейтинг: 0 / 0
04.08.2017, 09:28:17
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500093
Фотография DarkMaster
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DarkMaster
Участник
Barney83,

http://torry.net/authorsmore.php?id=1500 - старая добрая DCPCrypt
https://github.com/paolo-rossi/delphi-jose-jwt/blob/master/Source/Common/JOSE.Hashing.HMAC.pas - или тут смотри
...
Рейтинг: 0 / 0
04.08.2017, 09:29:54
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500097
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
Barney83Кто-нибудь реализовывал или есть алгоритм?
Я недавно нашел хороший алгоритм hmac, использующий виндовое криптоапи, подправил и перевел на паскаль. Реально работает хорошо.
 
Код: pascal
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.
var
  g_nLastCryptError: DWORD = 0;
  g_strLastCryptErrorFunction: String = '';

function HMAC_COMMON( const K; KLen: Integer; const M; MLen: Integer; HashAlgorithm: ALG_ID; out Mac; MacLen: DWORD ): Boolean;

  procedure UpdateLastError( const SFunction: String );
  begin
    g_nLastCryptError := GetLastError;
    g_strLastCryptErrorFunction := SFunction;
  end;

const
  BLOCK_SIZE = 64;
var
  i_key_pad: Array[ 0 .. BLOCK_SIZE - 1 ] of Byte;
  o_key_pad: Array[ 0 .. BLOCK_SIZE - 1 ] of Byte;

  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  len, cb, i: ULONG;
  f: BOOL;
  lpkeyhash1, lpkeyhash2, lpkey: PAnsiChar;
  c: Byte;
begin
  g_nLastCryptError := 0;
  lpkeyhash1 := nil;
  lpkeyhash2 := nil;

  f := CryptAcquireContext( @hProv, nil, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT or CRYPT_SILENT );
  if f then begin
    len := KLen;
    if len > BLOCK_SIZE then begin
      f := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
      if f then begin
        cb := sizeof( len );
        f := CryptHashData( hHash, @K, len, 0 ) and
             CryptGetHashParam( hHash, HP_HASHSIZE, @len, @cb, 0 );
        if f then begin
          GetMem( lpkeyhash1, len );
          f := CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash1 ), @len, 0 );
          if not f then
            UpdateLastError( 'CryptGetHashParam(HP_HASHVAL) (1)' );
        end else
          UpdateLastError( 'CryptHashData/CryptGetHashParam(HP_HASHSIZE)' );

        CryptDestroyHash( hHash );
      end else
        UpdateLastError( 'CryptCreateHash (1)' );
    end;

    if f then begin
      if Assigned( lpkeyhash1 ) then
        lpkey := lpkeyhash1
      else
        lpkey := @K;

      i := BLOCK_SIZE;
      repeat
        Dec( i );
        if i < len then
          c := Byte( lpkey[ i ] )
        else
          c := 0;

        i_key_pad[ i ] := $36 xor c;
        o_key_pad[ i ] := $5c xor c;
      until i = 0;

      f := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
      if f then begin
        cb := sizeof( len );
        f := CryptHashData( hHash, @i_key_pad, sizeof(i_key_pad), 0 ) and
             CryptHashData( hHash, @M, MLen, 0 ) and
             CryptGetHashParam( hHash, HP_HASHSIZE, @len, @cb, 0 );
        if f then begin
          GetMem( lpkeyhash2, len );
          f := CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash2 ), @len, 0 );
          if not f then
            UpdateLastError( 'CryptGetHashParam(HP_HASHVAL) (2)' );
        end else
          UpdateLastError( 'CryptHashData/CryptHashData/CryptGetHashParam(HP_HASHSIZE)' );

        CryptDestroyHash(hHash);

        if f then begin
          f := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
          if f then begin
            f := CryptHashData( hHash, @o_key_pad, sizeof( o_key_pad ), 0 ) and
                 CryptHashData( hHash, PByte( lpkeyhash2 ), len, 0 ) and
                 CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash2 ), @len, 0 );
            if not f then
              UpdateLastError( 'CryptHashData/CryptHashData/CryptGetHashParam(HP_HASHVAL)' );

            CryptDestroyHash(hHash);

            if f and ( len = MacLen ) then
              Move( lpkeyhash2^, Mac, len )
            else begin
              SetLastError( ERROR_INVALID_BLOCK );
              UpdateLastError( 'len != MacLen' );
            end;
          end else
            UpdateLastError( 'CryptCreateHash (3)' );
        end;
      end else
        UpdateLastError( 'CryptCreateHash (2)' );
    end;

    CryptReleaseContext( hProv, 0 );
  end else
    UpdateLastError( 'CryptAcquireContext' );

  if Assigned( lpkeyhash1 ) then
    FreeMem( lpkeyhash1 );

  if Assigned( lpkeyhash2 ) then
    FreeMem( lpkeyhash2 );

  Result := f;
end;


(переменые ошибое - для отладки, в принципе уже вроде не нужны)
Передай туда нужный алгоритм шифрования и результат с длиной, например, так:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
type
  THMAC_SHA256_DATA = packed array[ 0 .. 31 ] of Byte;

function HMAC_SHA256( const Key, Text: AnsiString; out ResHash: THMAC_SHA256_DATA ): Boolean;
begin
  Result := HMAC_COMMON( Pointer( Key )^, Length( Key ), Pointer( Text )^, Length( Text ), CALG_SHA256, ResHash, sizeof( ResHash ) );
end;



А затем - загони результат в Base64 например так:
 
Код: pascal
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.
function EncodeBase64( Value: AnsiString ): AnsiString;
const
  b64alphabet: PAnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  pad: PAnsiChar = '====';

  function EncodeChunk(const Chunk: String): String;
  var
    W: LongWord;
    i, n: Byte;
  begin
    n := Length(Chunk); W := 0;
    for i := 0 to n - 1 do
      W := W + Ord(Chunk[i + 1]) shl ((2 - i) * 8);
    Result := b64alphabet[(W shr 18) and $3f] +
              b64alphabet[(W shr 12) and $3f] +
              b64alphabet[(W shr 06) and $3f] +
              b64alphabet[(W shr 00) and $3f];
    if n <> 3 then
      Result := Copy(Result, 0, n + 1) + Copy(pad, 0, 3 - n);   //add padding when out len isn't 24 bits
  end;

var
  i, nLen, nEndLen: Integer;

begin
  Result := '';
  while Length(Value) > 0 do
  begin
    Result := Result + EncodeChunk(Copy(Value, 0, 3));
    Delete(Value, 1, 3);
  end;
end;



Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
type
  THMAC_SHA256_DATA = packed array[ 0 .. 31 ] of Byte;

function HMAC_SHA256_AsBase64( const Key, Text: AnsiString ): AnsiString;
var
  ResHash: THMAC_SHA256_DATA;
begin
  Result := '';
  if HMAC_COMMON( Pointer( Key )^, Length( Key ), Pointer( Text )^, Length( Text ), CALG_SHA256, ResHash, sizeof( ResHash ) ) then begin
    SetString( Result, PAnsiChar( @ResHash ), sizeof( ResHash ) );
    Result := EncodeBase64( Result );
  end;
end;



тебе понадобится Wcrypt2.pas найти в интернете и возможно константы алгоритмов типа CALG_SHA_384 (все они есть в мсдн).

Да, начиная от CALG_SHA_256 не всякая WinXP поддерживает эти алгоритмы.
...
Рейтинг: 0 / 0
04.08.2017, 09:34:51
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500099
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
Да, я это тестил на d6 и fpc 3.0.2 для win32/i386 и win64/x86_64
...
Рейтинг: 0 / 0
04.08.2017, 09:36:19
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500120
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Еще докину пару ссылок:
https://github.com/fundamentalslib/fundamentals4
https://github.com/fundamentalslib/fundamentals5

SHA384 в 5й версии точно есть, правда без HMAC.
HMACи есть только для SHA1/256/512.

См. Source/Utils/flcHash.pas
...
Рейтинг: 0 / 0
04.08.2017, 10:02:46
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500122
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
YuRock,

Код: pascal
1.
2.
3.
4.
5.
  while Length(Value) > 0 do
  begin
    Result := Result + EncodeChunk(Copy(Value, 0, 3));
    Delete(Value, 1, 3);
  end;


Боюсь даже подумать, с какой скоростью это будет тормозить работать.
...
Рейтинг: 0 / 0
04.08.2017, 10:05:28
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500134
Barney83
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Barney83
Гость
YuRock,

Можно работающий код?
...
Рейтинг: 0 / 0
04.08.2017, 10:30:37
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500173
Фотография krapotkin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
krapotkin
Участник
а чем не подошел родной код из первой ссылки?
...
Рейтинг: 0 / 0
04.08.2017, 11:07:28
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500183
Barney83
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Barney83
Гость
krapotkin,

не компилируется, нахватает каких-то файлов и т.д.
...
Рейтинг: 0 / 0
04.08.2017, 11:22:23
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500190
Фотография krapotkin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
krapotkin
Участник
ладно. намек не заходит.
тогда прямой вопрос. версию делфи может раскроете?
потому что начиная вроде с сиэттла в делфи есть родной модуль с SHA2 хэшем
...
Рейтинг: 0 / 0
04.08.2017, 11:26:30
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500191
Barney83
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Barney83
Гость
krapotkin,

Embarcadero® RAD Studio XE Version 15.0.3953.35171
...
Рейтинг: 0 / 0
04.08.2017, 11:28:30
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500206
Фотография krapotkin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
krapotkin
Участник
тогда DCPCrypt должен работать
...
Рейтинг: 0 / 0
04.08.2017, 11:48:32
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500213
Barney83
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Barney83
Гость
krapotkin,

HMAC там нет
...
Рейтинг: 0 / 0
04.08.2017, 11:54:16
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500218
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
Barney83YuRock,

Можно работающий код?
Я дал работающий код.
...
Рейтинг: 0 / 0
04.08.2017, 12:00:45
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500220
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
alekcvpYuRock,

Код: pascal
1.
2.
3.
4.
5.
  while Length(Value) > 0 do
  begin
    Result := Result + EncodeChunk(Copy(Value, 0, 3));
    Delete(Value, 1, 3);
  end;



Боюсь даже подумать, с какой скоростью это будет тормозить работать.
Да, ужас, но мне не надо было быстродействия в этой ф-ции пока-что. Я её "скачал не смотря", протестировал на глаз и всё.
...
Рейтинг: 0 / 0
04.08.2017, 12:01:56
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500223
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
YuRockBarney83YuRock,

Можно работающий код?
Я дал работающий код.
Единственное, в EncodeBase64 (которую я в качестве примера дал) надо все String заменить на AnsiString, раз у тебя дельфя юникодная.
...
Рейтинг: 0 / 0
04.08.2017, 12:04:12
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500227
Barney83
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Barney83
Гость
YuRock,

ALG_ID это что за тип данных, не хватает явно каких-то модулей еще
...
Рейтинг: 0 / 0
04.08.2017, 12:08:09
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500231
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
Barney83,

он определен в Wcrypt2.pas
Могу дать свой, но не факт, что он у тебя скомпилится
...
Рейтинг: 0 / 0
04.08.2017, 12:12:19
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500234
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
Barney83,

И еще, возможно, для алгоритмов > SHA256 надо константу BLOCK_SIZE изменить с 64 на 80.
...
Рейтинг: 0 / 0
04.08.2017, 12:13:47
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500418
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
YuRock,

У меня вот так реализована, работает очень быстро 1.178297 сек на процессоре 2009г - E3300 (1M Cache, 2.50 GHz, 800 MHz FSB)

 

Код: pascal
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.
function base64_encode(str: string): string;
const
  table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  PArrayChars = ^TArrayChars;
  TArrayChars = array of char;
var
  len, i, r: Integer;
  a, b: Byte;
  Sum: Cardinal;
begin
  len := Length(str);

  SetLength(Result, ((len + 2) div 3) * 4);

  i := 0;
  r := 0;
  while i <= len - 3 do
  begin
    Sum := WORD(str[i + 1]) shl 16 + WORD(str[i + 2]) shl 8 + WORD(str[i + 3]);

    PArrayChars(@Result)^[r + 0] := table[Sum shr 18 and $3F];
    PArrayChars(@Result)^[r + 1] := table[Sum shr 12 and $3F];
    PArrayChars(@Result)^[r + 2] := table[Sum shr 6 and $3F];
    PArrayChars(@Result)^[r + 3] := table[Sum and $3F];

    inc(i, 3);
    inc(r, 4);
  end;

  case len mod 3 of
    1:
      begin
        a := WORD(str[len]) and $FF;
        PArrayChars(@Result)^[r + 0] := table[a SHR 2];
        PArrayChars(@Result)^[r + 1] := table[a and 3 SHL 4];
        PArrayChars(@Result)^[r + 2] := '=';
        PArrayChars(@Result)^[r + 3] := '=';
      end;
    2:
      begin
        a := WORD(str[i + 1]) and $FF;
        b := WORD(str[i + 2]) and $FF;
        PArrayChars(@Result)^[r + 0] := table[a SHR 2];
        PArrayChars(@Result)^[r + 1] := table[((a and 3) SHL 4) or (b SHR 4)];
        PArrayChars(@Result)^[r + 2] := table[b and $0F SHL 2];
        PArrayChars(@Result)^[r + 3] := '=';
      end;
  end;
end;


...
Рейтинг: 0 / 0
04.08.2017, 17:14:18
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500419
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
Забыл приложить как тестил на скорость

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
    if ZStartTime(startTime) then
    begin
      for i := 0 to 10000000 do
      begin
        base64_encode('HytujkyHytujkyukHytujkyukuk');
      end;
      Writeln(ZStopTime(startTime));
    end;
...
Рейтинг: 0 / 0
04.08.2017, 17:15:08
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500420
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
Сейчас заметил кое что, чем меня уже пинали на форуме...

Добавляем const
 

function base64_encode(const str: string): string;



И результаты уже - 0.930440 sec.

Не за что бы не залез и не увидел, если бы не ты
...
Рейтинг: 0 / 0
04.08.2017, 17:18:07
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500425
няша
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
няша
Гость
НяшикНе за что бы не залез и не увидел, если бы не ты
...
Рейтинг: 0 / 0
04.08.2017, 17:28:36
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500427
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
няша,

И причём тут это?. Это уже спам.
...
Рейтинг: 0 / 0
04.08.2017, 17:30:46
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500433
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
[quot Няшик]Забыл приложить как тестил на скорость
А где исходники ZStartTime и ZStopTime?
...
Рейтинг: 0 / 0
04.08.2017, 17:43:35
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500437
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvp,

Извиняюсь что не приложил. Вот полный исходный код, проект консольного приложения, + включить в настройках проекта галочку оптимизации


 

Код: pascal
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.
program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  windows, System.SysUtils;

function memcmp(ptr1: PAnsiChar; ptr2: PAnsiChar; num: DWORD): Integer; cdecl;
  external 'Ntdll.dll' name 'memcmp';

function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs;
  external 'msvcrt.dll';

function ZStartTime(var StartTime: Int64): Boolean;
begin
  Result := QueryPerformanceCounter(StartTime);
end;

function ZStopTime(const StartTime: Int64): AnsiString;
var
  iCounterPerSec, StopTime: Int64;
  time: Single;
begin
  if QueryPerformanceCounter(StopTime) then
  begin
    if QueryPerformanceFrequency(iCounterPerSec) then
    begin

      time := (0 - StartTime + StopTime) / iCounterPerSec;

      Result := '';
      SetLength(Result, 25);

      SetLength(Result, sprintf(PAnsiChar(Result), 'Result: %f sec.', time));
    end
    else
      Result := 'Error[ZStopTime(QueryPerformanceFrequency)]';
  end
  else
    Result := 'Error[ZStopTime(QueryPerformanceCounter)]';
end;

function base64_encode(const str: string): string;
const
  table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  PArrayChars = ^TArrayChars;
  TArrayChars = array of char;
var
  len, i, r: Integer;
  a, b: Byte;
  Sum: Cardinal;
begin
  len := Length(str);

  SetLength(Result, ((len + 2) div 3) * 4);

  i := 0;
  r := 0;
  while i <= len - 3 do
  begin
    Sum := WORD(str[i + 1]) shl 16 + WORD(str[i + 2]) shl 8 + WORD(str[i + 3]);

    PArrayChars(@Result)^[r + 0] := table[Sum shr 18 and $3F];
    PArrayChars(@Result)^[r + 1] := table[Sum shr 12 and $3F];
    PArrayChars(@Result)^[r + 2] := table[Sum shr 6 and $3F];
    PArrayChars(@Result)^[r + 3] := table[Sum and $3F];

    inc(i, 3);
    inc(r, 4);
  end;

  case len mod 3 of
    1:
      begin
        a := WORD(str[len]) and $FF;
        PArrayChars(@Result)^[r + 0] := table[a SHR 2];
        PArrayChars(@Result)^[r + 1] := table[a and 3 SHL 4];
        PArrayChars(@Result)^[r + 2] := '=';
        PArrayChars(@Result)^[r + 3] := '=';
      end;
    2:
      begin
        a := WORD(str[i + 1]) and $FF;
        b := WORD(str[i + 2]) and $FF;
        PArrayChars(@Result)^[r + 0] := table[a SHR 2];
        PArrayChars(@Result)^[r + 1] := table[((a and 3) SHL 4) or (b SHR 4)];
        PArrayChars(@Result)^[r + 2] := table[b and $0F SHL 2];
        PArrayChars(@Result)^[r + 3] := '=';
      end;
  end;
end;

var
  i: Cardinal;
  StartTime: Int64;

begin
  try
    Writeln(base64_encode('HytujkyHytujkyukHytujkyukuk'));
    if ZStartTime(StartTime) then
    begin
      for i := 0 to 10000000 do
      begin
        base64_encode('HytujkyHytujkyukHytujkyukuk');
      end;
      Writeln(ZStopTime(StartTime));
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.




Выдаёт даже 0.926001 это 280000000 символов на моём то железе. Результаты более чем хорошие
...
Рейтинг: 0 / 0
04.08.2017, 17:53:57
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500486
Barney83
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Barney83
Гость
YuRock,

Не работает пример, валится на
UpdateLastError( 'CryptCreateHash (2)' );


Для алгоритма SHA_384 использовал
const
CALG_SHA_384 = $0000800d;
type
THMAC_SHA384_DATA = packed array[ 0 .. 47 ] of Byte;

procedure TForm6.FormCreate(Sender: TObject);
var
MyData : THMAC_SHA384_DATA;
begin
..
if HMAC_SHA384('MyString','MyKey',MyData) then
..
end;


Может у кого есть dll с другого языка?
...
Рейтинг: 0 / 0
04.08.2017, 19:03:26
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500493
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Няшик,

Я так понимаю, у тебя не Unicode delphi, да? Иначе если ему на вход передать строку с русскими символами, то он неправильно её обрабатывает.
...
Рейтинг: 0 / 0
04.08.2017, 19:10:01
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500510
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvpНяшик,

Я так понимаю, у тебя не Unicode delphi, да? Иначе если ему на вход передать строку с русскими символами, то он неправильно её обрабатывает.

Тоже интеесно чего это он. Ввёл 1 русский символ П, и запустил. На строке

Код: pascal
1.
        a := WORD(str[len]);



Вывел 31 хотя код соответствует 207 ... Следовательно это косяк редактора среды.

У меня Токио.
...
Рейтинг: 0 / 0
04.08.2017, 19:53:47
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500511
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Няшик,

Дело не в этом, а в
Код: pascal
1.
Sum := WORD(str[i + 1]) shl 16 + WORD(str[i + 2]) shl 8 + WORD(str[i + 3]);

в этой строке тупо переполнение будет, т.к. 3 символа - это 6 (шесть) байт, а не 3. И никак ты их в три байта не загонишь без потерь, хоть тресни.
...
Рейтинг: 0 / 0
04.08.2017, 19:56:30
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500512
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Няшик,

Попробуй какой-нибудь файл своей функцией закодировать и ты поймешь о чём я.
...
Рейтинг: 0 / 0
04.08.2017, 19:58:21
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500523
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикТоже интеесно чего это он. Ввёл 1 русский символ П, и запустил. На строке

Код: pascal
1.
        a := WORD(str[len]);


Вывел 31 хотя код соответствует 207 ... Следовательно это косяк редактора среды.
У меня Токио.
А 'a' - это какой тип?... Потому что русская "П" - это 0x041F, а 31 - это 0x1F. Улавливаешь? :)
...
Рейтинг: 0 / 0
04.08.2017, 20:20:19
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500549
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
white_nigger
Участник
alekcvpНяшик,

Я так понимаю, у тебя не Unicode delphi, да? Иначе если ему на вход передать строку с русскими символами, то он неправильно её обрабатывает.Ну чё пристал? Зато быстро! Быстро, Карл! (развелось оптимизаторов )))
...
Рейтинг: 0 / 0
04.08.2017, 22:19:35
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500555
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
white_niggerНу чё пристал? Зато быстро! Быстро, Карл! (развелось оптимизаторов )))
Хотите быстро и оптимизаций?... их есть у нас
 
x86 only

Код: pascal
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.
var
  B64Code: array [0..63] of AnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  B64Tail: AnsiChar = '=';
  
function Base64EncodedSize(InSize: Integer): Integer;
asm
  // вход:  eax - размер исходных данных
  // выход: eax - размер буфера, ecx - кол-во триплетов, edx - размер "хвоста"
  test  eax, eax
  jns   @@positive
  xor   eax, eax
@@positive:
  xor   edx, edx
  xor   ecx, ecx
  mov   cl, $03
  div   ecx
  mov   ecx, eax
  test  edx, edx
  jz    @@zerotail
  inc   eax
@@zerotail:
  shl   eax, 2
end;

function Base64Encode(Size: Integer; Source: Pointer; out Code: AnsiString): Boolean; register;
const
  MaxSize = MaxInt div 4 * 3;
asm
  cmp   eax, MaxSize
  jbe   @@proceed
  xor   eax, eax
  ret
@@proceed:
  push  ebp
  push  ebx
  push  edi
  push  esi
  push  ecx                            { « @Code }
  mov   esi, edx
  call  Base64EncodedSize
  mov   ebp, ecx
  xchg  eax, edx                       { edx = length, eax = tailsize }
  xchg  dword ptr [esp], eax           { @Code «» tailsize }
  xor   ecx, ecx                       { CodePage = 0 (System Default) }
  call  System.@LStrSetLength
  mov   edi, dword ptr [eax]
  lea   edx, B64Code
  test  ebp, ebp
  jz    @@tailpart
@@mainloop:
  movzx eax, byte ptr [esi]            { ax » 00000000 aaaaaaaa }
  mov   bh,  byte ptr [esi + 1]
  mov   bl,  byte ptr [esi + 2]        { bx » bbbbbbbb cccccccc }
  shl   eax, 8
  mov   al,  bh                        { ax » aaaaaaaa bbbbbbbb }
  mov   ecx, ebx                       { cx » bbbbbbbb cccccccc }
  lea   esi, [esi + 3]
  shr   ecx, 6                         { cx » 000000bb bbbbbbcc }
  and   ebx, $3F                       { bx » 00000000 00cccccc }
  and   ecx, $3F                       { cx » 000000bb 00bbbbcc }
  mov   cl,  [edx + ecx]
  mov   ch,  [edx + ebx]               { cx » 00cccccc 00bbbbcc }
@@halfblock:
  shr   eax, 4                         { ax » 0000aaaa aaaabbbb }
  mov   ebx, eax                       { bx » 0000aaaa aaaabbbb }
  and   eax, $3F                       { ax » 00000000 00aabbbb }
  shr   ebx, 6                         { bx » 00000000 00aaaaaa }
  shl   ecx, 16
  mov   ch,  [edx + eax]
  mov   cl,  [edx + ebx]               { cx » 00aabbbb 00aaaaaa }
  mov   [edi], ecx
  lea   edi, [edi + 4]
  dec   ebp
  jnz   @@mainloop
@@tailpart:
  pop   ecx                            { » размер хвоста }
  test  ecx, ecx
  jz    @@finalize
  push  $00                            { « размер хвоста = 0 }
  movzx eax, byte ptr [esi]            { ax » 00000000 aaaaaaaa }
  movzx ebx, byte ptr [B64Tail]        { bx » 00000000 ======== }
  shl   eax, 8                         { ax » aaaaaaaa 00000000 }
  dec   ecx
  jz    @@encode
  mov   bl, [esi + 1]                  { bx » 00000000 bbbbbbbb }
  mov   al, bl                         { ax » aaaaaaaa bbbbbbbb }
  shl   bl, 2                          { bx » 00000000 bbbbbb00 }
  and   bl, $3F                        { bx » 00000000 00bbbb00 }
  mov   bl, [edx + ebx]
@@encode:
  mov   ch, byte ptr [B64Tail]
  mov   cl, bl                         { cx » ======== 00bbbb00 или ======== ======== }
  inc   ebp
  jmp   @@halfblock
@@finalize:
  lea   eax, [ecx + 1]
  pop   esi
  pop   edi
  pop   ebx
  pop   ebp
end;


...
Рейтинг: 0 / 0
04.08.2017, 22:49:58
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500581
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvpwhite_niggerНу чё пристал? Зато быстро! Быстро, Карл! (развелось оптимизаторов )))
Хотите быстро и оптимизаций?... их есть у нас
 
x86 only

Код: pascal
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.
var
  B64Code: array [0..63] of AnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  B64Tail: AnsiChar = '=';
  
function Base64EncodedSize(InSize: Integer): Integer;
asm
  // вход:  eax - размер исходных данных
  // выход: eax - размер буфера, ecx - кол-во триплетов, edx - размер "хвоста"
  test  eax, eax
  jns   @@positive
  xor   eax, eax
@@positive:
  xor   edx, edx
  xor   ecx, ecx
  mov   cl, $03
  div   ecx
  mov   ecx, eax
  test  edx, edx
  jz    @@zerotail
  inc   eax
@@zerotail:
  shl   eax, 2
end;

function Base64Encode(Size: Integer; Source: Pointer; out Code: AnsiString): Boolean; register;
const
  MaxSize = MaxInt div 4 * 3;
asm
  cmp   eax, MaxSize
  jbe   @@proceed
  xor   eax, eax
  ret
@@proceed:
  push  ebp
  push  ebx
  push  edi
  push  esi
  push  ecx                            { « @Code }
  mov   esi, edx
  call  Base64EncodedSize
  mov   ebp, ecx
  xchg  eax, edx                       { edx = length, eax = tailsize }
  xchg  dword ptr [esp], eax           { @Code «» tailsize }
  xor   ecx, ecx                       { CodePage = 0 (System Default) }
  call  System.@LStrSetLength
  mov   edi, dword ptr [eax]
  lea   edx, B64Code
  test  ebp, ebp
  jz    @@tailpart
@@mainloop:
  movzx eax, byte ptr [esi]            { ax » 00000000 aaaaaaaa }
  mov   bh,  byte ptr [esi + 1]
  mov   bl,  byte ptr [esi + 2]        { bx » bbbbbbbb cccccccc }
  shl   eax, 8
  mov   al,  bh                        { ax » aaaaaaaa bbbbbbbb }
  mov   ecx, ebx                       { cx » bbbbbbbb cccccccc }
  lea   esi, [esi + 3]
  shr   ecx, 6                         { cx » 000000bb bbbbbbcc }
  and   ebx, $3F                       { bx » 00000000 00cccccc }
  and   ecx, $3F                       { cx » 000000bb 00bbbbcc }
  mov   cl,  [edx + ecx]
  mov   ch,  [edx + ebx]               { cx » 00cccccc 00bbbbcc }
@@halfblock:
  shr   eax, 4                         { ax » 0000aaaa aaaabbbb }
  mov   ebx, eax                       { bx » 0000aaaa aaaabbbb }
  and   eax, $3F                       { ax » 00000000 00aabbbb }
  shr   ebx, 6                         { bx » 00000000 00aaaaaa }
  shl   ecx, 16
  mov   ch,  [edx + eax]
  mov   cl,  [edx + ebx]               { cx » 00aabbbb 00aaaaaa }
  mov   [edi], ecx
  lea   edi, [edi + 4]
  dec   ebp
  jnz   @@mainloop
@@tailpart:
  pop   ecx                            { » размер хвоста }
  test  ecx, ecx
  jz    @@finalize
  push  $00                            { « размер хвоста = 0 }
  movzx eax, byte ptr [esi]            { ax » 00000000 aaaaaaaa }
  movzx ebx, byte ptr [B64Tail]        { bx » 00000000 ======== }
  shl   eax, 8                         { ax » aaaaaaaa 00000000 }
  dec   ecx
  jz    @@encode
  mov   bl, [esi + 1]                  { bx » 00000000 bbbbbbbb }
  mov   al, bl                         { ax » aaaaaaaa bbbbbbbb }
  shl   bl, 2                          { bx » 00000000 bbbbbb00 }
  and   bl, $3F                        { bx » 00000000 00bbbb00 }
  mov   bl, [edx + ebx]
@@encode:
  mov   ch, byte ptr [B64Tail]
  mov   cl, bl                         { cx » ======== 00bbbb00 или ======== ======== }
  inc   ebp
  jmp   @@halfblock
@@finalize:
  lea   eax, [ecx + 1]
  pop   esi
  pop   edi
  pop   ebx
  pop   ebp
end;





Уви, дорогой сэр. Это работает медленнее моего кода, плюс тоже не юникод. Сейчас обмозгую как его добавить в свой код, и скину пример
...
Рейтинг: 0 / 0
05.08.2017, 02:50:51
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500583
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
В общем вышло вот такое, правда уже не секунда. А целых 3.052310 секунды. Но за то поддержка юникода

 
Код: pascal
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.
program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  windows, System.SysUtils;

function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs;
  external 'msvcrt.dll';

function ZStartTime(var StartTime: Int64): Boolean;
begin
  Result := QueryPerformanceCounter(StartTime);
end;

function ZStopTime(const StartTime: Int64): AnsiString;
var
  iCounterPerSec, StopTime: Int64;
  time: Single;
begin
  if QueryPerformanceCounter(StopTime) then
  begin
    if QueryPerformanceFrequency(iCounterPerSec) then
    begin

      time := (0 - StartTime + StopTime) / iCounterPerSec;

      Result := '';
      SetLength(Result, 25);

      SetLength(Result, sprintf(PAnsiChar(Result), 'Result: %f sec.', time));
    end
    else
      Result := 'Error[ZStopTime(QueryPerformanceFrequency)]';
  end
  else
    Result := 'Error[ZStopTime(QueryPerformanceCounter)]';
end;

function base64_encode(const str: string): string;
const
  table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  PArrayChars = ^TArrayChars;
  TArrayChars = array of Char;
  TArrayBytes = array of Byte;
var
  len, i, r, j: Integer;
  f: TArrayBytes;
  c: PWideChar;
  bb: Char;
begin
  j := 0;
  r := 0;
  len := Length(str);

  SetLength(f, len * 3);

  c := Pointer(str);
  bb := c[0];
  while bb <> #0 do
  begin
    if WORD(bb) < 128 then
    begin
      f[j] := WORD(bb);
      inc(j);
    end
    else if WORD(bb) < 2048 then
    begin
      f[j] := ((WORD(bb) shr 6) or 192);
      f[j + 1] := ((WORD(bb) and 63) or 128);
      inc(j, 2);
    end
    else
    begin
      f[j] := (224 + (WORD(bb) shr 12));
      f[j + 1] := (128 + ((WORD(bb) shr 6) and 63));
      f[j + 2] := (128 + (WORD(bb) and 63));
      inc(j, 3);
    end;
    inc(r);
    bb := c[r];
  end;

  SetLength(Result, ((j + 2) div 3) * 4);

  i := 0;
  r := 0;
  while j >= 3 do
  begin
    PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
    PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
    PArrayChars(@Result)^[r + 2] := table[((f[i + 1] and 15) SHL 2) or (f[i + 2] SHR 6)];
    PArrayChars(@Result)^[r + 3] := table[f[i + 2] and 63];
    inc(i, 3);
    inc(r, 4);
    dec(j, 3);
  end;

  case j of
    1:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[f[i] and 3 SHL 4];
        PArrayChars(@Result)^[r + 2] := '=';
        PArrayChars(@Result)^[r + 3] := '=';
      end;
    2:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
        PArrayChars(@Result)^[r + 2] := table[f[i + 1] and $0F SHL 2];
        PArrayChars(@Result)^[r + 3] := '=';
      end;
  end;
end;

var
  i: Cardinal;
  StartTime: Int64;

begin
 // 0K7QvdC40LrQvtC0ISDOtc+Bzr/inaTinaTOtc+Bzr/inaQ=
  Writeln(base64_encode('Юникод! &#949;&#961;&#959;&#10084;&#10084;&#949;&#961;&#959;&#10084;'));

  try
    if ZStartTime(StartTime) then
    begin
      for i := 0 to 10000000 do
      begin
        base64_encode('HytujkyHytujkyukHytujkyukuk');
      end;
      Writeln(ZStopTime(StartTime));
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.

...
Рейтинг: 0 / 0
05.08.2017, 02:58:09
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500613
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
schi
Участник
НяшикВ общем вышло вот такое, правда уже не секунда. А целых 3.052310 секунды. Но за то поддержка юникода

 
Код: pascal
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.
program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  windows, System.SysUtils;

function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs;
  external 'msvcrt.dll';

function ZStartTime(var StartTime: Int64): Boolean;
begin
  Result := QueryPerformanceCounter(StartTime);
end;

function ZStopTime(const StartTime: Int64): AnsiString;
var
  iCounterPerSec, StopTime: Int64;
  time: Single;
begin
  if QueryPerformanceCounter(StopTime) then
  begin
    if QueryPerformanceFrequency(iCounterPerSec) then
    begin

      time := (0 - StartTime + StopTime) / iCounterPerSec;

      Result := '';
      SetLength(Result, 25);

      SetLength(Result, sprintf(PAnsiChar(Result), 'Result: %f sec.', time));
    end
    else
      Result := 'Error[ZStopTime(QueryPerformanceFrequency)]';
  end
  else
    Result := 'Error[ZStopTime(QueryPerformanceCounter)]';
end;

function base64_encode(const str: string): string;
const
  table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  PArrayChars = ^TArrayChars;
  TArrayChars = array of Char;
  TArrayBytes = array of Byte;
var
  len, i, r, j: Integer;
  f: TArrayBytes;
  c: PWideChar;
  bb: Char;
begin
  j := 0;
  r := 0;
  len := Length(str);

  SetLength(f, len * 3);

  c := Pointer(str);
  bb := c[0];
  while bb <> #0 do
  begin
    if WORD(bb) < 128 then
    begin
      f[j] := WORD(bb);
      inc(j);
    end
    else if WORD(bb) < 2048 then
    begin
      f[j] := ((WORD(bb) shr 6) or 192);
      f[j + 1] := ((WORD(bb) and 63) or 128);
      inc(j, 2);
    end
    else
    begin
      f[j] := (224 + (WORD(bb) shr 12));
      f[j + 1] := (128 + ((WORD(bb) shr 6) and 63));
      f[j + 2] := (128 + (WORD(bb) and 63));
      inc(j, 3);
    end;
    inc(r);
    bb := c[r];
  end;

  SetLength(Result, ((j + 2) div 3) * 4);

  i := 0;
  r := 0;
  while j >= 3 do
  begin
    PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
    PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
    PArrayChars(@Result)^[r + 2] := table[((f[i + 1] and 15) SHL 2) or (f[i + 2] SHR 6)];
    PArrayChars(@Result)^[r + 3] := table[f[i + 2] and 63];
    inc(i, 3);
    inc(r, 4);
    dec(j, 3);
  end;

  case j of
    1:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[f[i] and 3 SHL 4];
        PArrayChars(@Result)^[r + 2] := '=';
        PArrayChars(@Result)^[r + 3] := '=';
      end;
    2:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
        PArrayChars(@Result)^[r + 2] := table[f[i + 1] and $0F SHL 2];
        PArrayChars(@Result)^[r + 3] := '=';
      end;
  end;
end;

var
  i: Cardinal;
  StartTime: Int64;

begin
 // 0K7QvdC40LrQvtC0ISDOtc+Bzr/inaTinaTOtc+Bzr/inaQ=
  Writeln(base64_encode('Юникод! &#949;&#961;&#959;&#10084;&#10084;&#949;&#961;&#959;&#10084;'));

  try
    if ZStartTime(StartTime) then
    begin
      for i := 0 to 10000000 do
      begin
        base64_encode('HytujkyHytujkyukHytujkyukuk');
      end;
      Writeln(ZStopTime(StartTime));
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.



Скажи пожалуйста, а кому уперлись в пень твои секунды ? Или ты за чистое искусство страдаешь ?
...
Рейтинг: 0 / 0
05.08.2017, 10:31:16
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500619
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
schiНяшикВ общем вышло вот такое, правда уже не секунда. А целых 3.052310 секунды. Но за то поддержка юникода

 
Код: pascal
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.
program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  windows, System.SysUtils;

function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs;
  external 'msvcrt.dll';

function ZStartTime(var StartTime: Int64): Boolean;
begin
  Result := QueryPerformanceCounter(StartTime);
end;

function ZStopTime(const StartTime: Int64): AnsiString;
var
  iCounterPerSec, StopTime: Int64;
  time: Single;
begin
  if QueryPerformanceCounter(StopTime) then
  begin
    if QueryPerformanceFrequency(iCounterPerSec) then
    begin

      time := (0 - StartTime + StopTime) / iCounterPerSec;

      Result := '';
      SetLength(Result, 25);

      SetLength(Result, sprintf(PAnsiChar(Result), 'Result: %f sec.', time));
    end
    else
      Result := 'Error[ZStopTime(QueryPerformanceFrequency)]';
  end
  else
    Result := 'Error[ZStopTime(QueryPerformanceCounter)]';
end;

function base64_encode(const str: string): string;
const
  table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  PArrayChars = ^TArrayChars;
  TArrayChars = array of Char;
  TArrayBytes = array of Byte;
var
  len, i, r, j: Integer;
  f: TArrayBytes;
  c: PWideChar;
  bb: Char;
begin
  j := 0;
  r := 0;
  len := Length(str);

  SetLength(f, len * 3);

  c := Pointer(str);
  bb := c[0];
  while bb <> #0 do
  begin
    if WORD(bb) < 128 then
    begin
      f[j] := WORD(bb);
      inc(j);
    end
    else if WORD(bb) < 2048 then
    begin
      f[j] := ((WORD(bb) shr 6) or 192);
      f[j + 1] := ((WORD(bb) and 63) or 128);
      inc(j, 2);
    end
    else
    begin
      f[j] := (224 + (WORD(bb) shr 12));
      f[j + 1] := (128 + ((WORD(bb) shr 6) and 63));
      f[j + 2] := (128 + (WORD(bb) and 63));
      inc(j, 3);
    end;
    inc(r);
    bb := c[r];
  end;

  SetLength(Result, ((j + 2) div 3) * 4);

  i := 0;
  r := 0;
  while j >= 3 do
  begin
    PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
    PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
    PArrayChars(@Result)^[r + 2] := table[((f[i + 1] and 15) SHL 2) or (f[i + 2] SHR 6)];
    PArrayChars(@Result)^[r + 3] := table[f[i + 2] and 63];
    inc(i, 3);
    inc(r, 4);
    dec(j, 3);
  end;

  case j of
    1:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[f[i] and 3 SHL 4];
        PArrayChars(@Result)^[r + 2] := '=';
        PArrayChars(@Result)^[r + 3] := '=';
      end;
    2:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
        PArrayChars(@Result)^[r + 2] := table[f[i + 1] and $0F SHL 2];
        PArrayChars(@Result)^[r + 3] := '=';
      end;
  end;
end;

var
  i: Cardinal;
  StartTime: Int64;

begin
 // 0K7QvdC40LrQvtC0ISDOtc+Bzr/inaTinaTOtc+Bzr/inaQ=
  Writeln(base64_encode('Юникод! &#949;&#961;&#959;&#10084;&#10084;&#949;&#961;&#959;&#10084;'));

  try
    if ZStartTime(StartTime) then
    begin
      for i := 0 to 10000000 do
      begin
        base64_encode('HytujkyHytujkyukHytujkyukuk');
      end;
      Writeln(ZStopTime(StartTime));
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.



Скажи пожалуйста, а кому уперлись в пень твои секунды ? Или ты за чистое искусство страдаешь ?

Для быстрого и качественного проекта - который хочет заработать привлекая этим своё внимание. Что за странный вопрос ?
...
Рейтинг: 0 / 0
05.08.2017, 10:45:03
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500709
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикУви, дорогой сэр. Это работает медленнее моего кода, плюс тоже не юникод. Сейчас обмозгую как его добавить в свой код, и скину пример
1. Мой вариант работает с памятью - ей пофиг, юникод или нет. А вот результат должен быть в AnsiString, а не в string, иначе смысла в кодировании нет (т.к. выходной буфер через один забит нулями).
2. Когда говоришь что что-то работает медленнее - надо бы доказательство приводить, хотя допускаю что такое может быть на очень старых процессорах, т.к. мой оптимизирован под Core i3 и выше.

 
Сравнение
результат на моём Core i7 26000JTQstC10L3QsNC00YbQsNGC0Ywg0L/QvtC/0YPQs9Cw0LXQsiDQt9Cw0LrQu9C10LLQsNC70Lgg0L/QuNGC0L7QvdCwIQ==
Няшик: Result: 2.444395 sec.
FAQyBDUEPQQwBDQERgQwBEIETAQgAD8EPgQ/BEMEMwQwBDUEMgQgADcEMAQ6BDsENQQyBDAEOwQ4BCAAPwQ4BEIEPgQ9BDAEIQA=
AsmB64: Result: 1.043641 sec.


Обрати внимание что результаты разные, потому что твой код перед кодированием ещё и модифицирует исходные данные (base64 вообще-то предназначен для передачи двоичных данных, модифицировать их перед передачей - это бред).
 
код теста
Код: pascal
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.
 ... выше всё без изменений ...

const
  StrToEncode: string = 'Двенадцать попугаев заклевали питона!';

var
  Encoded: AnsiString;
  StrByteSize: Integer;
begin
  try
    Writeln(base64_encode(StrToEncode));
    if ZStartTime(StartTime) then
    begin
      for i := 0 to 10000000 do
      begin
        base64_encode(StrToEncode);
      end;
      Writeln('Няшик: ' + ZStopTime(StartTime));
    end;
    StrByteSize := Length(StrToEncode) * SizeOf(Char);
    Base64Encode(StrByteSize, Pointer(StrToEncode), Encoded);
    Writeln(Encoded);
    if ZStartTime(StartTime) then
    begin
      for i := 0 to 10000000 do
      begin
        Base64Encode(StrByteSize, Pointer(StrToEncode), Encoded);
      end;
      Writeln('AsmB64: ' + ZStopTime(StartTime));
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.



schiСкажи пожалуйста, а кому уперлись в пень твои секунды ? Или ты за чистое искусство страдаешь ?Могу за себя сказать: изучал ассемблер в Delphi, в качестве "подопытного" выбрал base64 т.к. просто и понятно :)
...
Рейтинг: 0 / 0
05.08.2017, 19:13:46
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500713
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvp1. Мой вариант работает с памятью - ей пофиг, юникод или нет. А вот результат должен быть в AnsiString, а не в string, иначе смысла в кодировании нет (т.к. выходной буфер через один забит нулями).


Бред, полный бред ! Скажу я тебе. Так как символ надо преобразовать в байтовую кодировку UTF-8

Например так, поддержка 6 байт

 
Код: pascal
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.
function base64_encode(const str: string): string;
const
  table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  PArrayChars = ^TArrayChars;
  TArrayChars = array of Char;
  TArrayBytes = array of Byte;
var
  len, i, r, j: Integer;
  f: TArrayBytes;
  c: PWideChar;
  bb: Char;
begin
  j := 0;
  r := 0;
  len := Length(str);

  SetLength(f, len * 3);

  c := Pointer(str);
  bb := c[0];
  while bb <> #0 do
  begin
    if (WORD(bb) < $00000080) then
    begin
      f[j] := WORD(bb);
      inc(j, 1);
    end
    else if (WORD(bb) < $00000800) then
    begin
      f[j] := $C0 or ((WORD(bb) shr 6) and $FF);
      f[j + 1] := $80 or (WORD(bb) and $3F);
      inc(j, 2);
    end
    else if (WORD(bb) < $00010000) then
    begin
      f[j] := $E0 or ((WORD(bb) shr 12) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 2] := $80 or (WORD(bb) and $3F);
      inc(j, 3);
    end
    else if (WORD(bb) < $00200000) then
    begin
      f[j] := $F0 or ((WORD(bb) shr 18) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 12) and $3F);
      f[j + 2] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 3] := $80 or (WORD(bb) and $3F);
      inc(j, 4);
    end
    else if (WORD(bb) < $04000000) then
    begin
      f[j] := $F8 or ((WORD(bb) shr 24) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 18) and $3F);
      f[j + 2] := $80 or ((WORD(bb) shr 12) and $3F);
      f[j + 3] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 4] := $80 or (WORD(bb) and $3F);
      inc(j, 5);
    end
    else if (WORD(bb) < $80000000) then
    begin
      f[j] := $FC or ((WORD(bb) shr 30) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 24) and $3F);
      f[j + 2] := $80 or ((WORD(bb) shr 18) and $3F);
      f[j + 3] := $80 or ((WORD(bb) shr 12) and $3F);
      f[j + 4] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 5] := $80 or (WORD(bb) and $3F);
      inc(j, 6);
    end;
    inc(r);
    bb := c[r];
  end;

  SetLength(Result, ((j + 2) div 3) * 4);

  i := 0;
  r := 0;
  while j >= 3 do
  begin
    PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
    PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
    PArrayChars(@Result)^[r + 2] := table[((f[i + 1] and 15) SHL 2) or (f[i + 2] SHR 6)];
    PArrayChars(@Result)^[r + 3] := table[f[i + 2] and 63];
    inc(i, 3);
    inc(r, 4);
    dec(j, 3);
  end;

  case j of
    1:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[f[i] and 3 SHL 4];
        PArrayChars(@Result)^[r + 2] := '=';
        PArrayChars(@Result)^[r + 3] := '=';
      end;
    2:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
        PArrayChars(@Result)^[r + 2] := table[f[i + 1] and $0F SHL 2];
        PArrayChars(@Result)^[r + 3] := '=';
      end;
  end;
end;



"С памятью" Я ржу
Т.е в коде мы с памятью не можем работать?


Мой пример тот выдаёт 0,9 сек а твой 1,1 ... Вся твоя быстрота не обоснованная.

alekcvp[spoiler Сравнение]


Я верю тебе, верю! А теперь в настройках галочку оптимизации пожалуйста включи, и проверь снова. И увидишь что мой пример будет во много раз быстрее.

Иж какой.


alekcvpМогу за себя сказать: изучал ассемблер в Delphi, в качестве "подопытного" выбрал base64 т.к. просто и понятно :)


Практика такова что ты не напишешь в современных Delphi на ассемблере лучше чем компилятор оптимизирует. Многие знатоки на этом форуме это подтвердят.
...
Рейтинг: 0 / 0
05.08.2017, 19:23:36
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500714
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvpНяшик: Result: 2.444395 sec.

AsmB64: Result: 1.043641 sec.


Если твой код на I3 так плохо работает, если на моём процессоре тоже за 1 секунду отрабатывает. А он кстати 2009 года
https://ark.intel.com/ru/products/42771/Intel-Celeron-Processor-E3300-1M-Cache-2_50-GHz-800-MHz-FSB

То твой код ещё хуже моего, мой то работает быстрее с включённой галочкой.
...
Рейтинг: 0 / 0
05.08.2017, 19:26:17
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500715
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
schi
Участник
alekcvpМогу за себя сказать: изучал ассемблер в Delphi, в качестве "подопытного" выбрал base64 т.к. просто и понятно :)

https://github.com/aklomp/base64

уже есть :)
...
Рейтинг: 0 / 0
05.08.2017, 19:27:31
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500719
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
schi
Участник
НяшикПрактика такова что ты не напишешь в современных Delphi на ассемблере лучше чем компилятор оптимизирует. Многие знатоки на этом форуме это подтвердят.

Увы, у тебя слишком сильная вера в возможности оптимизации дельфийского компилятора. Особенно для 64-битной платформы.
...
Рейтинг: 0 / 0
05.08.2017, 19:29:22
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500722
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
schiНяшикПрактика такова что ты не напишешь в современных Delphi на ассемблере лучше чем компилятор оптимизирует. Многие знатоки на этом форуме это подтвердят.

Увы, у тебя слишком сильная вера в возможности оптимизации дельфийского компилятора. Особенно для 64-битной платформы.

Я не пользуюсь этой версией компилятора, про неё ничего сказать не могу. Но вот для 86-32 битного разницы нету. Дельфовый компилятор ляпает код гораздо лучше чем его напишет человек, не раз уже в этом убеждался.
...
Рейтинг: 0 / 0
05.08.2017, 19:31:07
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500724
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикБред, полный бред ! Скажу я тебе. Так как символ надо преобразовать в байтовую кодировку UTF-8

Ещё раз, читай по буквам: wikiBase64 буквально означает — позиционная система счисления с основанием 64. Здесь 64 — это число символов в алфавите кодирования, из которого формируется конечный буквенно-цифровой текст на основе латинского алфавита. Число соответствует наибольшей степени двойки (26), которая может быть представлена с использованием печатных символов ASCII. Эта система широко используется в электронной почте для представления бинарных файлов в тексте письма (транспортное кодирование).
Какое нафиг преобразование исходных данных, если они по-умолчанию двоичные и их надо передать "как есть" и восстановить на другом конце один-в-один?..
НяшикТ.е в коде мы с памятью не можем работать?
Ладно, для редких военных профессий: мой код принимает указатель на буфер в памяти и размер данных в нём, ему пофиг что там - текст, музыка или картинка с котиками: он все преобразует как есть.
НяшикМой пример тот выдаёт 0,9 сек а твой 1,1 ... Вся твоя быстрота не обоснованная.
А теперь в настройках галочку оптимизации пожалуйста включи, и проверь снова.

Ты вот про эту галочку?..

А чтобы нормально сравнить - запусти мой пример, с русским текстом. Потому что я не удивлюсь, если ты у себя в тесте написал что-то вроде:
Код: pascal
1.
2.
3.
4.
for i := 1 to 1000000 do 
begin
  base64encode(length(s)*2, PChar(s), result);
end;


НяшикПрактика такова что ты не напишешь в современных Delphi на ассемблере лучше чем компилятор оптимизирует. Многие знатоки на этом форуме это подтвердят.
Вот как раз в современных Delphi с оптимизацией всё плохо, в отличие от старых. Иногда они такие куски лишнего кода генерят, что за голову схватиться хочется. Хотя, справедливости ради, это чаще всего качается inline-функций.
...
Рейтинг: 0 / 0
05.08.2017, 19:37:16
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500725
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
alekcvp,
Картинка: https://www.dropbox.com/s/cy9m4qmmndp6j9h/settings.png?dl=0
...
Рейтинг: 0 / 0
05.08.2017, 19:37:31
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500728
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
schi https://github.com/aklomp/base64
уже есть :)
Ещё б кто мне подсказал как .c напрямую в проект дельфей линковать без пляски с .obj и .dll.
...
Рейтинг: 0 / 0
05.08.2017, 19:42:52
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500729
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
schi
Участник
Няшикschiпропущено...


Увы, у тебя слишком сильная вера в возможности оптимизации дельфийского компилятора. Особенно для 64-битной платформы.

Я не пользуюсь этой версией компилятора, про неё ничего сказать не могу. Но вот для 86-32 битного разницы нету. Дельфовый компилятор ляпает код гораздо лучше чем его напишет человек, не раз уже в этом убеждался.

Я убеждался в обратном. Да и Саша Шарахов не зря куски FastCode на ассемблере писал.

По поводу 64-битного компилятора:
http://blog.digitaltundra.com/?p=296
...
Рейтинг: 0 / 0
05.08.2017, 19:43:46
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500736
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvpЕщё раз, читай по буквам:


Ты реально не понимаешь? Речь идёт о символах, которые нужно перевести в base64 Например смайлик сердечко это 3 байта, этих три байта надо разбить так, и перевести в base
 
Код: pascal
1.
2.
3.
      f[j] := $E0 or ((WORD(bb) shr 12) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 2] := $80 or (WORD(bb) and $3F);



Т.е один юникодный символ ❤ займёт ровно 3 байта, которые должны быть сохранены в base64 вот так
 

Код: pascal
1.
2.
3.
4.
    PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
    PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
    PArrayChars(@Result)^[r + 2] := table[((f[i + 1] and 15) SHL 2) or (f[i + 2] SHR 6)];
    PArrayChars(@Result)^[r + 3] := table[f[i + 2] and 63];





Всё ниже не вижу смысла комментировать, я уже объяснил.

alekcvpТы вот про эту галочку?..


Да про эту. У тебя комп забит муссором от майл - ру ?)))


alekcvp
А чтобы нормально сравнить - запусти мой пример, с русским текстом.


Смысл запускать то что не работает?)

 

IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=
0PPx8ero6SDy5erx8gAAAAAAAAAAAAAAAAA=
IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=



alekcvpВот как раз в современных Delphi с оптимизацией всё плохо, в отличие от старых. Иногда они такие куски лишнего кода генерят, что за голову схватиться хочется. Хотя, справедливости ради, это чаще всего качается inline-функций.

Согласен если плохо программируешь.
...
Рейтинг: 0 / 0
05.08.2017, 20:00:06
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500739
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикСмысл запускать то что не работает?)

 

IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=
0PPx8ero6SDy5erx8gAAAAAAAAAAAAAAAAA=
IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=


/facepalm
Ты реально не понимаешь разницы между string и ansistring?.. Тогда я не вижу больше предмета для обсуждения, подтяни что ли теорию, потом подумай почему второй вызов base64encode выдают другой результат и на самом деле является UB.
...
Рейтинг: 0 / 0
05.08.2017, 20:09:34
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500742
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvpНяшикСмысл запускать то что не работает?)

 

IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=
0PPx8ero6SDy5erx8gAAAAAAAAAAAAAAAAA=
IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=


/facepalm
Ты реально не понимаешь разницы между string и ansistring?.. Тогда я не вижу больше предмета для обсуждения, подтяни что ли теорию, потом подумай почему второй вызов base64encode выдают другой результат и на самом деле является UB.


ОМГ. Я привёл пример, что в string (он же WideString а именно MarshaledString) и AnsiString Выдают неверные результаты.


Не коси под идеота.
...
Рейтинг: 0 / 0
05.08.2017, 20:11:39
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500744
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvp,

Как не крути твой код, на русские символы он выдаёт подобную беребелбду. С англ всё нормально

IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=
0PPx8ero6SDy5erx8gAAAAAAAAAAAAAAAAA=


Ты хотя бы проверяй результаты своей программы
...
Рейтинг: 0 / 0
05.08.2017, 20:12:40
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500746
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Няшикalekcvp,
Как не крути твой код, на русские символы он выдаёт подобную беребелбду. С англ всё нормально
IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=
0PPx8ero6SDy5erx8gAAAAAAAAAAAAAAAAA=
Ты хотя бы проверяй результаты своей программы

Хорошо, вопрос на засыпку: почему ты длину AnsiString указываешь как Length(A2)*2 ? Что означает эта 2?..
...
Рейтинг: 0 / 0
05.08.2017, 20:24:20
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500750
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvpНяшикalekcvp,
Как не крути твой код, на русские символы он выдаёт подобную беребелбду. С англ всё нормально
IARDBEEEQQQ6BDgEOQQgAEIENQQ6BEEEQgQ=
0PPx8ero6SDy5erx8gAAAAAAAAAAAAAAAAA=
Ты хотя бы проверяй результаты своей программы

Хорошо, вопрос на засыпку: почему ты длину AnsiString указываешь как Length(A2)*2 ? Что означает эта 2?..


Потому что копипаст. Но это всё не важно, потому что правильный бейсик64 будет таким

'Русский Текст' => 0KDRg9GB0YHQutC40Lkg0KLQtdC60YHRgg==

Вот сайт для проверки http://base64.ru/

 
Код: pascal
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.
program Project3;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  windows, System.SysUtils;

function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer; cdecl; varargs;
  external 'msvcrt.dll';

function ZStartTime(var StartTime: Int64): Boolean;
begin
  Result := QueryPerformanceCounter(StartTime);
end;

function ZStopTime(const StartTime: Int64): AnsiString;
var
  iCounterPerSec, StopTime: Int64;
  time: Single;
begin
  if QueryPerformanceCounter(StopTime) then
  begin
    if QueryPerformanceFrequency(iCounterPerSec) then
    begin

      time := (0 - StartTime + StopTime) / iCounterPerSec;

      Result := '';
      SetLength(Result, 25);

      SetLength(Result, sprintf(PAnsiChar(Result), 'Result: %f sec.', time));
    end
    else
      Result := 'Error[ZStopTime(QueryPerformanceFrequency)]';
  end
  else
    Result := 'Error[ZStopTime(QueryPerformanceCounter)]';
end;

function base64_encode(const str: string): string;
const
  table: PWideChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  PArrayChars = ^TArrayChars;
  TArrayChars = array of Char;
  TArrayBytes = array of Byte;
var
  len, i, r, j: Integer;
  f: TArrayBytes;
  c: PWideChar;
  bb: Char;
begin
  j := 0;
  r := 0;
  len := Length(str);

  SetLength(f, len * 3);

  c := Pointer(str);
  bb := c[0];
  while bb <> #0 do
  begin
    if (WORD(bb) < $00000080) then
    begin
      f[j] := WORD(bb);
      inc(j, 1);
    end
    else if (WORD(bb) < $00000800) then
    begin
      f[j] := $C0 or ((WORD(bb) shr 6) and $FF);
      f[j + 1] := $80 or (WORD(bb) and $3F);
      inc(j, 2);
    end
    else if (WORD(bb) < $00010000) then
    begin
      f[j] := $E0 or ((WORD(bb) shr 12) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 2] := $80 or (WORD(bb) and $3F);
      inc(j, 3);
    end
    else if (WORD(bb) < $00200000) then
    begin
      f[j] := $F0 or ((WORD(bb) shr 18) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 12) and $3F);
      f[j + 2] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 3] := $80 or (WORD(bb) and $3F);
      inc(j, 4);
    end
    else if (WORD(bb) < $04000000) then
    begin
      f[j] := $F8 or ((WORD(bb) shr 24) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 18) and $3F);
      f[j + 2] := $80 or ((WORD(bb) shr 12) and $3F);
      f[j + 3] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 4] := $80 or (WORD(bb) and $3F);
      inc(j, 5);
    end
    else if (WORD(bb) < $80000000) then
    begin
      f[j] := $FC or ((WORD(bb) shr 30) and $FF);
      f[j + 1] := $80 or ((WORD(bb) shr 24) and $3F);
      f[j + 2] := $80 or ((WORD(bb) shr 18) and $3F);
      f[j + 3] := $80 or ((WORD(bb) shr 12) and $3F);
      f[j + 4] := $80 or ((WORD(bb) shr 6) and $3F);
      f[j + 5] := $80 or (WORD(bb) and $3F);
      inc(j, 6);
    end;
    inc(r);
    bb := c[r];
  end;

  SetLength(Result, ((j + 2) div 3) * 4);

  i := 0;
  r := 0;
  while j >= 3 do
  begin
    PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
    PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
    PArrayChars(@Result)^[r + 2] := table[((f[i + 1] and 15) SHL 2) or (f[i + 2] SHR 6)];
    PArrayChars(@Result)^[r + 3] := table[f[i + 2] and 63];
    inc(i, 3);
    inc(r, 4);
    dec(j, 3);
  end;

  case j of
    1:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[f[i] and 3 SHL 4];
        PArrayChars(@Result)^[r + 2] := '=';
        PArrayChars(@Result)^[r + 3] := '=';
      end;
    2:
      begin
        PArrayChars(@Result)^[r + 0] := table[f[i] SHR 2];
        PArrayChars(@Result)^[r + 1] := table[((f[i] and 3) SHL 4) or (f[i + 1] SHR 4)];
        PArrayChars(@Result)^[r + 2] := table[f[i + 1] and $0F SHL 2];
        PArrayChars(@Result)^[r + 3] := '=';
      end;
  end;
end;

var
  i: Cardinal;
  StartTime: Int64;

begin
  try
    Writeln(base64_encode('Русский Текст'));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.

...
Рейтинг: 0 / 0
05.08.2017, 20:29:09
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500757
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикВот сайт для проверки http://base64.ru/

Еще раз говорю: ты не понимаешь что такое AnsiString :)
http://foxtools.ru/Base64
Введи сюда то что выдаёт моя функция (0PPx8ero6SDy5erx8g==) и выбери кодировку Windows 1251 , после этого нажми "отправить" и посмотри на результат декодирования.
...
Рейтинг: 0 / 0
05.08.2017, 20:39:58
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500762
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvp,

=_= Я думал что ты строишь дурака, но мне кажется что не строишь.

Русский текст 2 байта, и их надо сохранить последовательно - как застёгивает замочек ширинку ленту.

Т.е, разбить символ на 2 байта, и взять ещё 1 байт от следующего символа.

Тебе сколько раз можно повторять это??? Base64 пакует 3 байта!!!! Причём тут вообще вывод в AnsiString ???..
...
Рейтинг: 0 / 0
05.08.2017, 20:49:09
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500764
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикТебе сколько раз можно повторять это??? Base64 пакует 3 байта!!!! Причём тут вообще вывод в AnsiString ???..
Мне наш разговор напоминает разговор слепого с глухонемым, или ты просто очень скиллованный тролль.
Замени в своём примере на картинке S2: AnsiString; на S2: Utf8String; и посмотри на результат.
...
Рейтинг: 0 / 0
05.08.2017, 20:53:28
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500766
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикОМГ. Я привёл пример, что в string (он же WideString а именно MarshaledString) и AnsiString Выдают неверные результаты.

Ты всерьёз считаешь, что одинаковый текст в разных кодировках должен давать одинаковый base64?
...
Рейтинг: 0 / 0
05.08.2017, 21:03:34
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500774
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvp,


Вставь свой base64 в свой сайт http://foxtools.ru/Base64

alekcvp

результат на моём Core i7 26000JTQstC10L3QsNC00YbQsNGC0Ywg0L/QvtC/0YPQs9Cw0LXQsiDQt9Cw0LrQu9C10LLQsNC70Lgg0L/QuNGC0L7QvdCwIQ==

Няшик: Result: 2.444395 sec.
FAQyBDUEPQQwBDQERgQwBEIETAQgAD8EPgQ/BEMEMwQwBDUEMgQgADcEMAQ6BDsENQQyBDAEOwQ4BCAAPwQ4BEIEPgQ9BDAEIQA=
AsmB64: Result: 1.043641 sec.
л base64 т.к. просто и понятно :)

[/quot]
...
Рейтинг: 0 / 0
05.08.2017, 21:14:21
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500779
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
Няшикalekcvp,
base64 т.к. просто и понятно :)
[/quot]
Таки ты тролль. "FAQyBDUEPQQwBDQERgQwBEIETAQgAD8EPgQ/BEMEMwQwBDUEMgQgADcEMAQ6BDsENQQyBDAEOwQ4BCAAPwQ4BEIEPgQ9BDAEIQA=" - это в кодировке Unicode или cp_1200 на том сайте.
...
Рейтинг: 0 / 0
05.08.2017, 21:17:00
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500780
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Няшик
Участник
alekcvpНяшикalekcvp,
base64 т.к. просто и понятно :)

Таки ты тролль. "FAQyBDUEPQQwBDQERgQwBEIETAQgAD8EPgQ/BEMEMwQwBDUEMgQgADcEMAQ6BDsENQQyBDAEOwQ4BCAAPwQ4BEIEPgQ9BDAEIQA=" - это в кодировке Unicode или cp_1200 на том сайте.[/quot]

Я уже все перетыкал что бы его расшифровать. Даже в пыху вставил, и там же получил

25=04F0BL �?>?C3052 �70:;520;8 �?8B>=0!�

http://sandbox.onlinephpfunctions.com/code/984f3917de156ce71e9b11c09ac46a84e40d2a11
...
Рейтинг: 0 / 0
05.08.2017, 21:19:29
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39500788
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
НяшикЯ уже все перетыкал что бы его расшифровать. Даже в пыху вставил, и там же получил
...
Рейтинг: 0 / 0
05.08.2017, 21:29:09
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39501122
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
Barney83Не работает пример, валится на
UpdateLastError( 'CryptCreateHash (2)' );
Странно. Там и ошибкам вроде негде взяться в этой строке. Надо смотреть SysErrorMessage( g_nLastCryptError ) в этой строке и разбираться. Я, честно говоря, не тестировал для 384 и выше, только для MD5, SHA1 и SHA256.
...
Рейтинг: 0 / 0
07.08.2017, 10:35:47
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39501177
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
Barney83,

подкорректировал ф-цию, теперь работает и для 384/512

 
Код: pascal
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.
function HMAC_COMMON( const K; KLen: Integer; const M; MLen: Integer; HashAlgorithm: ALG_ID; out Mac; MacLen: DWORD ): Boolean;

  procedure UpdateLastError( const SFunction: String );
  begin
    g_nLastCryptError := GetLastError;
    g_strLastCryptErrorFunction := SFunction;
  end;

var
  i_key_pad: Array[ 0 .. 127 ] of Byte;
  o_key_pad: Array[ 0 .. 127 ] of Byte;

  lpProvider: PChar;
  dwProvType: DWORD;

  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  len, cb, i, BLOCK_SIZE: ULONG;
  lpkeyhash1, lpkeyhash2, lpkey: PAnsiChar;
  c: Byte;
begin
  g_nLastCryptError := 0;
  lpkeyhash1 := nil;
  lpkeyhash2 := nil;

  if ( HashAlgorithm >= CALG_SHA_384 ) and ( HashAlgorithm <= CALG_SHA_512 ) then begin
    lpProvider := nil;
    dwProvType := PROV_RSA_AES;
    BLOCK_SIZE := 128;
  end else begin
    lpProvider := MS_DEF_PROV;
    dwProvType := PROV_RSA_FULL;
    BLOCK_SIZE := 64;
  end;

  Result := CryptAcquireContext( @hProv, nil, lpProvider, dwProvType, CRYPT_VERIFYCONTEXT or CRYPT_SILENT );
  if Result then begin
    len := KLen;
    if len > BLOCK_SIZE then begin
      Result := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
      if Result then begin
        cb := sizeof( len );
        Result := CryptHashData( hHash, @K, len, 0 ) and
                  CryptGetHashParam( hHash, HP_HASHSIZE, @len, @cb, 0 );
        if Result then begin
          GetMem( lpkeyhash1, len );
          Result := CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash1 ), @len, 0 );
          if not Result then
            UpdateLastError( 'CryptGetHashParam(HP_HASHVAL) (1)' );
        end else
          UpdateLastError( 'CryptHashData/CryptGetHashParam(HP_HASHSIZE)' );

        CryptDestroyHash( hHash );
      end else
        UpdateLastError( 'CryptCreateHash (1)' );
    end;

    if Result then begin
      if Assigned( lpkeyhash1 ) then
        lpkey := lpkeyhash1
      else
        lpkey := @K;

      i := BLOCK_SIZE;
      repeat
        Dec( i );
        if i < len then
          c := Byte( lpkey[ i ] )
        else
          c := 0;

        i_key_pad[ i ] := $36 xor c;
        o_key_pad[ i ] := $5c xor c;
      until i = 0;

      Result := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
      if Result then begin
        cb := sizeof( len );
        Result := CryptHashData( hHash, @i_key_pad, BLOCK_SIZE, 0 ) and
                  CryptHashData( hHash, @M, MLen, 0 ) and
                  CryptGetHashParam( hHash, HP_HASHSIZE, @len, @cb, 0 );
        if Result then begin
          GetMem( lpkeyhash2, len );
          Result := CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash2 ), @len, 0 );
          if not Result then
            UpdateLastError( 'CryptGetHashParam(HP_HASHVAL) (2)' );
        end else
          UpdateLastError( 'CryptHashData/CryptHashData/CryptGetHashParam(HP_HASHSIZE)' );

        CryptDestroyHash(hHash);

        if Result then begin
          Result := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
          if Result then begin
            Result := CryptHashData( hHash, @o_key_pad, BLOCK_SIZE, 0 ) and
                      CryptHashData( hHash, PByte( lpkeyhash2 ), len, 0 ) and
                      CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash2 ), @len, 0 );
            if not Result then
              UpdateLastError( 'CryptHashData/CryptHashData/CryptGetHashParam(HP_HASHVAL)' );

            CryptDestroyHash(hHash);

            if Result and ( len = MacLen ) then
              Move( lpkeyhash2^, Mac, len )
            else begin
              SetLastError( ERROR_INVALID_BLOCK );
              UpdateLastError( 'len != MacLen' );
            end;
          end else
            UpdateLastError( 'CryptCreateHash (3)' );
        end;
      end else
        UpdateLastError( 'CryptCreateHash (2)' );
    end;

    CryptReleaseContext( hProv, 0 );
  end else
    UpdateLastError( 'CryptAcquireContext' );

  if Assigned( lpkeyhash1 ) then
    FreeMem( lpkeyhash1 );

  if Assigned( lpkeyhash2 ) then
    FreeMem( lpkeyhash2 );
end;



Нужна будет константа PROV_RSA_AES = 24
...
Рейтинг: 0 / 0
07.08.2017, 12:44:50
| Ответить | Цитировать | Написать  
BASE64-HMAC-SHA384
    #39501181
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
YuRock
Участник
YuRock
Код: pascal
1.
2.
3.
4.
5.
6.
            if Result and ( len = MacLen ) then
              Move( lpkeyhash2^, Mac, len )
            else begin
              SetLastError( ERROR_INVALID_BLOCK );
              UpdateLastError( 'len != MacLen' );
            end;


заменить на
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
            if Result then begin
              if len = MacLen then
                Move( lpkeyhash2^, Mac, len )
              else begin
                Result := False;
                SetLastError( ERROR_INVALID_BLOCK );
                UpdateLastError( 'len != MacLen' );
              end;
            end;
...
Рейтинг: 0 / 0
07.08.2017, 12:52:12
| Ответить | Цитировать | Написать  
66 сообщений из 66, показаны все 3 страниц
  все  
Форумы / Delphi [игнор отключен] [закрыт для гостей] / BASE64-HMAC-SHA384
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?all=1&fid=58&tid=2041959]:
 0ms
get settings:
 9ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 178ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 92ms
get tp. blocked users:
 1ms
others: 220ms
total:  533ms
созд. / загр.: 533ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]