Mega Code Archive
Calculating CRCs Effectively
<![CDATA[
Title: Calculating CRCs Effectively
Question: Ever want to use a CRC? Should you use CRC-16, CRC-32 or any one of the other variants out there? Well this handy component will do just about any CRC you can dream up (up to 32 bits wide) and has presets for some of the more popular CRC schemes. Simply drop this on your form and set the properties accordingly.
Answer:
Drop this on a form, then repeatedly call Update(nextbyte) until your input stream is complete, then access the CRC property for a CRC of the input bytes.
unit CCRC;
interface
uses
Classes, SysUtils, DsgnIntf;
type
TCRCScheme = (crcX25, crcXMODEM, crcARC, crcCRC32, crcPKZIP, crcCustom);
TLongHex = LongWord;
ECRCException = class(Exception);
ECRCBadScheme = class(ECRCException);
TLongHexEditor = class(TIntegerProperty)
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure SetValue(const sValue: string); override;
end; //class TLongHexEditor
TCRC = class(TComponent)
private
//Private declarations
FScheme : TCRCScheme;
FWidth : Integer;
FReflectInput,
FReflectCRC : Boolean;
FCRC,
FInitialValue,
FPolynomial,
FXorToCRC : TLongHex;
protected
//Protected declarations
procedure SetScheme(crcNewScheme: TCRCScheme);
procedure SetCRCParameters(iNewWidth : Integer;
lNewPolynomial,
lNewInitialValue: TLongHex;
bNewReflectInput,
bNewReflectCRC : Boolean;
lNewXorToCRC : TLongHex);
procedure SetWidth(iNewWidth: Integer);
procedure SetPolynomial(lNewPolynomial: TLongHex);
procedure SetInitialValue(lNewInitialValue: TLongHex);
procedure SetReflectInput(bNewReflectInput: Boolean);
procedure SetReflectCRC(bNewReflectCRC: Boolean);
procedure SetXorToCRC(lNewXorToCRC: TLongHex);
function Reflect(lValue : TLongHex;
iBottomBitsToReflect: Integer): TLongHex;
function Bitmask(iBits: Integer): TLongHex;
function MaskOfWidth: TLongHex;
function GetCRC: TLongHex;
public
//Public declarations
constructor Create(AOwner: TComponent); override;
procedure Initialize;
procedure Update(byNewCharacter: Byte);
property CRC : TLongHex read GetCRC;
published
//Published declarations
property Scheme : TCRCScheme read FScheme write SetScheme default crcCRC32;
property Width : Integer read FWidth write SetWidth default 32;
property Polynomial : TLongHex read FPolynomial write SetPolynomial default $04C11DB7;
property InitialValue: TLongHex read FInitialValue write SetInitialValue default $FFFFFFFF;
property ReflectInput: Boolean read FReflectInput write SetReflectInput default True;
property ReflectCRC : Boolean read FReflectCRC write SetReflectCRC default True;
property XorToCRC : TLongHex read FXorToCRC write SetXorToCRC default $FFFFFFFF;
end; //class TCRC
procedure Register;
procedure CustomRegister(const sFolderName: string);
implementation
{$IFDEF VER100}
resourcestring
{$ELSE}
const
{$ENDIF}
rsCRCBadScheme = 'Invalid CRC scheme type specified.';
const
BITSINABYTE = 8;
var
sCustomFolderName: string = 'InterVocative Software';
//------------------------------------------------------------------------------
procedure TLongHexEditor.Edit;
var
ThisComponent: TPersistent;
begin //procedure TLongHexEditor.Edit
ThisComponent := GetComponent(Pred(PropCount));
if ThisComponent is TCRC then
begin //if..then
//do it here
end; //if..then
end; //procedure TLongHexEditor.Edit
//------------------------------------------------------------------------------
function TLongHexEditor.GetAttributes: TPropertyAttributes;
begin //function TLongHexEditor.GetAttributes
Result := inherited GetAttributes + [paRevertable];
end; //function TLongHexEditor.GetAttributes
//------------------------------------------------------------------------------
function TLongHexEditor.GetValue: string;
begin //function TLongHexEditor.GetValue
Result := inherited GetValue;
end; //function TLongHexEditor.GetValue
//------------------------------------------------------------------------------
procedure TLongHexEditor.SetValue(const sValue: string);
begin //procedure TLongHexEditor.SetValue
inherited SetValue(sValue);
end; //procedure TLongHexEditor.SetValue
//------------------------------------------------------------------------------
constructor TCRC.Create(AOwner: TComponent);
begin //constructor TCRC.Create
inherited Create(AOwner);
Scheme := crcCRC32;
Initialize;
end; //constructor TCRC.Create
//------------------------------------------------------------------------------
procedure TCRC.SetScheme(crcNewScheme: TCRCScheme);
begin //procedure TCRC.SetScheme
if crcNewScheme Scheme then
begin //if..then
case crcNewScheme of
crcX25 : SetCRCParameters(16, $1021, $FFFF, False, False, $0000);
crcXMODEM: SetCRCParameters(16, $8408, $0000, True, True, $0000);
crcARC : SetCRCParameters(16, $8005, $0000, True, True, $0000);
crcCRC32 : SetCRCParameters(32, $04C11DB7, $FFFFFFFF, True, True, $FFFFFFFF);
crcPKZIP : SetCRCParameters(32, $EDB88320, $FFFFFFFF, True, True, $FFFFFFFF);
crcCustom: ; //deliberate non-statement
else
raise ECRCBadScheme.Create(rsCRCBadScheme);
end; //case
FScheme := crcNewScheme;
end; //if..then
end; //procedure TCRC.SetScheme
//------------------------------------------------------------------------------
procedure TCRC.SetCRCParameters(iNewWidth : Integer;
lNewPolynomial,
lNewInitialValue: TLongHex;
bNewReflectInput,
bNewReflectCRC : Boolean;
lNewXorToCRC : TLongHex);
begin //procedure TCRC.SetCRCParameters
Width := iNewWidth;
Polynomial := lNewPolynomial;
InitialValue := lNewInitialValue;
ReflectInput := bNewReflectInput;
ReflectCRC := bNewReflectCRC;
XorToCRC := lNewXorToCRC;
end; //procedure TCRC.SetCRCParameters
//------------------------------------------------------------------------------
procedure TCRC.SetWidth(iNewWidth: Integer);
begin //procedure TCRC.SetWidth
if iNewWidth Width then
begin //if..then
FWidth := iNewWidth;
Scheme := crcCustom;
end; //if..then
end; //procedure TCRC.SetWidth
//------------------------------------------------------------------------------
procedure TCRC.SetPolynomial(lNewPolynomial: TLongHex);
begin //procedure TCRC.SetPolynomial
if lNewPolynomial Polynomial then
begin //if..then
FPolynomial := lNewPolynomial;
Scheme := crcCustom;
end; //if..then
end; //procedure TCRC.SetPolynomial
//------------------------------------------------------------------------------
procedure TCRC.SetInitialValue(lNewInitialValue: TLongHex);
begin //procedure TCRC.SetInitialValue
if lNewInitialValue InitialValue then
begin //if..then
FInitialValue := lNewInitialValue;
Scheme := crcCustom;
end; //if..then
end; //procedure TCRC.SetInitialValue
//------------------------------------------------------------------------------
procedure TCRC.SetReflectInput(bNewReflectInput: Boolean);
begin //procedure TCRC.SetReflectInput}
if bNewReflectInput ReflectInput then
begin //if..then
FReflectInput := bNewReflectInput;
Scheme := crcCustom;
end; //if..then
end; //procedure TCRC.SetReflectInput
//------------------------------------------------------------------------------
procedure TCRC.SetReflectCRC(bNewReflectCRC: Boolean);
begin //procedure TCRC.SetReflectCRC
if bNewReflectCRC ReflectCRC then
begin //if..then
FReflectCRC := bNewReflectCRC;
Scheme := crcCustom;
end; //if..then
end; //procedure TCRC.SetReflectCRC
//------------------------------------------------------------------------------
procedure TCRC.SetXorToCRC(lNewXorToCRC: TLongHex);
begin //procedure TCRC.SetXorToCRC
if lNewXorToCRC XorToCRC then
begin //if..then
FXorToCRC := lNewXorToCRC;
Scheme := crcCustom;
end; //if..then
end; //procedure TCRC.SetXorToCRC
//------------------------------------------------------------------------------
function TCRC.Reflect(lValue : TLongHex;
iBottomBitsToReflect: Integer): TLongHex;
var
iLoop : Integer;
lTempValue,
lOrValue: TLongHex;
begin //function TCRC.Reflect
lTempValue := lValue;
for iLoop := 0 to Pred(iBottomBitsToReflect) do
begin //for
lOrValue := Bitmask(Pred(iBottomBitsToReflect) - iLoop);
if lTempValue and 1 0 then
lValue := lValue or lOrValue
else
lValue := lValue and not lOrValue;
lTempValue := lTempValue shr 1;
end; //for
Result := lValue;
end; //function TCRC.Reflect
//------------------------------------------------------------------------------
function TCRC.Bitmask(iBits: Integer): TLongHex;
begin //function TCRC.Bitmask
Result := 1 shl iBits;
end; //function TCRC.Bitmask
//------------------------------------------------------------------------------
function TCRC.MaskOfWidth: TLongHex;
var
lhResult: TLongHex;
begin //function TCRC.MaskOfWidth
lhResult := 1 shl Pred(Width);
Result := (Pred(lhResult) shl 1) or 1;
end; //function TCRC.MaskOfWidth
//------------------------------------------------------------------------------
function TCRC.GetCRC: TLongHex;
begin //function TCRC.GetCRC
if ReflectCRC then
Result := XorToCRC xor Reflect(FCRC, Width)
else
Result := XorToCRC xor FCRC;
end; //function TCRC.GetCRC
//------------------------------------------------------------------------------
procedure TCRC.Initialize;
begin //procedure TCRC.Initialize
FCRC := InitialValue;
end; //procedure TCRC.Initialize
//------------------------------------------------------------------------------
procedure TCRC.Update(byNewCharacter: Byte);
var
iLoop : Integer;
lNewLong,
lTopBit : TLongHex;
begin //procedure TCRC.Update
lNewLong := byNewCharacter;
lTopBit := Bitmask(Pred(Width));
if ReflectInput then
lNewLong := Reflect(lNewLong, BITSINABYTE);
FCRC := FCRC xor (lNewLong shl (Width - BITSINABYTE));
for iLoop := 1 to BITSINABYTE do
begin //for
if FCRC and lTopBit 0 then
FCRC := (FCRC shl 1) xor Polynomial
else
FCRC := FCRC shl 1;
FCRC := FCRC and MaskOfWidth;
end; //for
end; //procedure TCRC.Update
//------------------------------------------------------------------------------
procedure Register;
begin //procedure Register
RegisterPropertyEditor(TypeInfo(TLongHex), nil, '', TLongHexEditor);
RegisterComponents(sCustomFolderName, [TCRC]);
end; //procedure Register
//------------------------------------------------------------------------------
procedure CustomRegister(const sFolderName: string);
begin //procedure CustomRegister
if Trim(sFolderName) '' then
sCustomFolderName := sFolderName;
Register;
end; //procedure CustomRegister
//------------------------------------------------------------------------------
end. //unit CCRC
]]>