fpimgcmn.pp 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2003 by the Free Pascal development team
  4. Auxiliary routines for image support.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}{$h+}
  12. unit FPImgCmn;
  13. interface
  14. function Swap(This : qword): qword;
  15. function Swap(This : int64): int64;
  16. function Swap(This : Longword): longword;
  17. function Swap(This : integer): integer;
  18. function Swap(This : Word): Word;
  19. function CalculateCRC (var data; alength:integer) : longword;
  20. function CalculateCRC (CRC:longword; var data; alength:integer) : longword;
  21. implementation
  22. uses sysutils;
  23. function Swap(This : Word): Word;
  24. var
  25. Tmp1, Tmp2 : Byte;
  26. AWord : Word;
  27. begin
  28. Tmp1 := This AND $00FF;
  29. Tmp2 := (This AND $FF00) SHR 8;
  30. AWord := Tmp1;
  31. result := (AWord SHL 8) + Tmp2;
  32. end;
  33. function Swap(This : integer): integer;
  34. begin
  35. result := integer(Swap(longword(This)));
  36. end;
  37. function Swap(This : longword): longword;
  38. var
  39. TmpW1 : Word;
  40. TmpB1,
  41. TmpB2 : Byte;
  42. AnInt : longword;
  43. begin
  44. TmpW1 := This AND $0000FFFF;
  45. TmpB1 := TmpW1 AND $00FF;
  46. TmpB2 := (TmpW1 AND $FF00) SHR 8;
  47. AnInt := TmpB1;
  48. AnInt := (AnInt SHL 8) + TmpB2;
  49. TmpW1 := (This AND $FFFF0000) SHR 16;
  50. TmpB1 := TmpW1 AND $00FF;
  51. TmpB2 := (TmpW1 AND $FF00) SHR 8;
  52. TmpW1 := TmpB1;
  53. result := (AnInt SHL 16) + (TmpW1 SHL 8) + TmpB2;
  54. end;
  55. function Swap(This : qword): qword;
  56. var l1, l2 : longword;
  57. res : qword;
  58. begin
  59. l1:=This and $00000000FFFFFFFF;
  60. l2:=(This and $FFFFFFFF00000000) shr 32;
  61. l1:=swap(l1);
  62. l2:=swap(l2);
  63. res:=l1;
  64. Result:=(res shl 32) + l2;
  65. end;
  66. function Swap(This : int64): int64;
  67. begin
  68. result := int64(Swap(qword(This)));
  69. end;
  70. var CRCtable : array[0..255] of longword;
  71. procedure MakeCRCtable;
  72. var c : longword;
  73. r, t : integer;
  74. begin
  75. for r := 0 to 255 do
  76. begin
  77. c := r;
  78. for t := 0 to 7 do
  79. begin
  80. if (c and 1) = 1 then
  81. c := $EDB88320 xor (c shr 1)
  82. else
  83. c := c shr 1
  84. end;
  85. CRCtable[r] := c;
  86. end;
  87. end;
  88. function CalculateCRC (CRC:longword; var data; alength:integer) : longword;
  89. var d : pbyte;
  90. r, t : integer;
  91. begin
  92. d := @data;
  93. result := CRC;
  94. for r := 0 to alength-1 do
  95. begin
  96. t := (byte(result) xor d^);
  97. result := CRCtable[t] xor (result shr 8);
  98. inc (d);
  99. end;
  100. end;
  101. function CalculateCRC (var data; alength:integer) : longword;
  102. var f : longword;
  103. begin
  104. f := CalculateCRC($FFFFFFFF, data, alength);
  105. result := f xor $FFFFFFFF;
  106. end;
  107. initialization
  108. MakeCRCtable;
  109. end.