1 unit CRC24;
2
3 {24 Bit CRC, polynomial $1864CFB (used in OpenPGP)}
4
5
6 interface
7
8 (*************************************************************************
9
10 DESCRIPTION : 24 Bit CRC, polynomial $1864CFB (used in OpenPGP)
11
12 REQUIREMENTS : TP6/7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP
13
14 EXTERNAL DATA : ---
15
16 MEMORY USAGE : ---
17
18 DISPLAY MODE : ---
19
20 REFERENCES : J. Callas et al, "OpenPGP Message Format", available at
21 http://tools.ietf.org/html/rfc2440
22
23 Version Date Author Modification
24 ------- -------- ------- ------------------------------------------
25 0.10 02.04.06 W.Ehrhardt Initial TP55 version based on CRC32 layout
26 0.11 02.04.06 we With array of byte absolute CRC
27 0.12 02.04.06 we BIT32 version
28 0.13 02.04.06 we BASM16 version
29 0.14 02.04.06 we BASM16: reordering of main loop
30 0.15 03.04.06 we TPGPDigest, Long2PGP
31 0.16 07.08.06 we $ifdef BIT32: (const fname: shortstring...)
32 0.17 10.02.07 we CRC24File: no eof, XL and filemode via $ifdef
33 0.18 29.06.07 we BASM16: align helpers
34 0.19 04.10.07 we FPC: {$asmmode intel}
35 0.20 12.11.08 we uses BTypes, Ptr2Inc and/or Str255
36 0.21 25.04.09 we updated RFC URL(s)
37 0.22 19.07.09 we D12 fix: assign with typecast string(fname)
38 0.23 08.03.12 we {$ifndef BIT16} instead of {$ifdef WIN32}
39 0.24 26.12.12 we D17 and PurePascal
40 0.25 16.08.15 we Removed $ifdef DLL / stdcall
41 0.26 29.11.17 we CRC24File - fname: string
42
43 **************************************************************************)
44
45
46 (*-------------------------------------------------------------------------
47 (C) Copyright 2006-2017 Wolfgang Ehrhardt
48
49 This software is provided 'as-is', without any express or implied warranty.
50 In no event will the authors be held liable for any damages arising from
51 the use of this software.
52
53 Permission is granted to anyone to use this software for any purpose,
54 including commercial applications, and to alter it and redistribute it
55 freely, subject to the following restrictions:
56
57 1. The origin of this software must not be misrepresented; you must not
58 claim that you wrote the original software. If you use this software in
59 a product, an acknowledgment in the product documentation would be
60 appreciated but is not required.
61
62 2. Altered source versions must be plainly marked as such, and must not be
63 misrepresented as being the original software.
64
65 3. This notice may not be removed or altered from any source distribution.
66 ----------------------------------------------------------------------------*)
67
68 {$i STD.INC}
69
70 {$ifdef BIT64}
71 {$ifndef PurePascal}
72 {$define PurePascal}
73 {$endif}
74 {$endif}
75
76 uses
77 BTypes;
78
79 type
80 TPGPDigest = array[0..2] of byte; {OpenPGP 3 byte MSB first CRC24 digest}
81
82
83 procedure Long2PGP(CRC: longint; var PGPCRC: TPGPDigest);
84 {-convert longint CRC24 to OpenPGP MSB first format}
85
86 procedure CRC24Init(var CRC: longint);
87 {-initialize context}
88
89 procedure CRC24Update(var CRC: longint; Msg: pointer; Len: word);
90 {-update CRC24 with Msg data}
91
92 procedure CRC24Final(var CRC: longint);
93 {-CRC24: finalize calculation}
94
CRC24SelfTestnull95 function CRC24SelfTest: boolean;
96 {-Self test for CRC24}
97
98 procedure CRC24Full(var CRC: longint; Msg: pointer; Len: word);
99 {-CRC24 of Msg with init/update/final}
100
101 procedure CRC24File({$ifdef CONST} const {$endif} fname: string;
102 var CRC: longint; var buf; bsize: word; var Err: word);
103 {-CRC24 of file, buf: buffer with at least bsize bytes}
104
105
106 {$ifndef BIT16}
107 procedure CRC24UpdateXL(var CRC: longint; Msg: pointer; Len: longint);
108 {-update CRC24 with Msg data}
109
110 procedure CRC24FullXL(var CRC: longint; Msg: pointer; Len: longint);
111 {-CRC24 of Msg with init/update/final}
112 {$endif}
113
114
115 implementation
116
117
118 {$ifdef StrictLong}
119 {$warnings off}
120 {$R-} {avoid D9 errors!}
121 {$endif}
122
123 {$ifdef BASM16}
124 {$i ALIGN.INC}
125 {$endif}
126
127 const
128 {$ifdef BASM16}
129 {$ifdef A4_CRC24}
130 AlignDummy_CRC24: word = 0;
131 {$endif}
132 {$endif}
133 CT24: array[0..255] of longint = (
134 $00000000,$00864cfb,$008ad50d,$000c99f6,$0093e6e1,$0015aa1a,$001933ec,$009f7f17,
135 $00a18139,$0027cdc2,$002b5434,$00ad18cf,$003267d8,$00b42b23,$00b8b2d5,$003efe2e,
136 $00c54e89,$00430272,$004f9b84,$00c9d77f,$0056a868,$00d0e493,$00dc7d65,$005a319e,
137 $0064cfb0,$00e2834b,$00ee1abd,$00685646,$00f72951,$007165aa,$007dfc5c,$00fbb0a7,
138 $000cd1e9,$008a9d12,$008604e4,$0000481f,$009f3708,$00197bf3,$0015e205,$0093aefe,
139 $00ad50d0,$002b1c2b,$002785dd,$00a1c926,$003eb631,$00b8faca,$00b4633c,$00322fc7,
140 $00c99f60,$004fd39b,$00434a6d,$00c50696,$005a7981,$00dc357a,$00d0ac8c,$0056e077,
141 $00681e59,$00ee52a2,$00e2cb54,$006487af,$00fbf8b8,$007db443,$00712db5,$00f7614e,
142 $0019a3d2,$009fef29,$009376df,$00153a24,$008a4533,$000c09c8,$0000903e,$0086dcc5,
143 $00b822eb,$003e6e10,$0032f7e6,$00b4bb1d,$002bc40a,$00ad88f1,$00a11107,$00275dfc,
144 $00dced5b,$005aa1a0,$00563856,$00d074ad,$004f0bba,$00c94741,$00c5deb7,$0043924c,
145 $007d6c62,$00fb2099,$00f7b96f,$0071f594,$00ee8a83,$0068c678,$00645f8e,$00e21375,
146 $0015723b,$00933ec0,$009fa736,$0019ebcd,$008694da,$0000d821,$000c41d7,$008a0d2c,
147 $00b4f302,$0032bff9,$003e260f,$00b86af4,$002715e3,$00a15918,$00adc0ee,$002b8c15,
148 $00d03cb2,$00567049,$005ae9bf,$00dca544,$0043da53,$00c596a8,$00c90f5e,$004f43a5,
149 $0071bd8b,$00f7f170,$00fb6886,$007d247d,$00e25b6a,$00641791,$00688e67,$00eec29c,
150 $003347a4,$00b50b5f,$00b992a9,$003fde52,$00a0a145,$0026edbe,$002a7448,$00ac38b3,
151 $0092c69d,$00148a66,$00181390,$009e5f6b,$0001207c,$00876c87,$008bf571,$000db98a,
152 $00f6092d,$007045d6,$007cdc20,$00fa90db,$0065efcc,$00e3a337,$00ef3ac1,$0069763a,
153 $00578814,$00d1c4ef,$00dd5d19,$005b11e2,$00c46ef5,$0042220e,$004ebbf8,$00c8f703,
154 $003f964d,$00b9dab6,$00b54340,$00330fbb,$00ac70ac,$002a3c57,$0026a5a1,$00a0e95a,
155 $009e1774,$00185b8f,$0014c279,$00928e82,$000df195,$008bbd6e,$00872498,$00016863,
156 $00fad8c4,$007c943f,$00700dc9,$00f64132,$00693e25,$00ef72de,$00e3eb28,$0065a7d3,
157 $005b59fd,$00dd1506,$00d18cf0,$0057c00b,$00c8bf1c,$004ef3e7,$00426a11,$00c426ea,
158 $002ae476,$00aca88d,$00a0317b,$00267d80,$00b90297,$003f4e6c,$0033d79a,$00b59b61,
159 $008b654f,$000d29b4,$0001b042,$0087fcb9,$001883ae,$009ecf55,$009256a3,$00141a58,
160 $00efaaff,$0069e604,$00657ff2,$00e33309,$007c4c1e,$00fa00e5,$00f69913,$0070d5e8,
161 $004e2bc6,$00c8673d,$00c4fecb,$0042b230,$00ddcd27,$005b81dc,$0057182a,$00d154d1,
162 $0026359f,$00a07964,$00ace092,$002aac69,$00b5d37e,$00339f85,$003f0673,$00b94a88,
163 $0087b4a6,$0001f85d,$000d61ab,$008b2d50,$00145247,$00921ebc,$009e874a,$0018cbb1,
164 $00e37b16,$006537ed,$0069ae1b,$00efe2e0,$00709df7,$00f6d10c,$00fa48fa,$007c0401,
165 $0042fa2f,$00c4b6d4,$00c82f22,$004e63d9,$00d11cce,$00575035,$005bc9c3,$00dd8538
166 );
167
168 {$ifdef StrictLong}
169 {$warnings on}
170 {$ifdef RangeChecks_on}
171 {$R+}
172 {$endif}
173 {$endif}
174
175
176 {$ifndef BIT16}
177
178 (**** 32+ Bit Delphi2+/FPC/VP *****)
179
180 {$ifdef PurePascal}
181 {---------------------------------------------------------------------------}
182 procedure CRC24UpdateXL(var CRC: longint; Msg: pointer; Len: longint);
183 {-update CRC24 with Msg data}
184 var
185 i: longint;
186 begin
187 for i:=1 to Len do begin
188 CRC := CT24[byte(CRC shr 16) xor PByte(Msg)^] xor (CRC shl 8);
189 inc(Ptr2Inc(Msg));
190 end;
191 end;
192 {$else}
193 {---------------------------------------------------------------------------}
194 procedure CRC24UpdateXL(var CRC: longint; Msg: pointer; Len: longint);
195 {-update CRC24 with Msg data}
196 begin
197 {CRC := CT24[byte(CRC shr 16) xor pByte(Msg)^] xor (CRC shl 8);}
198 asm
199 push esi
200 push ebx
201 mov ecx,[Len]
202 jecxz @@2
203 mov eax,[CRC]
204 mov eax,[eax] {eax holds CRC during main loop}
205 mov esi,[Msg]
206
207 @@1: movzx ebx,byte ptr [esi]
208 inc esi
209 mov edx,eax
210 shr edx,16
211 xor bl,dl
212 shl eax,8 {CRC shl 8}
213 xor eax,dword ptr CT24[ebx*4] {CTab[(CRC shr 16) xor Byte] xor (CRC shl 8)}
214 dec ecx
215 jnz @@1
216
217 mov edx,[CRC]
218 mov [edx],eax
219 @@2: pop ebx
220 pop esi
221 end;
222 end;
223 {$endif}
224
225
226 {---------------------------------------------------------------------------}
227 procedure CRC24Update(var CRC: longint; Msg: pointer; Len: word);
228 {-update CRC24 with Msg data}
229 begin
230 CRC24UpdateXL(CRC, Msg, Len);
231 end;
232
233
234 {$else}
235
236 (**** TP5-7/Delphi1 for 386+ *****)
237
238 {$ifndef BASM16}
239
240 {---------------------------------------------------------------------------}
241 procedure CRC24Update(var CRC: longint; Msg: pointer; Len: word);
242 {-update CRC24 with Msg data}
243 var
244 i: word;
245 CA: packed array[0..3] of byte absolute CRC;
246 begin
247 for i:=1 to Len do begin
248 {CRC := CT24[byte(CRC shr 16) xor pByte(Msg)^] xor (CRC shl 8);}
249 CRC := CT24[CA[2] xor pByte(Msg)^] xor (CRC shl 8);
250 inc(Ptr2Inc(Msg));
251 end;
252 end;
253
254
255 {$else}
256
257
258 {---------------------------------------------------------------------------}
259 procedure CRC24Update(var CRC: longint; Msg: pointer; Len: word); assembler;
260 {-update CRC24 with Msg data}
261 asm
262 {CRC := CT24[byte(CRC shr 16) xor pByte(Msg)^] xor (CRC shl 8);}
263 mov cx,[len]
264 jcxz @@2
265 les si,[CRC]
266 db $66; mov ax,es:[si]
267 les si,[Msg]
268 db $66; sub di,di
269 mov di,offset CT24
270 @@1: db $66; mov dx,ax
271 db $66; shr dx,16 {dx = CRC shr 16}
272 db $66, $26, $0f, $b6, $1c {movzx ebx,es:[si]}
273 inc si
274 xor bl,dl
275 db $66; shl ax,8
276 db $66,$67,$33,$04,$9F {xor eax,[edi+4*ebx]}
277 dec cx
278 jnz @@1
279
280 les si,CRC
281 db $66; mov es:[si],ax
282 @@2:
283 end;
284
285
286 {$endif BASM16}
287 {$endif BIT16}
288
289
290 {$ifndef BIT16}
291 {---------------------------------------------------------------------------}
292 procedure CRC24FullXL(var CRC: longint; Msg: pointer; Len: longint);
293 {-CRC24 of Msg with init/update/final}
294 begin
295 CRC24Init(CRC);
296 CRC24UpdateXL(CRC, Msg, Len);
297 CRC24Final(CRC);
298 end;
299 {$endif}
300
301
302
303 {---------------------------------------------------------------------------}
304 procedure CRC24Init(var CRC: longint);
305 {-CRC initialization}
306 begin
307 CRC := $B704CE;
308 end;
309
310
311 {---------------------------------------------------------------------------}
312 procedure CRC24Final(var CRC: longint);
313 {-CRC24: finalize calculation}
314 begin
315 {Mask 24 bits}
316 CRC := CRC and $FFFFFF;
317 end;
318
319
320 {---------------------------------------------------------------------------}
321 procedure CRC24Full(var CRC: longint; Msg: pointer; Len: word);
322 {-CRC24 of Msg with init/update/final}
323 begin
324 CRC24Init(CRC);
325 CRC24Update(CRC, Msg, Len);
326 CRC24Final(CRC);
327 end;
328
329
330 {---------------------------------------------------------------------------}
331 procedure Long2PGP(CRC: longint; var PGPCRC: TPGPDigest);
332 {-convert longint CRC24 to OpenPGP MSB first format}
333 var
334 CA: packed array[0..3] of byte absolute CRC;
335 begin
336 PGPCRC[0] := CA[2];
337 PGPCRC[1] := CA[1];
338 PGPCRC[2] := CA[0];
339 end;
340
341
342 {---------------------------------------------------------------------------}
CRC24SelfTestnull343 function CRC24SelfTest: boolean;
344 {-self test for CRC24}
345 const
346 s: string[17] = '0123456789abcdefg';
347 Check = $30B593; {calculated with trfc2440.c}
348 var
349 i: integer;
350 CRC, CRCF: longint;
351 begin
352 CRC24Full(CRCF, @s[1], length(s));
353 CRC24Init(CRC);
354 for i:=1 to length(s) do CRC24Update(CRC, @s[i], 1);
355 CRC24Final(CRC);
356 CRC24SelfTest := (CRC=Check) and (CRCF=Check);
357 end;
358
359
360 {$i-} {Force I-}
361 {---------------------------------------------------------------------------}
362 procedure CRC24File({$ifdef CONST} const {$endif} fname: string;
363 var CRC: longint; var buf; bsize: word; var Err: word);
364 {-CRC24 of file, buf: buffer with at least bsize bytes}
365 var
366 {$ifdef VirtualPascal}
367 fms: word;
368 {$else}
369 fms: byte;
370 {$endif}
371 {$ifndef BIT16}
372 L: longint;
373 {$else}
374 L: word;
375 {$endif}
376 f: file;
377 begin
378 fms := FileMode;
379 {$ifdef VirtualPascal}
380 FileMode := $40; {open_access_ReadOnly or open_share_DenyNone;}
381 {$else}
382 FileMode := 0;
383 {$endif}
384 system.assign(f,{$ifdef D12Plus} string {$endif} (fname));
385 system.reset(f,1);
386 Err := IOResult;
387 FileMode := fms;
388 if Err<>0 then exit;
389 CRC24Init(CRC);
390 L := bsize;
391 while (Err=0) and (L=bsize) do begin
392 system.blockread(f,buf,bsize,L);
393 Err := IOResult;
394 {$ifndef BIT16}
395 CRC24UpdateXL(CRC, @buf, L);
396 {$else}
397 CRC24Update(CRC, @buf, L);
398 {$endif}
399 end;
400 system.close(f);
401 if IOResult=0 then;
402 CRC24Final(CRC);
403 end;
404
405 {$ifdef DumpAlign}
406 begin
407 writeln('Align CRC24: ',ofs(CT24) and 3:2);
408 {$endif}
409
410 end.
411