mORMot and Open Source friends
Check-in [b7ba18e682]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
SHA1 Hash:b7ba18e68252b76c0fedb9f9841b8d5edf784c20
Date: 2015-02-21 11:45:23
User: ab
Comment:{946} added SSE4 x64 optimized asm for SHA-256 on Win64
  • under Win32, with a Core i7 CPU: pure pascal: 152ms - x86: 112ms
  • under Win64, with a Core i7 CPU: pure pascal: 202ms - SSE4: 78ms
Tags And Properties
Context
2015-02-21
11:46
[78507a0782] {947} mainly for logging and debugging purposes, Model and LogClass will be serialized with a TSQLRest instance (user: ab, tags: trunk)
11:45
[b7ba18e682] {946} added SSE4 x64 optimized asm for SHA-256 on Win64
  • under Win32, with a Core i7 CPU: pure pascal: 152ms - x86: 112ms
  • under Win64, with a Core i7 CPU: pure pascal: 202ms - SSE4: 78ms
(user: ab, tags: trunk)
2015-02-20
16:00
[6eeb81a028] {945} let TFileBufferWriter.WriteDirectStart() allocate dynamically up to 100 MB to fully resolve [3032f99195b9db] (user: ab, tags: trunk)
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SynCommons.pas.

37813
37814
37815
37816
37817
37818
37819
37820
37821
37822
37823
37824
37825
37826
37827
37828
.....
39447
39448
39449
39450
39451
39452
39453
39454
39455
39456
39457
39458
39459
39460
39461

39462
39463
39464
39465
39466
39467
39468
  {$ifdef VER3_1_1}+' 3.1.1'{$endif}
{$else}
  {$ifdef VER90}  'Delphi 2'{$endif}
  {$ifdef VER100} 'Delphi 3'{$endif}
  {$ifdef VER120} 'Delphi 4'{$endif}
  {$ifdef VER130} 'Delphi 5'{$endif}
  {$ifdef CONDITIONALEXPRESSIONS}  // Delphi 6 or newer
    {$if     defined(VER140)}'Delphi 6'
    {$elseif defined(KYLIX3)}'Kylix 3'
    {$elseif defined(VER150)}'Delphi 7'
    {$elseif defined(VER160)}'Delphi 8'
    {$elseif defined(VER170)}'Delphi 2005'
    {$elseif defined(VER185)}'Delphi 2007'
    {$elseif defined(VER180)}'Delphi 2006'
    {$elseif defined(VER200)}'Delphi 2009'
    {$elseif defined(VER210)}'Delphi 2010'
................................................................................
  until false;
end;

function TFileBufferWriter.WriteDirectStart(maxSize: integer;
  const TooBigMessage: RawUTF8): PByte;
begin
  inc(maxSize,fPos);
  if maxSize>fBufLen then
    fTotalWritten := Flush;
  if maxSize>fBufLen then begin
    if maxSize>100 shl 20 then
      raise ESynException.CreateUTF8('%.WriteDirectStart: too big % - '+
        'expected up to 100 MB block',[self,TooBigMessage]);
    fBufLen := maxSize+1024;
    SetString(fBuf,nil,fBufLen);

  end;
  result := @PByteArray(fBuf)^[fPos];
end;

procedure TFileBufferWriter.WriteDirectEnd(realSize: integer);
begin
  if fPos+realSize>fBufLen then







|
|







 







|

|
|
|
|
|
|
>







37813
37814
37815
37816
37817
37818
37819
37820
37821
37822
37823
37824
37825
37826
37827
37828
.....
39447
39448
39449
39450
39451
39452
39453
39454
39455
39456
39457
39458
39459
39460
39461
39462
39463
39464
39465
39466
39467
39468
39469
  {$ifdef VER3_1_1}+' 3.1.1'{$endif}
{$else}
  {$ifdef VER90}  'Delphi 2'{$endif}
  {$ifdef VER100} 'Delphi 3'{$endif}
  {$ifdef VER120} 'Delphi 4'{$endif}
  {$ifdef VER130} 'Delphi 5'{$endif}
  {$ifdef CONDITIONALEXPRESSIONS}  // Delphi 6 or newer
    {$if     defined(KYLIX3)}'Kylix 3'
    {$elseif defined(VER140)}'Delphi 6'
    {$elseif defined(VER150)}'Delphi 7'
    {$elseif defined(VER160)}'Delphi 8'
    {$elseif defined(VER170)}'Delphi 2005'
    {$elseif defined(VER185)}'Delphi 2007'
    {$elseif defined(VER180)}'Delphi 2006'
    {$elseif defined(VER200)}'Delphi 2009'
    {$elseif defined(VER210)}'Delphi 2010'
................................................................................
  until false;
end;

function TFileBufferWriter.WriteDirectStart(maxSize: integer;
  const TooBigMessage: RawUTF8): PByte;
begin
  inc(maxSize,fPos);
  if maxSize>fBufLen then begin
    fTotalWritten := Flush;
    if maxSize>fBufLen then begin
      if maxSize>100 shl 20 then
        raise ESynException.CreateUTF8('%.WriteDirectStart: too big % - '+
          'we allow up to 100 MB block',[self,TooBigMessage]);
      fBufLen := maxSize+1024;
      SetString(fBuf,nil,fBufLen);
    end;
  end;
  result := @PByteArray(fBuf)^[fPos];
end;

procedure TFileBufferWriter.WriteDirectEnd(realSize: integer);
begin
  if fPos+realSize>fBufLen then

Changes to SynCrypto.pas.

28
29
30
31
32
33
34

35
36
37
38
39
40
41
...
159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
...
209
210
211
212
213
214
215

216
217
218
219
220
221
222
...
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
...
866
867
868
869
870
871
872

873
874
875
876
877
878
879
....
1529
1530
1531
1532
1533
1534
1535








1536
1537
1538
1539
1540
1541
1542
....
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128



3129
3130
3131
3132
3133
3134
3135
....
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204




3205































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































3206
3207
3208
3209
3210
3211
3212












3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
....
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
....
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
....
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
....
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
....
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811

3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929


3930
3931



3932
3933
3934
3935
3936
3937
3938
....
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
....
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
....
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
....
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2015
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  - Wolfgang Ehrhardt under zlib license for AES "pure pascal" versions


  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
................................................................................
       XorOffset  368 MB/s
        XorConst  510 MB/s

   Conclusion:
   - USETHREADSFORBIGAESBLOCKS will help on modern multi-threaded CPU
   - AES speed: W.Ehrhardt's pascal is 55MB/s, A.Bouchez's asm is 84MB/s
   - AES-256 is faster than a simple XOR() on a dedibox with a C7 cpu ;)
   - see below for benchmarks using AES-NI, which see a huge performance boost


   Initial version (C) 2008-2009 Arnaud Bouchez http://bouchez.info

   Revision History:

   Version 1.0
    - initial release on Internet, with MyCrypto unit name
................................................................................
   - added pure pascal version (for XE2 64 compilation) of all algorithms

   Version 1.18
   - added AES-NI hardware support on newer CPUs, for huge performance boost
     and enhanced security
   - tested compilation for Win64 platform
   - run with FPC under Win32 and Linux (including AES-NI support), and Kylix

   - added overloaded procedure TMD5.Final() and function SHA256()
   - introduce ESynCrypto exception class dedicated to this unit
   - added AES encryption using official Microsoft AES Cryptographic Provider
     (CryptoAPI) via TAESECB_API, TAESCBC_API, TAESCFB_API and TAESOFB_API -
     our optimized asm version is faster, so is still our default/preferred
   - added CompressShaAes() and global CompressShaAesKey, CompressShaAesIV and
     CompressShaAesClass variables to be used by THttpSocket.RegisterCompress
................................................................................

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

{.$define USEPADLOCK}

{.$define PUREPASCAL} // for debug

{$ifdef Linux} // padlock is dedibox linux tested only, but may be OK on Windows
  {$undef USETHREADSFORBIGAESBLOCKS}
  {.$define USEPADLOCK}
{$else}
  {$ifdef CONDITIONALEXPRESSIONS}
    // on Windows: enable Microsoft AES Cryptographic Provider (XP SP3 and up)
    {$define USE_PROV_RSA_AES}
  {$endif}
  // on Windows: will use Threads for very big blocks (>512KB) if multi-CPU
  {$define USETHREADSFORBIGAESBLOCKS}
................................................................................
/// simple Adler32 implementation
// - a bit slower than Adler32Asm() version below, but shorter code size
function Adler32Pas(Adler: cardinal; p: pointer; Count: Integer): cardinal;

/// fast Adler32 implementation
// - 16-bytes-chunck unrolled asm version
function Adler32Asm(Adler: cardinal; p: pointer; Count: Integer): cardinal;


// - very fast XOR according to Cod - not Compression or Stream compatible
// - used in AESFull() for KeySize=32
procedure XorBlock(p: PIntegerArray; Count, Cod: integer);

/// fast and simple XOR Cypher using Index (=Position in Dest Stream)
// - Compression not compatible with this function: should be applied after
................................................................................
begin
//  result := true; exit;
  result := SingleTest('abc', D1) and
     SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq', D2);
  if not result then exit;
  SHA256Weak('lagrangehommage',Digest); // test with len=256>64
  result := Comparemem(@Digest,@D3,sizeof(Digest));








end;

function MD5(const s: RawByteString): RawUTF8;
begin
  result := MD5DigestToString(MD5Buf(s[1],length(s)));
end;

................................................................................
  {$endif}
  bIn := pIn;
  bOut := pOut;
  WaitForMultipleObjects(nThread,@Handle[0],True,INFINITE);
  for i := 0 to nThread-1 do
    CloseHandle(Handle[i]);
end;
{$endif}


{ TSHA256 }




procedure Sha256ExpandMessageBlocks(W, Buf: PIntegerArray);
// Calculate "expanded message blocks"
{$ifdef PUREPASCAL}
var i: integer;
begin
  for i := 0 to 15 do
................................................................................
     jnz   @@2
     pop   ebx
     pop   edi
     pop   esi
end;
{$endif}

procedure TSHA256.Compress;
// Actual hashing function
const
  K: array[0..63] of cardinal = (
   $428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1,
   $923f82a4, $ab1c5ed5, $d807aa98, $12835b01, $243185be, $550c7dc3,
   $72be5d74, $80deb1fe, $9bdc06a7, $c19bf174, $e49b69c1, $efbe4786,
   $0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da,
   $983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147,
   $06ca6351, $14292967, $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13,
   $650a7354, $766a0abb, $81c2c92e, $92722c85, $a2bfe8a1, $a81a664b,
   $c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070,
   $19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a,
   $5b9cca4f, $682e6ff3, $748f82ee, $78a5636f, $84c87814, $8cc70208,
   $90befffa, $a4506ceb, $bef9a3f7, $c67178f2);




var































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































  H: TSHAHash;
  W: array[0..63] of cardinal;
{$ifdef PUREPASCAL}
  i: integer;
  t1, t2: cardinal;
{$endif}
begin












  // Calculate "expanded message blocks"
  Sha256ExpandMessageBlocks(@W,@TSHAContext(Context).Buffer);

  // Assign old working hash to variables A..H
  with TSHAContext(Context) do begin
    H.A := Hash.A;
    H.B := Hash.B;
    H.C := Hash.C;
    H.D := Hash.D;
    H.E := Hash.E;
    H.F := Hash.F;
................................................................................
    H.H := Hash.H;
  end;

{$ifdef PUREPASCAL}
  // SHA256 compression function
  for i := 0 to high(W) do begin
    t1 := H.H+(((H.E shr 6)or(H.E shl 26))xor((H.E shr 11)or(H.E shl 21))xor
      ((H.E shr 25)or(H.E shl 7)))+((H.E and H.F)xor(not H.E and H.G))+K[i]+W[i];
    t2 := (((H.A shr 2)or(H.A shl 30))xor((H.A shr 13)or(H.A shl 19))xor
      ((H.A shr 22)xor(H.A shl 10)))+((H.A and H.B)xor(H.A and H.C)xor(H.B and H.C));
    H.H := H.G; H.G := H.F; H.F := H.E; H.E := H.D+t1;
    H.D := H.C; H.C := H.B; H.B := H.A; H.A := t1+t2; 
  end;
{$else}
  // SHA256 compression function - optimized by A.B. for pipelined CPU
  asm
    push ebx
    push esi
    push edi
................................................................................
    mov  eax,[H].TSHAHash.F
    mov  [H].TSHAHash.H,edx
    mov  [H].TSHAHash.G,eax
    xor  eax,edx
    mov  [H].TSHAHash.F,ebx
    and  eax,ebx
    xor  eax,edx
    add  eax,dword ptr [K+edi*4]
    add  eax,ecx
    mov  ecx,[H].TSHAHash.D
    add  eax,dword ptr [W+edi*4]
    mov  ebx,[H].TSHAHash.A
    //  eax= T1 := H + Sum1(E) +(((F xor G) and E) xor G)+K[i]+W[i];
    add  ecx,eax
    mov  esi,eax  // esi = T1
    mov  [H].TSHAHash.E,ecx // E := D + T1;
    mov  eax,ebx // Sum0(A)
    mov  edx,ebx
    ror  eax,2
    mov  ecx,ebx
................................................................................
    mov  [H].TSHAHash.D,eax
    cmp  edi,64
    jnz  @s
    pop  edi
    pop  esi
    pop  ebx
  end;
{$endif}

  // Calculate new working hash
  with TSHAContext(Context) do begin
    inc(Hash.A,H.A);
    inc(Hash.B,H.B);
    inc(Hash.C,H.C);
    inc(Hash.D,H.D);
................................................................................
end;

procedure TSHA256.Update(Buffer: pointer; Len: integer);
var Data: TSHAContext absolute Context;
    aLen: integer;
begin
  if Buffer=nil then exit; // avoid GPF
  inc(Data.MLen, Int64(cardinal(Len)) shl 3);
  while Len > 0 do begin
    aLen := 64-Data.Index;
    if aLen<=Len then begin
      move(buffer^,Data.Buffer[Data.Index],aLen);
      dec(Len,aLen);
      inc(PtrInt(buffer),aLen);
      Compress;
      Data.Index := 0;
................................................................................
    dec(Count,n);
  end;
  result := word(s1)+cardinal(word(s2)) shl 16;
end;

function Adler32Asm(Adler: cardinal; p: pointer; Count: Integer): cardinal;
{$ifdef PUREPASCAL}
var s1, s2: cardinal;
    i, n: integer;
begin
  s1 := LongRec(Adler).Lo;
  s2 := LongRec(Adler).Hi;
  while Count>0 do begin
    if Count<5552 then
      n := Count else
      n := 5552;
    for i := 1 to n do begin
      inc(s1,pByte(p)^);
      inc(PtrUInt(p));
      inc(s2,s1);

    end;
    s1 := s1 mod 65521;
    s2 := s2 mod 65521;
    dec(Count,n);
  end;
  result := word(s1)+cardinal(word(s2)) shl 16;
end;
{$else}
asm
	push      ebx
	push      esi
	push      edi
	mov       edi,eax
	shr       edi,16
	movzx     ebx,ax
	push      ebp
	mov       esi,edx
	test      esi,esi
	mov       ebp,ecx
	jne       @31
	mov       eax,1
	jmp       @32
@31:    test      ebp,ebp
	jbe       @34
@33:    cmp       ebp,5552
	jae        @35
	mov       eax,ebp
	jmp        @36
@35:    mov       eax,5552
@36:    sub       ebp,eax
	cmp       eax,16
	jl        @38
	xor       edx,edx
	xor       ecx,ecx
@39:    sub       eax,16
	mov       dl,[esi]
	mov       cl,[esi+1]
	add       ebx,edx
	add       edi,ebx
	add       ebx,ecx
	mov       dl,[esi+2]
	add       edi,ebx
	add       ebx,edx
	mov       cl,[esi+3]
	add       edi,ebx
	add       ebx,ecx
	mov       dl,[esi+4]
	add       edi,ebx
	add       ebx,edx
	mov       cl,[esi+5]
	add       edi,ebx
	add       ebx,ecx
	mov       dl,[esi+6]
	add       edi,ebx
	add       ebx,edx
	mov       cl,[esi+7]
	add       edi,ebx
	add       ebx,ecx
	mov       dl,[esi+8]
	add       edi,ebx
	add       ebx,edx
	mov       cl,[esi+9]
	add       edi,ebx
	add       ebx,ecx
	mov       dl,[esi+10]
	add       edi,ebx
	add       ebx,edx
	mov       cl,[esi+11]
	add       edi,ebx
	add       ebx,ecx
	mov       dl,[esi+12]
	add       edi,ebx
	add       ebx,edx
	mov       cl,[esi+13]
	add       edi,ebx
	add       ebx,ecx
	mov       dl,[esi+14]
	add       edi,ebx
	add       ebx,edx
	mov       cl,[esi+15]
	add       edi,ebx
	add       ebx,ecx
	cmp       eax,16
	lea       esi,[esi+16]
	lea       edi,[edi+ebx]
	jge       @39
@38:    test      eax,eax
	je         @42
@43:    movzx     edx,byte ptr [esi]
	add       ebx,edx
	dec       eax
	lea       esi,[esi+1]
        lea       edi,[edi+ebx]
	jg        @43
@42:    mov       ecx,65521
	mov       eax,ebx
	xor       edx,edx
	div       ecx
	mov       ebx,edx
	mov       ecx,65521
	mov       eax,edi
	xor       edx,edx
	div       ecx
	test      ebp,ebp
	mov       edi,edx
	ja        @33
@34:    mov       eax,edi
	shl       eax,16
	or        eax,ebx
@45:@32:pop       ebp
	pop       edi
	pop       esi
	pop       ebx
end;
{$endif}

function Adler32SelfTest: boolean;
begin


  result := (Adler32Asm(1,@Te0,sizeof(Te0))=Adler32Pas(1,@Te0,sizeof(Te0))) and
    (Adler32Asm(7,@Te1,sizeof(Te1)-3)=Adler32Pas(7,@Te1,sizeof(Te1)-3));



end;


{ TAESWriteStream }

constructor TAESWriteStream.Create(outStream: TStream; const Key; KeySize: cardinal);
begin
................................................................................
begin
  p := @buffer;
  // Update byte count
  t := bytes[0];
  Inc(bytes[0], len);
  if bytes[0]<t then
    Inc(bytes[1]);  // Carry from low to high
  t := 64 - (t and $3f);  // Space available in in (at least 1)
  if t>len then begin
    Move(p^, Pointer(PtrUInt(@in_) + 64 - t)^, len);
    Exit;
  end;
  // First chunk is an odd size
  Move(p^, Pointer(PtrUInt(@in_) + 64 - t)^, t);
  MD5Transform(buf, in_);
................................................................................
  with TSHAContext(Context) do begin
    A := Hash.A;
    B := Hash.B;
    C := Hash.C;
    D := Hash.D;
    E := Hash.E;
  end;

  // unrolled loop -> all is computed in cpu registers
  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 0]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[ 1]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[ 2]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[ 3]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[ 4]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 5]); B:= (B shl 30) or (B shr 2);
................................................................................
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[73]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[74]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[75]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[76]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[77]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[78]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[79]); C:= (C shl 30) or (C shr 2);

  // Calculate new working hash
  with TSHAContext(Context) do begin
    inc(Hash.A,A);
    inc(Hash.B,B);
    inc(Hash.C,C);
    inc(Hash.D,D);
    inc(Hash.E,E);
................................................................................
var RC4: TRC4;
    Dat: array[0..9] of byte;
    Backup: TRC4InternalKey;
begin
  RC4.Init(Test1,8);
  RC4.Encrypt(Test1,Dat,8);
  result := CompareMem(@Dat,@Res1,sizeof(Res1));
  if not result then exit;
  RC4.Init(Key2,4);
  RC4.Encrypt(Test2,Dat,10);
  result := CompareMem(@Dat,@Res2,sizeof(Res2));
  if not result then exit;
  RC4.Init(Key,sizeof(Key));
  RC4.Encrypt(InDat,Dat,sizeof(InDat));
  result := CompareMem(@Dat,@OutDat,sizeof(OutDat));
  if not result then exit;
  RC4.Init(Key,sizeof(Key));
  RC4.SaveKey(Backup);
  RC4.Encrypt(InDat,Dat,sizeof(InDat));
  result := CompareMem(@Dat,@OutDat,sizeof(OutDat));
  if not result then exit;
  RC4.RestoreKey(Backup);
  RC4.Encrypt(InDat,Dat,sizeof(InDat));
  result := CompareMem(@Dat,@OutDat,sizeof(OutDat));
  if not result then exit;
  RC4.RestoreKey(Backup);
  RC4.Encrypt(OutDat,Dat,sizeof(InDat));
  result := CompareMem(@Dat,@InDat,sizeof(OutDat));
end;


procedure CompressShaAesSetKey(const Key: RawByteString; const IV: RawByteString='');
var IV256: TSHA256Digest;
begin
  if Key='' then







>







 







|
>







 







>







 







|
|
|







 







>







 







>
>
>
>
>
>
>
>







 







|



>
>
>







 







<
<

|











>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|

>
>
>
>
>
>
>
>
>
>
>
>



|







 







|



|







 







|




|







 







|







 







|
|







 







<
<

<
<
<
<
<
<
<
<
<
<
>
|
<
<
<
<
<
<


|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|





>
>
|
|
>
>
>







 







|







 







<







 







<







 







<


|
<


|
<



|
<


|
<


|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
...
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
...
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
...
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
....
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
....
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
....
3198
3199
3200
3201
3202
3203
3204


3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
....
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
....
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
....
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
....
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
....
4780
4781
4782
4783
4784
4785
4786


4787










4788
4789






4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
....
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
....
5335
5336
5337
5338
5339
5340
5341

5342
5343
5344
5345
5346
5347
5348
....
5416
5417
5418
5419
5420
5421
5422

5423
5424
5425
5426
5427
5428
5429
....
6059
6060
6061
6062
6063
6064
6065

6066
6067
6068

6069
6070
6071

6072
6073
6074
6075

6076
6077
6078

6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2015
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  - Wolfgang Ehrhardt under zlib license for AES "pure pascal" versions
  - Intel's sha256_sse4.asm under under a three-clause Open Software license

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
................................................................................
       XorOffset  368 MB/s
        XorConst  510 MB/s

   Conclusion:
   - USETHREADSFORBIGAESBLOCKS will help on modern multi-threaded CPU
   - AES speed: W.Ehrhardt's pascal is 55MB/s, A.Bouchez's asm is 84MB/s
   - AES-256 is faster than a simple XOR() on a dedibox with a C7 cpu ;)
   - see below for benchmarks using AES-NI or SHA-256-SSE4, which induce
     a huge performance boost

   Initial version (C) 2008-2009 Arnaud Bouchez http://bouchez.info

   Revision History:

   Version 1.0
    - initial release on Internet, with MyCrypto unit name
................................................................................
   - added pure pascal version (for XE2 64 compilation) of all algorithms

   Version 1.18
   - added AES-NI hardware support on newer CPUs, for huge performance boost
     and enhanced security
   - tested compilation for Win64 platform
   - run with FPC under Win32 and Linux (including AES-NI support), and Kylix
   - added Intel's SSE4 x64 optimized asm for SHA-256 on Win64
   - added overloaded procedure TMD5.Final() and function SHA256()
   - introduce ESynCrypto exception class dedicated to this unit
   - added AES encryption using official Microsoft AES Cryptographic Provider
     (CryptoAPI) via TAESECB_API, TAESCBC_API, TAESCFB_API and TAESOFB_API -
     our optimized asm version is faster, so is still our default/preferred
   - added CompressShaAes() and global CompressShaAesKey, CompressShaAesIV and
     CompressShaAesClass variables to be used by THttpSocket.RegisterCompress
................................................................................

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

{.$define USEPADLOCK}

{.$define PUREPASCAL} // for debug

{$ifdef Linux}
  {$undef USETHREADSFORBIGAESBLOCKS} // uses low-level WinAPI threading
  {.$define USEPADLOCK} // dedibox linux tested only, but may be OK on Windows
{$else}
  {$ifdef CONDITIONALEXPRESSIONS}
    // on Windows: enable Microsoft AES Cryptographic Provider (XP SP3 and up)
    {$define USE_PROV_RSA_AES}
  {$endif}
  // on Windows: will use Threads for very big blocks (>512KB) if multi-CPU
  {$define USETHREADSFORBIGAESBLOCKS}
................................................................................
/// simple Adler32 implementation
// - a bit slower than Adler32Asm() version below, but shorter code size
function Adler32Pas(Adler: cardinal; p: pointer; Count: Integer): cardinal;

/// fast Adler32 implementation
// - 16-bytes-chunck unrolled asm version
function Adler32Asm(Adler: cardinal; p: pointer; Count: Integer): cardinal;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

// - very fast XOR according to Cod - not Compression or Stream compatible
// - used in AESFull() for KeySize=32
procedure XorBlock(p: PIntegerArray; Count, Cod: integer);

/// fast and simple XOR Cypher using Index (=Position in Dest Stream)
// - Compression not compatible with this function: should be applied after
................................................................................
begin
//  result := true; exit;
  result := SingleTest('abc', D1) and
     SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq', D2);
  if not result then exit;
  SHA256Weak('lagrangehommage',Digest); // test with len=256>64
  result := Comparemem(@Digest,@D3,sizeof(Digest));
  {$ifdef CPU64}
  if cfSSE41 in CpuFeatures then begin
    Exclude(CpuFeatures,cfSSE41);
    result := result and SingleTest('abc', D1) and
       SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq', D2);
    Include(CpuFeatures,cfSSE41);
  end
  {$endif}
end;

function MD5(const s: RawByteString): RawUTF8;
begin
  result := MD5DigestToString(MD5Buf(s[1],length(s)));
end;

................................................................................
  {$endif}
  bIn := pIn;
  bOut := pOut;
  WaitForMultipleObjects(nThread,@Handle[0],True,INFINITE);
  for i := 0 to nThread-1 do
    CloseHandle(Handle[i]);
end;
{$endif USETHREADSFORBIGAESBLOCKS}


{ TSHA256 }

// under Win32, with a Core i7 CPU: pure pascal: 152ms - x86: 112ms
// under Win64, with a Core i7 CPU: pure pascal: 202ms - SSE4: 78ms

procedure Sha256ExpandMessageBlocks(W, Buf: PIntegerArray);
// Calculate "expanded message blocks"
{$ifdef PUREPASCAL}
var i: integer;
begin
  for i := 0 to 15 do
................................................................................
     jnz   @@2
     pop   ebx
     pop   edi
     pop   esi
end;
{$endif}



const
  K256: array[0..63] of cardinal = (
   $428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1,
   $923f82a4, $ab1c5ed5, $d807aa98, $12835b01, $243185be, $550c7dc3,
   $72be5d74, $80deb1fe, $9bdc06a7, $c19bf174, $e49b69c1, $efbe4786,
   $0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da,
   $983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147,
   $06ca6351, $14292967, $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13,
   $650a7354, $766a0abb, $81c2c92e, $92722c85, $a2bfe8a1, $a81a664b,
   $c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070,
   $19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a,
   $5b9cca4f, $682e6ff3, $748f82ee, $78a5636f, $84c87814, $8cc70208,
   $90befffa, $a4506ceb, $bef9a3f7, $c67178f2);

{$ifdef CPU64}
// optimized unrolled version from Intel's sha256_sse4.asm
//  Original code is released as Copyright (c) 2012, Intel Corporation
var
  K256Aligned: RawByteString; // movdqa + paddd do expect 16 bytes alignment
const
  PSHUFFLE_BYTE_FLIP_MASK: array[0..1] of QWord =
    ($0405060700010203,$0C0D0E0F08090A0B);
  _SHUF_00BA: array[0..1] of QWord =
    ($B0A090803020100, $FFFFFFFFFFFFFFFF);
  _SHUF_DC00: array[0..1] of QWord =
    ($FFFFFFFFFFFFFFFF,$B0A090803020100);
  STACK_SIZE = 32{$ifndef LINUX}+7*16{$endif};

procedure sha256_sse4(var input_data; var digest; num_blks: PtrUInt);
  {$ifdef FPC}nostackframe; assembler;{$endif}
asm // rcx=input_data rdx=digest r8=num_blks
        {$ifdef CPUX64}
        .NOFRAME
        {$endif}
        push    rbx
        {$ifndef LINUX}
        push    rsi
        push    rdi
        {$endif}
        push    rbp
        push    r13
        push    r14
        push    r15
        sub     rsp,STACK_SIZE
        {$ifndef LINUX}
        movdqa  [rsp+20H],xmm6    // manual .PUSHNV for FPC compatibility
        movdqa  [rsp+30H],xmm7
        movdqa  [rsp+40H],xmm8
        movdqa  [rsp+50H],xmm9
        movdqa  [rsp+60H],xmm10
        movdqa  [rsp+70H],xmm11
        movdqa  [rsp+80H],xmm12
        {$endif}
        shl     r8,6
        je      @done
        add     r8,rcx
        mov     [rsp],r8
        mov     eax,[rdx]
        mov     ebx,[rdx+4H]
        mov     edi,[rdx+8H]
        mov     esi,[rdx+0CH]
        mov     r8d,[rdx+10H]
        mov     r9d,[rdx+14H]
        mov     r10d,[rdx+18H]
        mov     r11d,[rdx+1CH]
        movdqu  xmm12,[PSHUFFLE_BYTE_FLIP_MASK]
        movdqu  xmm10,[_SHUF_00BA]
        movdqu  xmm11,[_SHUF_DC00]
@loop0: mov     rbp,[K256Aligned]
        movdqu  xmm4,[rcx]
        pshufb  xmm4,xmm12
        movdqu  xmm5,[rcx+10H]
        pshufb  xmm5,xmm12
        movdqu  xmm6,[rcx+20H]
        pshufb  xmm6,xmm12
        movdqu  xmm7,[rcx+30H]
        pshufb  xmm7,xmm12
        mov     [rsp+8H],rcx
        mov     rcx,3
        nop; nop; nop; nop; nop // manual align 16
@loop1: movdqa  xmm9,[rbp]
        paddd   xmm9,xmm4
        movdqa  [rsp+10H],xmm9
        movdqa  xmm0,xmm7
        mov     r13d,r8d
        ror     r13d,14                                
        mov     r14d,eax                               
        palignr xmm0,xmm6,04H
        ror     r14d,9
        xor     r13d,r8d                               
        mov     r15d,r9d                               
        ror     r13d,5                                 
        movdqa  xmm1,xmm5                              
        xor     r14d,eax                               
        xor     r15d,r10d                              
        paddd   xmm0,xmm4                              
        xor     r13d,r8d                               
        and     r15d,r8d                               
        ror     r14d,11                                
        palignr xmm1,xmm4,04H                         
        xor     r14d,eax                               
        ror     r13d,6                                 
        xor     r15d,r10d                              
        movdqa  xmm2,xmm1                              
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+10H]
        movdqa  xmm3,xmm1                              
        mov     r13d,eax                               
        add     r11d,r15d                              
        mov     r15d,eax                               
        pslld   xmm1,25                                
        or      r13d,edi                               
        add     esi,r11d                               
        and     r15d,edi                               
        psrld   xmm2,7                                 
        and     r13d,ebx                               
        add     r11d,r14d                              
        por     xmm1,xmm2                              
        or      r13d,r15d                              
        add     r11d,r13d                              
        movdqa  xmm2,xmm3                              
        mov     r13d,esi                               
        mov     r14d,r11d                              
        movdqa  xmm8,xmm3                              
        ror     r13d,14
        xor     r13d,esi                               
        mov     r15d,r8d                               
        ror     r14d,9                                 
        pslld   xmm3,14                                
        xor     r14d,r11d                              
        ror     r13d,5                                 
        xor     r15d,r9d
        psrld   xmm2,18
        ror     r14d,11                                
        xor     r13d,esi                               
        and     r15d,esi                               
        ror     r13d,6
        pxor    xmm1,xmm3                              
        xor     r14d,r11d                              
        xor     r15d,r9d                               
        psrld   xmm8,3                                 
        add     r15d,r13d                              
        add     r15d,[rsp+14H]
        ror     r14d,2                                 
        pxor    xmm1,xmm2                              
        mov     r13d,r11d                              
        add     r10d,r15d                              
        mov     r15d,r11d
        pxor    xmm1,xmm8                              
        or      r13d,ebx                               
        add     edi,r10d                               
        and     r15d,ebx                               
        pshufd  xmm2,xmm7,0FAH                        
        and     r13d,eax                               
        add     r10d,r14d                              
        paddd   xmm0,xmm1                              
        or      r13d,r15d                              
        add     r10d,r13d                              
        movdqa  xmm3,xmm2                              
        mov     r13d,edi                               
        mov     r14d,r10d                              
        ror     r13d,14                                
        movdqa  xmm8,xmm2                              
        xor     r13d,edi                               
        ror     r14d,9                                 
        mov     r15d,esi                               
        xor     r14d,r10d                              
        ror     r13d,5                                 
        psrlq   xmm2,17                                
        xor     r15d,r8d                               
        psrlq   xmm3,19                                
        xor     r13d,edi                               
        and     r15d,edi                               
        psrld   xmm8,10
        ror     r14d,11                                
        xor     r14d,r10d                              
        xor     r15d,r8d                               
        ror     r13d,6                                 
        pxor    xmm2,xmm3                              
        add     r15d,r13d                              
        ror     r14d,2
        add     r15d,[rsp+18H]
        pxor    xmm8,xmm2                              
        mov     r13d,r10d                              
        add     r9d,r15d                               
        mov     r15d,r10d
        pshufb  xmm8,xmm10                             
        or      r13d,eax                               
        add     ebx,r9d                                
        and     r15d,eax                               
        paddd   xmm0,xmm8                              
        and     r13d,r11d                              
        add     r9d,r14d                               
        pshufd  xmm2,xmm0,50H                         
        or      r13d,r15d                              
        add     r9d,r13d                               
        movdqa  xmm3,xmm2                              
        mov     r13d,ebx                               
        ror     r13d,14                                
        mov     r14d,r9d                               
        movdqa  xmm4,xmm2                              
        ror     r14d,9                                 
        xor     r13d,ebx                               
        mov     r15d,edi                               
        ror     r13d,5                                 
        psrlq   xmm2,17                                
        xor     r14d,r9d                               
        xor     r15d,esi                               
        psrlq   xmm3,19
        xor     r13d,ebx                               
        and     r15d,ebx                               
        ror     r14d,11                                
        psrld   xmm4,10                                
        xor     r14d,r9d                               
        ror     r13d,6                                 
        xor     r15d,esi                               
        pxor    xmm2,xmm3                              
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+1CH]
        pxor    xmm4,xmm2                              
        mov     r13d,r9d                               
        add     r8d,r15d
        mov     r15d,r9d                               
        pshufb  xmm4,xmm11                             
        or      r13d,r11d                              
        add     eax,r8d                                
        and     r15d,r11d                              
        paddd   xmm4,xmm0                              
        and     r13d,r10d
        add     r8d,r14d
        or      r13d,r15d                              
        add     r8d,r13d                               
        movdqa  xmm9,[rbp+10H]
        paddd   xmm9,xmm5
        movdqa  [rsp+10H],xmm9
        movdqa  xmm0,xmm4                              
        mov     r13d,eax                               
        ror     r13d,14                                
        mov     r14d,r8d                               
        palignr xmm0,xmm7,04H                         
        ror     r14d,9                                 
        xor     r13d,eax                               
        mov     r15d,ebx                               
        ror     r13d,5                                 
        movdqa  xmm1,xmm6                              
        xor     r14d,r8d                               
        xor     r15d,edi                               
        paddd   xmm0,xmm5                              
        xor     r13d,eax                               
        and     r15d,eax                               
        ror     r14d,11                                
        palignr xmm1,xmm5,04H                         
        xor     r14d,r8d                               
        ror     r13d,6                                 
        xor     r15d,edi                               
        movdqa  xmm2,xmm1                              
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+10H]
        movdqa  xmm3,xmm1                              
        mov     r13d,r8d                               
        add     esi,r15d                               
        mov     r15d,r8d                               
        pslld   xmm1,25                                
        or      r13d,r10d                              
        add     r11d,esi                               
        and     r15d,r10d                              
        psrld   xmm2,7                                 
        and     r13d,r9d
        add     esi,r14d                               
        por     xmm1,xmm2
        or      r13d,r15d                              
        add     esi,r13d                               
        movdqa  xmm2,xmm3                              
        mov     r13d,r11d                              
        mov     r14d,esi                               
        movdqa  xmm8,xmm3                              
        ror     r13d,14
        xor     r13d,r11d
        mov     r15d,eax                               
        ror     r14d,9                                 
        pslld   xmm3,14                                
        xor     r14d,esi
        ror     r13d,5                                 
        xor     r15d,ebx                               
        psrld   xmm2,18                                
        ror     r14d,11                                
        xor     r13d,r11d                              
        and     r15d,r11d                              
        ror     r13d,6                                 
        pxor    xmm1,xmm3                              
        xor     r14d,esi                               
        xor     r15d,ebx                               
        psrld   xmm8,3                                 
        add     r15d,r13d                              
        add     r15d,[rsp+14H]
        ror     r14d,2                                 
        pxor    xmm1,xmm2                              
        mov     r13d,esi                               
        add     edi,r15d                               
        mov     r15d,esi                               
        pxor    xmm1,xmm8                              
        or      r13d,r9d                               
        add     r10d,edi                               
        and     r15d,r9d                               
        pshufd  xmm2,xmm4,0FAH                        
        and     r13d,r8d                               
        add     edi,r14d                               
        paddd   xmm0,xmm1                              
        or      r13d,r15d                              
        add     edi,r13d                               
        movdqa  xmm3,xmm2                              
        mov     r13d,r10d                              
        mov     r14d,edi                               
        ror     r13d,14                                
        movdqa  xmm8,xmm2                              
        xor     r13d,r10d                              
        ror     r14d,9                                 
        mov     r15d,r11d                              
        xor     r14d,edi
        ror     r13d,5                                 
        psrlq   xmm2,17                                
        xor     r15d,eax                               
        psrlq   xmm3,19                                
        xor     r13d,r10d                              
        and     r15d,r10d                              
        psrld   xmm8,10
        ror     r14d,11
        xor     r14d,edi                               
        xor     r15d,eax
        ror     r13d,6                                 
        pxor    xmm2,xmm3
        add     r15d,r13d                              
        ror     r14d,2                                 
        add     r15d,[rsp+18H]
        pxor    xmm8,xmm2                              
        mov     r13d,edi                               
        add     ebx,r15d                               
        mov     r15d,edi                               
        pshufb  xmm8,xmm10                             
        or      r13d,r8d                               
        add     r9d,ebx                                
        and     r15d,r8d                               
        paddd   xmm0,xmm8                              
        and     r13d,esi                               
        add     ebx,r14d                               
        pshufd  xmm2,xmm0,50H                         
        or      r13d,r15d                              
        add     ebx,r13d                               
        movdqa  xmm3,xmm2                              
        mov     r13d,r9d                               
        ror     r13d,14                                
        mov     r14d,ebx                               
        movdqa  xmm5,xmm2                              
        ror     r14d,9                                 
        xor     r13d,r9d                               
        mov     r15d,r10d                              
        ror     r13d,5                                 
        psrlq   xmm2,17                                
        xor     r14d,ebx                               
        xor     r15d,r11d                              
        psrlq   xmm3,19                                
        xor     r13d,r9d                               
        and     r15d,r9d                               
        ror     r14d,11                                
        psrld   xmm5,10                                
        xor     r14d,ebx                               
        ror     r13d,6                                 
        xor     r15d,r11d
        pxor    xmm2,xmm3                              
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+1CH]
        pxor    xmm5,xmm2                              
        mov     r13d,ebx                               
        add     eax,r15d
        mov     r15d,ebx
        pshufb  xmm5,xmm11                             
        or      r13d,esi                               
        add     r8d,eax                                
        and     r15d,esi
        paddd   xmm5,xmm0                              
        and     r13d,edi                               
        add     eax,r14d                               
        or      r13d,r15d                              
        add     eax,r13d                               
        movdqa  xmm9,[rbp+20H]
        paddd   xmm9,xmm6                              
        movdqa  [rsp+10H],xmm9
        movdqa  xmm0,xmm5                              
        mov     r13d,r8d
        ror     r13d,14                                
        mov     r14d,eax                               
        palignr xmm0,xmm4,04H                         
        ror     r14d,9                                 
        xor     r13d,r8d                               
        mov     r15d,r9d                               
        ror     r13d,5                                 
        movdqa  xmm1,xmm7                              
        xor     r14d,eax                               
        xor     r15d,r10d                              
        paddd   xmm0,xmm6                              
        xor     r13d,r8d                               
        and     r15d,r8d                               
        ror     r14d,11                                
        palignr xmm1,xmm6,04H                         
        xor     r14d,eax                               
        ror     r13d,6                                 
        xor     r15d,r10d                              
        movdqa  xmm2,xmm1                              
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+10H]
        movdqa  xmm3,xmm1                              
        mov     r13d,eax                               
        add     r11d,r15d                              
        mov     r15d,eax                               
        pslld   xmm1,25
        or      r13d,edi                               
        add     esi,r11d                               
        and     r15d,edi                               
        psrld   xmm2,7                                 
        and     r13d,ebx                               
        add     r11d,r14d                              
        por     xmm1,xmm2
        or      r13d,r15d
        add     r11d,r13d                              
        movdqa  xmm2,xmm3                              
        mov     r13d,esi                               
        mov     r14d,r11d
        movdqa  xmm8,xmm3                              
        ror     r13d,14                                
        xor     r13d,esi                               
        mov     r15d,r8d                               
        ror     r14d,9                                 
        pslld   xmm3,14                                
        xor     r14d,r11d                              
        ror     r13d,5                                 
        xor     r15d,r9d                               
        psrld   xmm2,18                                
        ror     r14d,11                                
        xor     r13d,esi                               
        and     r15d,esi                               
        ror     r13d,6                                 
        pxor    xmm1,xmm3                              
        xor     r14d,r11d                              
        xor     r15d,r9d                               
        psrld   xmm8,3                                 
        add     r15d,r13d                              
        add     r15d,[rsp+14H]
        ror     r14d,2                                 
        pxor    xmm1,xmm2
        mov     r13d,r11d                              
        add     r10d,r15d                              
        mov     r15d,r11d                              
        pxor    xmm1,xmm8                              
        or      r13d,ebx                               
        add     edi,r10d                               
        and     r15d,ebx                               
        pshufd  xmm2,xmm5,0FAH                        
        and     r13d,eax                               
        add     r10d,r14d                              
        paddd   xmm0,xmm1                              
        or      r13d,r15d                              
        add     r10d,r13d                              
        movdqa  xmm3,xmm2                              
        mov     r13d,edi
        mov     r14d,r10d                              
        ror     r13d,14                                
        movdqa  xmm8,xmm2                              
        xor     r13d,edi                               
        ror     r14d,9                                 
        mov     r15d,esi                               
        xor     r14d,r10d
        ror     r13d,5
        psrlq   xmm2,17                                
        xor     r15d,r8d                               
        psrlq   xmm3,19                                
        xor     r13d,edi
        and     r15d,edi                               
        psrld   xmm8,10                                
        ror     r14d,11                                
        xor     r14d,r10d                              
        xor     r15d,r8d                               
        ror     r13d,6                                 
        pxor    xmm2,xmm3                              
        add     r15d,r13d                              
        ror     r14d,2                                 
        add     r15d,[rsp+18H]
        pxor    xmm8,xmm2                              
        mov     r13d,r10d                              
        add     r9d,r15d                               
        mov     r15d,r10d                              
        pshufb  xmm8,xmm10                             
        or      r13d,eax                               
        add     ebx,r9d                                
        and     r15d,eax                               
        paddd   xmm0,xmm8                              
        and     r13d,r11d                              
        add     r9d,r14d                               
        pshufd  xmm2,xmm0,50H                         
        or      r13d,r15d                              
        add     r9d,r13d                               
        movdqa  xmm3,xmm2                              
        mov     r13d,ebx                               
        ror     r13d,14                                
        mov     r14d,r9d                               
        movdqa  xmm6,xmm2                              
        ror     r14d,9                                 
        xor     r13d,ebx                               
        mov     r15d,edi                               
        ror     r13d,5                                 
        psrlq   xmm2,17
        xor     r14d,r9d                               
        xor     r15d,esi                               
        psrlq   xmm3,19
        xor     r13d,ebx                               
        and     r15d,ebx                               
        ror     r14d,11                                
        psrld   xmm6,10                                
        xor     r14d,r9d                               
        ror     r13d,6                                 
        xor     r15d,esi
        pxor    xmm2,xmm3
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+1CH]
        pxor    xmm6,xmm2
        mov     r13d,r9d                               
        add     r8d,r15d                               
        mov     r15d,r9d                               
        pshufb  xmm6,xmm11                             
        or      r13d,r11d                              
        add     eax,r8d                                
        and     r15d,r11d                              
        paddd   xmm6,xmm0                              
        and     r13d,r10d                              
        add     r8d,r14d                               
        or      r13d,r15d                              
        add     r8d,r13d                               
        movdqa  xmm9,[rbp+30H]
        paddd   xmm9,xmm7                              
        movdqa  [rsp+10H],xmm9
        add     rbp,64                                 
        movdqa  xmm0,xmm6                              
        mov     r13d,eax                               
        ror     r13d,14                                
        mov     r14d,r8d                               
        palignr xmm0,xmm5,04H                         
        ror     r14d,9                                 
        xor     r13d,eax                               
        mov     r15d,ebx                               
        ror     r13d,5                                 
        movdqa  xmm1,xmm4                              
        xor     r14d,r8d                               
        xor     r15d,edi                               
        paddd   xmm0,xmm7                              
        xor     r13d,eax                               
        and     r15d,eax                               
        ror     r14d,11                                
        palignr xmm1,xmm7,04H                         
        xor     r14d,r8d                               
        ror     r13d,6                                 
        xor     r15d,edi                               
        movdqa  xmm2,xmm1
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+10H]
        movdqa  xmm3,xmm1                              
        mov     r13d,r8d                               
        add     esi,r15d                               
        mov     r15d,r8d
        pslld   xmm1,25
        or      r13d,r10d
        add     r11d,esi                               
        and     r15d,r10d                              
        psrld   xmm2,7
        and     r13d,r9d                               
        add     esi,r14d                               
        por     xmm1,xmm2                              
        or      r13d,r15d                              
        add     esi,r13d                               
        movdqa  xmm2,xmm3                              
        mov     r13d,r11d                              
        mov     r14d,esi                               
        movdqa  xmm8,xmm3                              
        ror     r13d,14                                
        xor     r13d,r11d                              
        mov     r15d,eax                               
        ror     r14d,9                                 
        pslld   xmm3,14                                
        xor     r14d,esi                               
        ror     r13d,5                                 
        xor     r15d,ebx                               
        psrld   xmm2,18                                
        ror     r14d,11                                
        xor     r13d,r11d                              
        and     r15d,r11d                              
        ror     r13d,6                                 
        pxor    xmm1,xmm3                              
        xor     r14d,esi                               
        xor     r15d,ebx                               
        psrld   xmm8,3                                 
        add     r15d,r13d                              
        add     r15d,[rsp+14H]
        ror     r14d,2                                 
        pxor    xmm1,xmm2                              
        mov     r13d,esi                               
        add     edi,r15d                               
        mov     r15d,esi                               
        pxor    xmm1,xmm8                              
        or      r13d,r9d                               
        add     r10d,edi                               
        and     r15d,r9d
        pshufd  xmm2,xmm6,0FAH                        
        and     r13d,r8d                               
        add     edi,r14d                               
        paddd   xmm0,xmm1                              
        or      r13d,r15d                              
        add     edi,r13d                               
        movdqa  xmm3,xmm2
        mov     r13d,r10d
        mov     r14d,edi                               
        ror     r13d,14                                
        movdqa  xmm8,xmm2                              
        xor     r13d,r10d
        ror     r14d,9                                 
        mov     r15d,r11d                              
        xor     r14d,edi                               
        ror     r13d,5                                 
        psrlq   xmm2,17                                
        xor     r15d,eax                               
        psrlq   xmm3,19                                
        xor     r13d,r10d                              
        and     r15d,r10d
        psrld   xmm8,10                                
        ror     r14d,11                                
        xor     r14d,edi                               
        xor     r15d,eax                               
        ror     r13d,6                                 
        pxor    xmm2,xmm3                              
        add     r15d,r13d                              
        ror     r14d,2                                 
        add     r15d,[rsp+18H]
        pxor    xmm8,xmm2                              
        mov     r13d,edi                               
        add     ebx,r15d                               
        mov     r15d,edi                               
        pshufb  xmm8,xmm10                             
        or      r13d,r8d                               
        add     r9d,ebx                                
        and     r15d,r8d                               
        paddd   xmm0,xmm8                              
        and     r13d,esi
        add     ebx,r14d                               
        pshufd  xmm2,xmm0,50H                         
        or      r13d,r15d                              
        add     ebx,r13d                               
        movdqa  xmm3,xmm2                              
        mov     r13d,r9d                               
        ror     r13d,14                                
        mov     r14d,ebx                               
        movdqa  xmm7,xmm2
        ror     r14d,9                                 
        xor     r13d,r9d                               
        mov     r15d,r10d                              
        ror     r13d,5                                 
        psrlq   xmm2,17                                
        xor     r14d,ebx                               
        xor     r15d,r11d
        psrlq   xmm3,19
        xor     r13d,r9d                               
        and     r15d,r9d                               
        ror     r14d,11                                
        psrld   xmm7,10
        xor     r14d,ebx                               
        ror     r13d,6                                 
        xor     r15d,r11d                              
        pxor    xmm2,xmm3                              
        ror     r14d,2                                 
        add     r15d,r13d                              
        add     r15d,[rsp+1CH]
        pxor    xmm7,xmm2                              
        mov     r13d,ebx                               
        add     eax,r15d                               
        mov     r15d,ebx                               
        pshufb  xmm7,xmm11                             
        or      r13d,esi                               
        add     r8d,eax                                
        and     r15d,esi                               
        paddd   xmm7,xmm0                              
        and     r13d,edi                               
        add     eax,r14d                               
        or      r13d,r15d                              
        add     eax,r13d                               
        sub     rcx,1
        jne     @loop1
        mov     rcx,2
@loop2: paddd   xmm4,[rbp]
        movdqa  [rsp+10H],xmm4
        mov     r13d,r8d                               
        ror     r13d,14                                
        mov     r14d,eax
        xor     r13d,r8d
        ror     r14d,9                                 
        mov     r15d,r9d                               
        xor     r14d,eax                               
        ror     r13d,5
        xor     r15d,r10d                              
        xor     r13d,r8d                               
        ror     r14d,11                                
        and     r15d,r8d
        xor     r14d,eax                               
        ror     r13d,6                                 
        xor     r15d,r10d                              
        add     r15d,r13d                              
        ror     r14d,2                                 
        add     r15d,[rsp+10H]
        mov     r13d,eax
        add     r11d,r15d
        mov     r15d,eax                               
        or      r13d,edi                               
        add     esi,r11d                               
        and     r15d,edi
        and     r13d,ebx                               
        add     r11d,r14d                              
        or      r13d,r15d                              
        add     r11d,r13d                              
        mov     r13d,esi                               
        ror     r13d,14                                
        mov     r14d,r11d                              
        xor     r13d,esi                               
        ror     r14d,9                                 
        mov     r15d,r8d                               
        xor     r14d,r11d                              
        ror     r13d,5                                 
        xor     r15d,r9d                               
        xor     r13d,esi                               
        ror     r14d,11                                
        and     r15d,esi                               
        xor     r14d,r11d                              
        ror     r13d,6                                 
        xor     r15d,r9d                               
        add     r15d,r13d                              
        ror     r14d,2                                 
        add     r15d,[rsp+14H]
        mov     r13d,r11d                              
        add     r10d,r15d                              
        mov     r15d,r11d                              
        or      r13d,ebx                               
        add     edi,r10d                               
        and     r15d,ebx
        and     r13d,eax                               
        add     r10d,r14d                              
        or      r13d,r15d                              
        add     r10d,r13d                              
        mov     r13d,edi                               
        ror     r13d,14                                
        mov     r14d,r10d
        xor     r13d,edi                               
        ror     r14d,9
        mov     r15d,esi                               
        xor     r14d,r10d                              
        ror     r13d,5                                 
        xor     r15d,r8d                               
        xor     r13d,edi                               
        ror     r14d,11                                
        and     r15d,edi
        xor     r14d,r10d
        ror     r13d,6                                 
        xor     r15d,r8d                               
        add     r15d,r13d                              
        ror     r14d,2
        add     r15d,[rsp+18H]
        mov     r13d,r10d                              
        add     r9d,r15d                               
        mov     r15d,r10d                              
        or      r13d,eax                               
        add     ebx,r9d                                
        and     r15d,eax                               
        and     r13d,r11d                              
        add     r9d,r14d                               
        or      r13d,r15d                              
        add     r9d,r13d                               
        mov     r13d,ebx                               
        ror     r13d,14                                
        mov     r14d,r9d                               
        xor     r13d,ebx                               
        ror     r14d,9                                 
        mov     r15d,edi                               
        xor     r14d,r9d                               
        ror     r13d,5                                 
        xor     r15d,esi                               
        xor     r13d,ebx                               
        ror     r14d,11                                
        and     r15d,ebx                               
        xor     r14d,r9d                               
        ror     r13d,6                                 
        xor     r15d,esi                               
        add     r15d,r13d
        ror     r14d,2
        add     r15d,[rsp+1CH]
        mov     r13d,r9d                               
        add     r8d,r15d                               
        mov     r15d,r9d                               
        or      r13d,r11d                              
        add     eax,r8d                                
        and     r15d,r11d                              
        and     r13d,r10d                              
        add     r8d,r14d
        or      r13d,r15d                              
        add     r8d,r13d                               
        paddd   xmm5,[rbp+10H]
        movdqa  [rsp+10H],xmm5
        add     rbp,32                                 
        mov     r13d,eax                               
        ror     r13d,14
        mov     r14d,r8d
        xor     r13d,eax                               
        ror     r14d,9
        mov     r15d,ebx                               
        xor     r14d,r8d
        ror     r13d,5                                 
        xor     r15d,edi                               
        xor     r13d,eax                               
        ror     r14d,11                                
        and     r15d,eax                               
        xor     r14d,r8d                               
        ror     r13d,6                                 
        xor     r15d,edi                               
        add     r15d,r13d                              
        ror     r14d,2                                 
        add     r15d,[rsp+10H]
        mov     r13d,r8d                               
        add     esi,r15d                               
        mov     r15d,r8d                               
        or      r13d,r10d                              
        add     r11d,esi                               
        and     r15d,r10d                              
        and     r13d,r9d                               
        add     esi,r14d                               
        or      r13d,r15d                              
        add     esi,r13d                               
        mov     r13d,r11d                              
        ror     r13d,14                                
        mov     r14d,esi                               
        xor     r13d,r11d                              
        ror     r14d,9                                 
        mov     r15d,eax
        xor     r14d,esi
        ror     r13d,5                                 
        xor     r15d,ebx                               
        xor     r13d,r11d                              
        ror     r14d,11                                
        and     r15d,r11d                              
        xor     r14d,esi                               
        ror     r13d,6                                 
        xor     r15d,ebx                               
        add     r15d,r13d
        ror     r14d,2                                 
        add     r15d,[rsp+14H]
        mov     r13d,esi                               
        add     edi,r15d                               
        mov     r15d,esi                               
        or      r13d,r9d                               
        add     r10d,edi
        and     r15d,r9d
        and     r13d,r8d                               
        add     edi,r14d                               
        or      r13d,r15d                              
        add     edi,r13d
        mov     r13d,r10d                              
        ror     r13d,14                                
        mov     r14d,edi                               
        xor     r13d,r10d                              
        ror     r14d,9                                 
        mov     r15d,r11d                              
        xor     r14d,edi                               
        ror     r13d,5                                 
        xor     r15d,eax                               
        xor     r13d,r10d
        ror     r14d,11                                
        and     r15d,r10d                              
        xor     r14d,edi                               
        ror     r13d,6                                 
        xor     r15d,eax                               
        add     r15d,r13d                              
        ror     r14d,2                                 
        add     r15d,[rsp+18H]
        mov     r13d,edi                               
        add     ebx,r15d                               
        mov     r15d,edi                               
        or      r13d,r8d                               
        add     r9d,ebx                                
        and     r15d,r8d                               
        and     r13d,esi                               
        add     ebx,r14d                               
        or      r13d,r15d
        add     ebx,r13d
        mov     r13d,r9d                               
        ror     r13d,14                                
        mov     r14d,ebx                               
        xor     r13d,r9d                               
        ror     r14d,9                                 
        mov     r15d,r10d                              
        xor     r14d,ebx                               
        ror     r13d,5                                 
        xor     r15d,r11d
        xor     r13d,r9d                               
        ror     r14d,11                                
        and     r15d,r9d                               
        xor     r14d,ebx                               
        ror     r13d,6                                 
        xor     r15d,r11d                              
        add     r15d,r13d
        ror     r14d,2
        add     r15d,[rsp+1CH]
        mov     r13d,ebx                               
        add     eax,r15d                               
        mov     r15d,ebx
        or      r13d,esi                               
        add     r8d,eax                                
        and     r15d,esi                               
        and     r13d,edi                               
        add     eax,r14d                               
        or      r13d,r15d                              
        add     eax,r13d                               
        movdqa  xmm4,xmm6                              
        movdqa  xmm5,xmm7                              
        dec     rcx
        jne     @loop2
        add     eax,[rdx]
        mov     [rdx],eax
        add     ebx,[rdx+4H]
        add     edi,[rdx+8H]
        add     esi,[rdx+0CH]
        add     r8d,[rdx+10H]
        add     r9d,[rdx+14H]
        add     r10d,[rdx+18H]
        add     r11d,[rdx+1CH]
        mov     [rdx+4H],ebx
        mov     [rdx+8H],edi
        mov     [rdx+0CH],esi
        mov     [rdx+10H],r8d
        mov     [rdx+14H],r9d
        mov     [rdx+18H],r10d
        mov     [rdx+1CH],r11d
        mov     rcx,[rsp+8H]
        add     rcx,64
        cmp     rcx,[rsp]
        jne     @loop0
@done: {$ifndef LINUX}
        movdqa  xmm6,[rsp+20H]
        movdqa  xmm7,[rsp+30H]
        movdqa  xmm8,[rsp+40H]
        movdqa  xmm9,[rsp+50H]
        movdqa  xmm10,[rsp+60H]
        movdqa  xmm11,[rsp+70H]
        movdqa  xmm12,[rsp+80H]
        {$endif}
        add     rsp,STACK_SIZE
        pop     r15
        pop     r14
        pop     r13
        pop     rbp
        {$ifndef LINUX}
        pop     rdi
        pop     rsi
        {$endif}
        pop     rbx
end;
{$endif CPU64}

procedure TSHA256.Compress;
// Actual hashing function
var H: TSHAHash;
    W: array[0..63] of cardinal;
    {$ifdef PUREPASCAL}
    i: integer;
    t1, t2: cardinal;
    {$endif}
begin
  {$ifdef CPU64}
  if cfSSE41 in CpuFeatures then begin
    if K256Aligned='' then begin
      SetString(K256Aligned,PAnsiChar(@K256),SizeOf(K256));
      if PtrUInt(K256ALigned)and 15<>0 then
        raise ESynCrypto.Create('TSHA256.Compress unaligned K256 for x64');
    end;
    sha256_sse4(TSHAContext(Context).Buffer,TSHAContext(Context).Hash,1);
    exit;
  end;
  {$endif CPU64}

  // Calculate "expanded message blocks"
  Sha256ExpandMessageBlocks(@W,@TSHAContext(Context).Buffer);

  // Assign old working hash to local variables A..H
  with TSHAContext(Context) do begin
    H.A := Hash.A;
    H.B := Hash.B;
    H.C := Hash.C;
    H.D := Hash.D;
    H.E := Hash.E;
    H.F := Hash.F;
................................................................................
    H.H := Hash.H;
  end;

{$ifdef PUREPASCAL}
  // SHA256 compression function
  for i := 0 to high(W) do begin
    t1 := H.H+(((H.E shr 6)or(H.E shl 26))xor((H.E shr 11)or(H.E shl 21))xor
      ((H.E shr 25)or(H.E shl 7)))+((H.E and H.F)xor(not H.E and H.G))+K256[i]+W[i];
    t2 := (((H.A shr 2)or(H.A shl 30))xor((H.A shr 13)or(H.A shl 19))xor
      ((H.A shr 22)xor(H.A shl 10)))+((H.A and H.B)xor(H.A and H.C)xor(H.B and H.C));
    H.H := H.G; H.G := H.F; H.F := H.E; H.E := H.D+t1;
    H.D := H.C; H.C := H.B; H.B := H.A; H.A := t1+t2;
  end;
{$else}
  // SHA256 compression function - optimized by A.B. for pipelined CPU
  asm
    push ebx
    push esi
    push edi
................................................................................
    mov  eax,[H].TSHAHash.F
    mov  [H].TSHAHash.H,edx
    mov  [H].TSHAHash.G,eax
    xor  eax,edx
    mov  [H].TSHAHash.F,ebx
    and  eax,ebx
    xor  eax,edx
    add  eax,dword ptr [K256+edi*4]
    add  eax,ecx
    mov  ecx,[H].TSHAHash.D
    add  eax,dword ptr [W+edi*4]
    mov  ebx,[H].TSHAHash.A
    //  eax= T1 := H + Sum1(E) +(((F xor G) and E) xor G)+K256[i]+W[i];
    add  ecx,eax
    mov  esi,eax  // esi = T1
    mov  [H].TSHAHash.E,ecx // E := D + T1;
    mov  eax,ebx // Sum0(A)
    mov  edx,ebx
    ror  eax,2
    mov  ecx,ebx
................................................................................
    mov  [H].TSHAHash.D,eax
    cmp  edi,64
    jnz  @s
    pop  edi
    pop  esi
    pop  ebx
  end;
{$endif PUREPASCAL}

  // Calculate new working hash
  with TSHAContext(Context) do begin
    inc(Hash.A,H.A);
    inc(Hash.B,H.B);
    inc(Hash.C,H.C);
    inc(Hash.D,H.D);
................................................................................
end;

procedure TSHA256.Update(Buffer: pointer; Len: integer);
var Data: TSHAContext absolute Context;
    aLen: integer;
begin
  if Buffer=nil then exit; // avoid GPF
  inc(Data.MLen,Int64(cardinal(Len)) shl 3);
  while Len>0 do begin
    aLen := 64-Data.Index;
    if aLen<=Len then begin
      move(buffer^,Data.Buffer[Data.Index],aLen);
      dec(Len,aLen);
      inc(PtrInt(buffer),aLen);
      Compress;
      Data.Index := 0;
................................................................................
    dec(Count,n);
  end;
  result := word(s1)+cardinal(word(s2)) shl 16;
end;

function Adler32Asm(Adler: cardinal; p: pointer; Count: Integer): cardinal;
{$ifdef PUREPASCAL}


begin










  result := Adler32Pas(Adler,p,Count);
end;






{$else}
asm
    push  ebx
    push  esi
    push  edi
    mov   edi,eax
    shr   edi,16
    movzx ebx,ax
    push  ebp
    mov   esi,edx
    test  esi,esi
    mov   ebp,ecx
    jne   @31
    mov   eax,1
    jmp   @32
@31:test  ebp,ebp
  	jbe   @34
@33:cmp   ebp,5552
    jae    @35
    mov   eax,ebp
    jmp    @36
@35:mov   eax,5552
@36:sub   ebp,eax
    cmp   eax,16
    jl    @38
    xor   edx,edx
    xor   ecx,ecx
@39:sub   eax,16
    mov   dl,[esi]
    mov   cl,[esi+1]
    add   ebx,edx
    add   edi,ebx
    add   ebx,ecx
    mov   dl,[esi+2]
    add   edi,ebx
    add   ebx,edx
    mov   cl,[esi+3]
    add   edi,ebx
    add   ebx,ecx
    mov   dl,[esi+4]
    add   edi,ebx
    add   ebx,edx
    mov   cl,[esi+5]
    add   edi,ebx
    add   ebx,ecx
    mov   dl,[esi+6]
    add   edi,ebx
    add   ebx,edx
    mov   cl,[esi+7]
    add   edi,ebx
    add   ebx,ecx
    mov   dl,[esi+8]
    add   edi,ebx
    add   ebx,edx
    mov   cl,[esi+9]
    add   edi,ebx
    add   ebx,ecx
    mov   dl,[esi+10]
    add   edi,ebx
    add   ebx,edx
    mov   cl,[esi+11]
    add   edi,ebx
    add   ebx,ecx
    mov   dl,[esi+12]
    add   edi,ebx
    add   ebx,edx
    mov   cl,[esi+13]
    add   edi,ebx
    add   ebx,ecx
    mov   dl,[esi+14]
    add   edi,ebx
    add   ebx,edx
    mov   cl,[esi+15]
    add   edi,ebx
    add   ebx,ecx
    cmp   eax,16
    lea   esi,[esi+16]
    lea   edi,[edi+ebx]
    jge   @39
@38:test  eax,eax
  	je    @42
@43:movzx edx,byte ptr [esi]
    add   ebx,edx
    dec   eax
    lea   esi,[esi+1]
    lea   edi,[edi+ebx]
    jg    @43
@42:mov   ecx,65521
    mov   eax,ebx
    xor   edx,edx
    div   ecx
    mov   ebx,edx
    mov   ecx,65521
    mov   eax,edi
    xor   edx,edx
    div   ecx
    test  ebp,ebp
    mov   edi,edx
    ja    @33
@34:mov   eax,edi
    shl   eax,16
    or    eax,ebx
@32:pop   ebp
	  pop   edi
  	pop   esi
  	pop   ebx
end;
{$endif}

function Adler32SelfTest: boolean;
begin
  result :=
  {$ifndef PUREPASCAL}
    (Adler32Asm(1,@Te0,sizeof(Te0))=$BCBEFE10) and
    (Adler32Asm(7,@Te1,sizeof(Te1)-3)=$DA91FDBE) and
  {$endif}
    (Adler32Pas(1,@Te0,sizeof(Te0))=$BCBEFE10) and
    (Adler32Pas(7,@Te1,sizeof(Te1)-3)=$DA91FDBE);
end;


{ TAESWriteStream }

constructor TAESWriteStream.Create(outStream: TStream; const Key; KeySize: cardinal);
begin
................................................................................
begin
  p := @buffer;
  // Update byte count
  t := bytes[0];
  Inc(bytes[0], len);
  if bytes[0]<t then
    Inc(bytes[1]);  // Carry from low to high
  t := 64 - (t and $3f);  // Space available in in_ (at least 1)
  if t>len then begin
    Move(p^, Pointer(PtrUInt(@in_) + 64 - t)^, len);
    Exit;
  end;
  // First chunk is an odd size
  Move(p^, Pointer(PtrUInt(@in_) + 64 - t)^, t);
  MD5Transform(buf, in_);
................................................................................
  with TSHAContext(Context) do begin
    A := Hash.A;
    B := Hash.B;
    C := Hash.C;
    D := Hash.D;
    E := Hash.E;
  end;

  // unrolled loop -> all is computed in cpu registers
  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 0]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[ 1]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[ 2]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[ 3]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[ 4]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 5]); B:= (B shl 30) or (B shr 2);
................................................................................
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[73]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[74]); C:= (C shl 30) or (C shr 2);
  Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[75]); B:= (B shl 30) or (B shr 2);
  Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[76]); A:= (A shl 30) or (A shr 2);
  Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[77]); E:= (E shl 30) or (E shr 2);
  Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[78]); D:= (D shl 30) or (D shr 2);
  Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[79]); C:= (C shl 30) or (C shr 2);

  // Calculate new working hash
  with TSHAContext(Context) do begin
    inc(Hash.A,A);
    inc(Hash.B,B);
    inc(Hash.C,C);
    inc(Hash.D,D);
    inc(Hash.E,E);
................................................................................
var RC4: TRC4;
    Dat: array[0..9] of byte;
    Backup: TRC4InternalKey;
begin
  RC4.Init(Test1,8);
  RC4.Encrypt(Test1,Dat,8);
  result := CompareMem(@Dat,@Res1,sizeof(Res1));

  RC4.Init(Key2,4);
  RC4.Encrypt(Test2,Dat,10);
  result := result and CompareMem(@Dat,@Res2,sizeof(Res2));

  RC4.Init(Key,sizeof(Key));
  RC4.Encrypt(InDat,Dat,sizeof(InDat));
  result := result and CompareMem(@Dat,@OutDat,sizeof(OutDat));

  RC4.Init(Key,sizeof(Key));
  RC4.SaveKey(Backup);
  RC4.Encrypt(InDat,Dat,sizeof(InDat));
  result := result and CompareMem(@Dat,@OutDat,sizeof(OutDat));

  RC4.RestoreKey(Backup);
  RC4.Encrypt(InDat,Dat,sizeof(InDat));
  result := result and CompareMem(@Dat,@OutDat,sizeof(OutDat));

  RC4.RestoreKey(Backup);
  RC4.Encrypt(OutDat,Dat,sizeof(InDat));
  result := result and CompareMem(@Dat,@InDat,sizeof(OutDat));
end;


procedure CompressShaAesSetKey(const Key: RawByteString; const IV: RawByteString='');
var IV256: TSHA256Digest;
begin
  if Key='' then

Changes to SynSelfTests.pas.

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
....
7272
7273
7274
7275
7276
7277
7278


7279
7280
7281
7282
7283
7284
7285
....
7342
7343
7344
7345
7346
7347
7348

7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383

7384
7385
7386
7387
7388
7389
7390



















7391
7392
7393
7394
7395
7396
7397
.....
12449
12450
12451
12452
12453
12454
12455
12456
12457
12458
12459
12460
12461
12462
12463
12464
12465
12466
12467
12468
12469
12470
12471
12472
12473
12474
    /// test via TSQLRestClientURINamedPipe instances
    procedure _TSQLRestClientURINamedPipe;
    /// test via TSQLRestClientURIMessage instances
    procedure _TSQLRestClientURIMessage;
    {$endif}
    {$ifndef ONLYUSEHTTPSOCKET}
    /// test via TSQLHttpClientWinHTTP instances over http.sys (HTTP API) server
    procedure _TSQLHttpClientWinHTTP_HTTPAPI;
    {$endif}
    /// test via TSQLHttpClientWinSock instances over OS's socket API server
    // - this test won't work within the Delphi IDE debugger
    procedure _TSQLHttpClientWinSock_WinSock;
    /// test via TSQLRestClientDB instances with AcquireWriteMode=amLocked
    procedure Locked;
    /// test via TSQLRestClientDB instances with AcquireWriteMode=amUnlocked
    procedure Unlocked;
    /// test via TSQLRestClientDB instances with AcquireWriteMode=amBackgroundThread
    procedure BackgroundThread;
    {$ifndef LVCL}
................................................................................
      finally
        Free;
      end;
    finally
      AES.outStreamCreated.Free;
    end;
  end;


end;

procedure TTestCryptographicRoutines._CompressShaAes;
var s1,s2: RawByteString;
    key,i: integer;
begin
  for key := 0 to 10 do begin
................................................................................
  SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq',Test2Out);
  s := 'Wikipedia, l''encyclopedie libre et gratuite';
  SHA.Full(pointer(s),length(s),Digest);
  Check(SHA1DigestToString(Digest)='c18cc65028bbdc147288a2d136313287782b9c73');
end;

procedure TTestCryptographicRoutines._SHA256;

procedure SingleTest(const s: AnsiString; const TDig: TSHA256Digest);
var SHA: TSHA256;
  Digest: TSHA256Digest;
  i: integer;
begin
  // 1. Hash complete AnsiString
  SHA.Full(pointer(s),length(s),Digest);
  Check(CompareMem(@Digest,@TDig,sizeof(Digest)));
  // 2. one update call for all chars
  SHA.Init;
  for i := 1 to length(s) do
    SHA.Update(@s[i],1);
  SHA.Final(Digest);
  Check(CompareMem(@Digest,@TDig,sizeof(Digest)));
  // 3. test consistency with Padlock engine down results
{$ifdef USEPADLOCK}
  if not padlock_available then exit;
  padlock_available := false;  // force PadLock engine down
  SHA.Full(pointer(s),length(s),Digest);
  Check(CompareMem(@Digest,@TDig,sizeof(Digest)));
{$ifdef PADLOCKDEBUG} write('=padlock '); {$endif}
  padlock_available := true;
{$endif}
end;
var Digest: TSHA256Digest;
const
  D1: TSHA256Digest =
    ($ba,$78,$16,$bf,$8f,$01,$cf,$ea,$41,$41,$40,$de,$5d,$ae,$22,$23,
     $b0,$03,$61,$a3,$96,$17,$7a,$9c,$b4,$10,$ff,$61,$f2,$00,$15,$ad);
  D2: TSHA256Digest =
    ($24,$8d,$6a,$61,$d2,$06,$38,$b8,$e5,$c0,$26,$93,$0c,$3e,$60,$39,
     $a3,$3c,$e4,$59,$64,$ff,$21,$67,$f6,$ec,$ed,$d4,$19,$db,$06,$c1);
  D3: TSHA256Digest =
    ($94,$E4,$A9,$D9,$05,$31,$23,$1D,$BE,$D8,$7E,$D2,$E4,$F3,$5E,$4A,
     $0B,$F4,$B3,$BC,$CE,$EB,$17,$16,$D5,$77,$B1,$E0,$8B,$A9,$BA,$A3);

begin
//  result := true; exit;
  SingleTest('abc', D1);
  SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq', D2);
  SHA256Weak('lagrangehommage',Digest); // test with len=256>64
  Check(Comparemem(@Digest,@D3,sizeof(Digest)));
end;





















{$ifdef MSWINDOWS}
{$ifndef FPC}
{$ifndef LVCL}

{ TTestSynopsePDF }
................................................................................
procedure TTestMultiThreadProcess.MainThread;
begin
  Test(TSQLRestClientDB,HTTP_DEFAULT_MODE,amMainThread);
end;
{$endif}

{$ifndef ONLYUSEHTTPSOCKET}
procedure TTestMultiThreadProcess._TSQLHttpClientWinHTTP_HTTPAPI;
begin
  Test(TSQLHttpClientWinHTTP,useHttpApi);
end;
{$endif}

procedure TTestMultiThreadProcess._TSQLHttpClientWinSock_WinSock;
begin
  {$WARN SYMBOL_PLATFORM OFF}
  {$ifdef FPC}
  exit;
  {$else}
  if DebugHook=0 then
  {$endif}
    Test(TSQLHttpClientWinSock,useHttpSocket);
  {$WARN SYMBOL_PLATFORM ON}
end;

procedure TTestMultiThreadProcess._TSQLRestClientDB;







|



|







 







>
>







 







>








|





<
<
<
<
<
<
<
<
<

<










>

<
|
|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|





|


|
<
<







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
....
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
....
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365









7366

7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378

7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400
7401
7402
7403
7404
7405
7406
7407
7408
7409
.....
12461
12462
12463
12464
12465
12466
12467
12468
12469
12470
12471
12472
12473
12474
12475
12476
12477


12478
12479
12480
12481
12482
12483
12484
    /// test via TSQLRestClientURINamedPipe instances
    procedure _TSQLRestClientURINamedPipe;
    /// test via TSQLRestClientURIMessage instances
    procedure _TSQLRestClientURIMessage;
    {$endif}
    {$ifndef ONLYUSEHTTPSOCKET}
    /// test via TSQLHttpClientWinHTTP instances over http.sys (HTTP API) server
    procedure WinHttp_HttpApi;
    {$endif}
    /// test via TSQLHttpClientWinSock instances over OS's socket API server
    // - this test won't work within the Delphi IDE debugger
    procedure SocketAPI;
    /// test via TSQLRestClientDB instances with AcquireWriteMode=amLocked
    procedure Locked;
    /// test via TSQLRestClientDB instances with AcquireWriteMode=amUnlocked
    procedure Unlocked;
    /// test via TSQLRestClientDB instances with AcquireWriteMode=amBackgroundThread
    procedure BackgroundThread;
    {$ifndef LVCL}
................................................................................
      finally
        Free;
      end;
    finally
      AES.outStreamCreated.Free;
    end;
  end;
  if A.UsesAESNI then
    fRunConsole := fRunConsole+'using AES-NI instruction set';
end;

procedure TTestCryptographicRoutines._CompressShaAes;
var s1,s2: RawByteString;
    key,i: integer;
begin
  for key := 0 to 10 do begin
................................................................................
  SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq',Test2Out);
  s := 'Wikipedia, l''encyclopedie libre et gratuite';
  SHA.Full(pointer(s),length(s),Digest);
  Check(SHA1DigestToString(Digest)='c18cc65028bbdc147288a2d136313287782b9c73');
end;

procedure TTestCryptographicRoutines._SHA256;
procedure DoTest;
procedure SingleTest(const s: AnsiString; const TDig: TSHA256Digest);
var SHA: TSHA256;
  Digest: TSHA256Digest;
  i: integer;
begin
  // 1. Hash complete AnsiString
  SHA.Full(pointer(s),length(s),Digest);
  Check(CompareMem(@Digest,@TDig,sizeof(Digest)));
  // 2. one update call for each char
  SHA.Init;
  for i := 1 to length(s) do
    SHA.Update(@s[i],1);
  SHA.Final(Digest);
  Check(CompareMem(@Digest,@TDig,sizeof(Digest)));









end;

const
  D1: TSHA256Digest =
    ($ba,$78,$16,$bf,$8f,$01,$cf,$ea,$41,$41,$40,$de,$5d,$ae,$22,$23,
     $b0,$03,$61,$a3,$96,$17,$7a,$9c,$b4,$10,$ff,$61,$f2,$00,$15,$ad);
  D2: TSHA256Digest =
    ($24,$8d,$6a,$61,$d2,$06,$38,$b8,$e5,$c0,$26,$93,$0c,$3e,$60,$39,
     $a3,$3c,$e4,$59,$64,$ff,$21,$67,$f6,$ec,$ed,$d4,$19,$db,$06,$c1);
  D3: TSHA256Digest =
    ($94,$E4,$A9,$D9,$05,$31,$23,$1D,$BE,$D8,$7E,$D2,$E4,$F3,$5E,$4A,
     $0B,$F4,$B3,$BC,$CE,$EB,$17,$16,$D5,$77,$B1,$E0,$8B,$A9,$BA,$A3);
var Digest: TSHA256Digest;
begin

  SingleTest('abc',D1);
  SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq',D2);
  SHA256Weak('lagrangehommage',Digest); // test with len=256>64
  Check(Comparemem(@Digest,@D3,sizeof(Digest)));
end;
begin
  DoTest;
  {$ifdef USEPADLOCK}
  if padlock_available then begin
    fRunConsole := fRunConsole+' using Padlock';
    padlock_available := false;  // force PadLock engine down
    DoTest;
    padlock_available := true;
  end;
  {$endif}
  {$ifdef CPU64}
  if cfSSE41 in CpuFeatures then begin
    fRunConsole := fRunConsole+' using SSE4 instruction set';
    Exclude(CpuFeatures,cfSSE41);
    DoTest;
    Include(CpuFeatures,cfSSE41);
  end
  {$endif}
end;


{$ifdef MSWINDOWS}
{$ifndef FPC}
{$ifndef LVCL}

{ TTestSynopsePDF }
................................................................................
procedure TTestMultiThreadProcess.MainThread;
begin
  Test(TSQLRestClientDB,HTTP_DEFAULT_MODE,amMainThread);
end;
{$endif}

{$ifndef ONLYUSEHTTPSOCKET}
procedure TTestMultiThreadProcess.WinHttp_HttpApi;
begin
  Test(TSQLHttpClientWinHTTP,useHttpApi);
end;
{$endif}

procedure TTestMultiThreadProcess.SocketAPI;
begin
  {$WARN SYMBOL_PLATFORM OFF}
  {$ifndef FPC}


  if DebugHook=0 then
  {$endif}
    Test(TSQLHttpClientWinSock,useHttpSocket);
  {$WARN SYMBOL_PLATFORM ON}
end;

procedure TTestMultiThreadProcess._TSQLRestClientDB;

Changes to SynopseCommit.inc.

1
'1.18.945'
|
1
'1.18.946'