crc.pas 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Free Pascal Development Team
  4. Routines to compute CRC values
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. Unit crc;
  19. {$i fpcdefs.inc}
  20. Interface
  21. Function Crc32(Const HStr:String):cardinal;
  22. Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:integer):cardinal;
  23. Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
  24. Implementation
  25. {*****************************************************************************
  26. Crc 32
  27. *****************************************************************************}
  28. var
  29. Crc32Tbl : array[0..255] of cardinal;
  30. procedure MakeCRC32Tbl;
  31. var
  32. crc : cardinal;
  33. i,n : integer;
  34. begin
  35. for i:=0 to 255 do
  36. begin
  37. crc:=i;
  38. for n:=1 to 8 do
  39. if (crc and 1)<>0 then
  40. crc:=(crc shr 1) xor cardinal($edb88320)
  41. else
  42. crc:=crc shr 1;
  43. Crc32Tbl[i]:=crc;
  44. end;
  45. end;
  46. Function Crc32(Const HStr:String):cardinal;
  47. var
  48. i : integer;
  49. InitCrc : cardinal;
  50. begin
  51. if Crc32Tbl[1]=0 then
  52. MakeCrc32Tbl;
  53. InitCrc:=cardinal($ffffffff);
  54. for i:=1 to Length(Hstr) do
  55. InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(Hstr[i])] xor (InitCrc shr 8);
  56. Crc32:=InitCrc;
  57. end;
  58. Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:Integer):cardinal;
  59. var
  60. i : integer;
  61. p : pchar;
  62. begin
  63. if Crc32Tbl[1]=0 then
  64. MakeCrc32Tbl;
  65. p:=@InBuf;
  66. for i:=1 to InLen do
  67. begin
  68. InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
  69. inc(p);
  70. end;
  71. UpdateCrc32:=InitCrc;
  72. end;
  73. Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
  74. begin
  75. if Crc32Tbl[1]=0 then
  76. MakeCrc32Tbl;
  77. UpdCrc32:=Crc32Tbl[byte(InitCrc) xor b] xor (InitCrc shr 8);
  78. end;
  79. end.
  80. {
  81. $Log$
  82. Revision 1.9 2002-05-18 13:34:06 peter
  83. * readded missing revisions
  84. Revision 1.8 2002/05/16 19:46:35 carl
  85. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  86. + try to fix temp allocation (still in ifdef)
  87. + generic constructor calls
  88. + start of tassembler / tmodulebase class cleanup
  89. }