* Rename unit crc to fpccrc to avoid name conflict in packages

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@1856 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 100 insertions, 0 deletions

diff --git a/compiler/fpccrc.pas b/compiler/fpccrc.pas
new file mode 100644
index 0000000000..502e7e7216
--- /dev/null
+++ b/compiler/fpccrc.pas
@@ -0,0 +1,100 @@
+{
+    Copyright (c) 2000-2002 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 fpccrc;
+
+{$i fpcdefs.inc}
+
+Interface
+
+Function Crc32(Const HStr:String):cardinal;
+Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:integer):cardinal;
+Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
+
+
+Implementation
+
+{*****************************************************************************
+                                   Crc 32
+*****************************************************************************}
+
+var
+  Crc32Tbl : array[0..255] of cardinal;
+
+procedure MakeCRC32Tbl;
+var
+  crc : cardinal;
+  i,n : integer;
+begin
+  for i:=0 to 255 do
+   begin
+     crc:=i;
+     for n:=1 to 8 do
+      if (crc and 1)<>0 then
+       crc:=(crc shr 1) xor cardinal($edb88320)
+      else
+       crc:=crc shr 1;
+     Crc32Tbl[i]:=crc;
+   end;
+end;
+
+
+Function Crc32(Const HStr:String):cardinal;
+var
+  i : integer;
+  InitCrc : cardinal;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  InitCrc:=cardinal($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:cardinal;const InBuf;InLen:Integer):cardinal;
+var
+  i : integer;
+  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(p);
+   end;
+  UpdateCrc32:=InitCrc;
+end;
+
+
+
+Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  UpdCrc32:=Crc32Tbl[byte(InitCrc) xor b] xor (InitCrc shr 8);
+end;
+
+end.