1 unit Adler32;
2
3 {ZLib - Adler32 checksum function}
4
5 interface
6
7 (*************************************************************************
8
9 DESCRIPTION : ZLib - Adler32 checksum function
10
11 REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP
12
13 EXTERNAL DATA : ---
14
15 MEMORY USAGE : ---
16
17 DISPLAY MODE : ---
18
19 REFERENCES : RFC 1950 (http://tools.ietf.org/html/rfc1950)
20
21
22 Version Date Author Modification
23 ------- -------- ------- ------------------------------------------
24 0.10 30.08.03 W.Ehrhardt Initial version based on MD5 layout
25 2.10 30.08.03 we Common vers., XL versions for Win32
26 2.20 27.09.03 we FPC/go32v2
27 2.30 05.10.03 we STD.INC, TP5.0
28 2.40 10.10.03 we common version, english comments
29 3.00 01.12.03 we Common version 3.0
30 3.01 22.05.05 we Adler32UpdateXL (i,n: integer)
31 3.02 17.12.05 we Force $I- in Adler32File
32 3.03 07.08.06 we $ifdef BIT32: (const fname: shortstring...)
33 3.04 10.02.07 we Adler32File: no eof, XL and filemode via $ifdef
34 3.05 04.07.07 we BASM16: speed-up factor 15
35 3.06 12.11.08 we uses BTypes, Ptr2Inc and/or Str255
36 3.07 25.04.09 we updated RFC URL(s)
37 3.08 19.07.09 we D12 fix: assign with typecast string(fname)
38 **************************************************************************)
39
40 (*-------------------------------------------------------------------------
41 (C) Copyright 2002-2009 Wolfgang Ehrhardt
42
43 This software is provided 'as-is', without any express or implied warranty.
44 In no event will the authors be held liable for any damages arising from
45 the use of this software.
46
47 Permission is granted to anyone to use this software for any purpose,
48 including commercial applications, and to alter it and redistribute it
49 freely, subject to the following restrictions:
50
51 1. The origin of this software must not be misrepresented; you must not
52 claim that you wrote the original software. If you use this software in
53 a product, an acknowledgment in the product documentation would be
54 appreciated but is not required.
55
56 2. Altered source versions must be plainly marked as such, and must not be
57 misrepresented as being the original software.
58
59 3. This notice may not be removed or altered from any source distribution.
60 ----------------------------------------------------------------------------*)
61
62 (*
63 As per the license above, noting that this implementation of adler32 was stripped of everything we didn't need.
64 That means no btypes, file loading, and the assembly version disabled.
65 Also, the structure was removed to simplify C conversion
66 *)
67
Adler32Updatenull68 function Adler32Update (adler : longint; Msg :Pointer; Len :longint ) : longint;
69
70 implementation
71
72 (*
73 $ifdef BASM16
74
75 procedure Adler32Update(var adler: longint; Msg: pointer; Len: longint);
76 //-update Adler32 with Msg data
77 const
78 BASE = 65521; // max. prime < 65536
79 NMAX = 5552; // max. n with 255n(n+1)/2 + (n+1)(BASE-1) < 2^32
80 type
81 LH = packed record
82 L,H: word;
83 end;
84 var
85 s1,s2: longint;
86 n: integer;
87 begin
88 s1 := LH(adler).L;
89 s2 := LH(adler).H;
90 while Len > 0 do
91 begin
92 if Len<NMAX then
93 n := Len
94 else
95 n := NMAX;
96 //BASM increases speed from about 52 cyc/byte to about 3.7 cyc/byte
97 asm
98 mov cx,[n]
99 db $66; mov ax,word ptr [s1]
100 db $66; mov di,word ptr [s2]
101 les si,[msg]
102 @@1: db $66, $26, $0f, $b6, $1c // movzx ebx,es:[si]
103 inc si
104 db $66; add ax,bx // inc(s1, pByte(Msg)^)
105 db $66; add di,ax // inc(s2, s1
106 dec cx
107 jnz @@1
108 db $66; sub cx,cx
109 mov cx,BASE
110 db $66; sub dx,dx
111 db $66; div cx
112 db $66; mov word ptr [s1],dx // s1 := s1 mod BASE
113 db $66; sub dx,dx
114 db $66; mov ax,di
115 db $66; div cx
116 db $66; mov word ptr [s2],dx // s2 := s2 mod BASE
117 mov word ptr [msg],si // save offset for next chunk
118 end;
119 dec(len, n);
120 end;
121 LH(adler).L := word(s1);
122 LH(adler).H := word(s2);
123 end;
124 *)
125
Adler32Updatenull126 function Adler32Update(adler:longint; Msg: Pointer; Len :longint) : longint;
127 {-update Adler32 with Msg data}
128 const
129 BASE = 65521; {max. prime < 65536 }
130 NMAX = 3854; {max. n with 255n(n+1)/2 + (n+1)(BASE-1) < 2^31}
131 var
132 s1, s2 : longint;
133 i, n : integer;
134 m : PByte;
135 begin
136 m := PByte(Msg);
137 s1 := Longword(adler) and $FFFF;
138 s2 := Longword(adler) shr 16;
139 while Len>0 do
140 begin
141 if Len<NMAX then
142 n := Len
143 else
144 n := NMAX;
145
146 for i := 1 to n do
147 begin
148 inc(s1, m^);
149 inc(m);
150 inc(s2, s1);
151 end;
152 s1 := s1 mod BASE;
153 s2 := s2 mod BASE;
154 dec(len, n);
155 end;
156 Adler32Update:= (s2 shl 16) or s1;
157 end;
158
159 end.
160