CRC calculation placed into a unit

compiler/crc.pas

@@ -0,0 +1,108 @@
+{
+    $Id$
+    Copyright (c) 2000 by Free Pascal Development Team
+
+    Routines to compute CRC values
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+Unit CRC;
+
+Interface
+Function Crc32(Const HStr:String):longint;
+Function UpdateCrc32(InitCrc:longint;var InBuf;InLen:Longint):longint;
+Function UpdCrc32(InitCrc:longint;b:byte):longint;
+
+
+Implementation
+
+{*****************************************************************************
+                                   Crc 32
+*****************************************************************************}
+
+var
+  Crc32Tbl : array[0..255] of longint;
+
+procedure MakeCRC32Tbl;
+var
+  crc : longint;
+  i,n : byte;
+begin
+  for i:=0 to 255 do
+   begin
+     crc:=i;
+     for n:=1 to 8 do
+      if odd(crc) then
+       crc:=(crc shr 1) xor longint($edb88320)
+      else
+       crc:=crc shr 1;
+     Crc32Tbl[i]:=crc;
+   end;
+end;
+
+
+{$ifopt R+}
+{$define Range_check_on}
+{$endif opt R+}
+
+{$R- needed here }
+{CRC 32}
+Function Crc32(Const HStr:String):longint;
+var
+  i,InitCrc : longint;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  InitCrc:=longint($ffffffff);
+  for i:=1 to Length(Hstr) do
+   InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(Hstr[i])] xor (InitCrc shr 8);
+  Crc32:=InitCrc;
+end;
+
+
+
+Function UpdateCrc32(InitCrc:longint;var InBuf;InLen:Longint):longint;
+var
+  i : word;
+  p : pchar;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  p:=@InBuf;
+  for i:=1 to InLen do
+   begin
+     InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
+     inc(longint(p));
+   end;
+  UpdateCrc32:=InitCrc;
+end;
+
+
+
+Function UpdCrc32(InitCrc:longint;b:byte):longint;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  UpdCrc32:=Crc32Tbl[byte(InitCrc) xor b] xor (InitCrc shr 8);
+end;
+
+{$ifdef Range_check_on}
+{$R+}
+{$undef Range_check_on}
+{$endif Range_check_on}
+
+end.