• Status: Solved
• Priority: Medium
• Security: Public
• Views: 4084

# calculate CRC16 for strings in Delphi?

Any body, can help me calculate CRC 16 for strings in Delphi programming?

thanks
irvann
0
irvann
1 Solution

Commented:
see this link for pretty complete information: http://www.efg2.com/Lab/Mathematics/CRC.htm
0

Example usage and source below.

Regards,
Russell

--- example ---

var  wCrc:       Word;
szText:     String;
begin

// Set text to run crc 16 on
szText:='Hello world';

// Get crc16 for text; the initial seed value is passed as zero
wCrc:=Crc16(Pointer(szText), Length(szText), 0);

end;

--- include unit ---

unit verify;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit        :  Verify
//   Author      :  rllibby
//   Date        :  02.17.2004
//
//   Description :  Collection of verification and redundancy check routines such
//                  as crc, lrc, etc.
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
Windows, SysUtils;

////////////////////////////////////////////////////////////////////////////////
//   CRC tables for 16 and 32 bit calculations
////////////////////////////////////////////////////////////////////////////////
const
CT16:       Array [0..255] of Word =
(\$0000, \$C0C1, \$C181, \$0140, \$C301, \$03C0, \$0280, \$C241, \$C601, \$06C0, \$0780,
\$C741, \$0500, \$C5C1, \$C481, \$0440, \$CC01, \$0CC0, \$0D80, \$CD41, \$0F00, \$CFC1,
\$CE81, \$0E40, \$0A00, \$CAC1, \$CB81, \$0B40, \$C901, \$09C0, \$0880, \$C841, \$D801,
\$18C0, \$1980, \$D941, \$1B00, \$DBC1, \$DA81, \$1A40, \$1E00, \$DEC1, \$DF81, \$1F40,
\$DD01, \$1DC0, \$1C80, \$DC41, \$1400, \$D4C1, \$D581, \$1540, \$D701, \$17C0, \$1680,
\$D641, \$D201, \$12C0, \$1380, \$D341, \$1100, \$D1C1, \$D081, \$1040, \$F001, \$30C0,
\$3180, \$F141, \$3300, \$F3C1, \$F281, \$3240, \$3600, \$F6C1, \$F781, \$3740, \$F501,
\$35C0, \$3480, \$F441, \$3C00, \$FCC1, \$FD81, \$3D40, \$FF01, \$3FC0, \$3E80, \$FE41,
\$FA01, \$3AC0, \$3B80, \$FB41, \$3900, \$F9C1, \$F881, \$3840, \$2800, \$E8C1, \$E981,
\$2940, \$EB01, \$2BC0, \$2A80, \$EA41, \$EE01, \$2EC0, \$2F80, \$EF41, \$2D00, \$EDC1,
\$EC81, \$2C40, \$E401, \$24C0, \$2580, \$E541, \$2700, \$E7C1, \$E681, \$2640, \$2200,
\$E2C1, \$E381, \$2340, \$E101, \$21C0, \$2080, \$E041, \$A001, \$60C0, \$6180, \$A141,
\$6300, \$A3C1, \$A281, \$6240, \$6600, \$A6C1, \$A781, \$6740, \$A501, \$65C0, \$6480,
\$A441, \$6C00, \$ACC1, \$AD81, \$6D40, \$AF01, \$6FC0, \$6E80, \$AE41, \$AA01, \$6AC0,
\$6B80, \$AB41, \$6900, \$A9C1, \$A881, \$6840, \$7800, \$B8C1, \$B981, \$7940, \$BB01,
\$7BC0, \$7A80, \$BA41, \$BE01, \$7EC0, \$7F80, \$BF41, \$7D00, \$BDC1, \$BC81, \$7C40,
\$B401, \$74C0, \$7580, \$B541, \$7700, \$B7C1, \$B681, \$7640, \$7200, \$B2C1, \$B381,
\$7340, \$B101, \$71C0, \$7080, \$B041, \$5000, \$90C1, \$9181, \$5140, \$9301, \$53C0,
\$5280, \$9241, \$9601, \$56C0, \$5780, \$9741, \$5500, \$95C1, \$9481, \$5440, \$9C01,
\$5CC0, \$5D80, \$9D41, \$5F00, \$9FC1, \$9E81, \$5E40, \$5A00, \$9AC1, \$9B81, \$5B40,
\$9901, \$59C0, \$5880, \$9841, \$8801, \$48C0, \$4980, \$8941, \$4B00, \$8BC1, \$8A81,
\$4A40, \$4E00, \$8EC1, \$8F81, \$4F40, \$8D01, \$4DC0, \$4C80, \$8C41, \$4400, \$84C1,
\$8581, \$4540, \$8701, \$47C0, \$4680, \$8641, \$8201, \$42C0, \$4380, \$8341, \$4100,
\$81C1, \$8081, \$4040);
CT32:       Array [0..255] of LongWord =
(\$00000000, \$77073096, \$EE0E612C, \$990951BA, \$076DC419, \$706AF48F,
\$E963A535, \$9E6495A3, \$0EDB8832, \$79DCB8A4, \$E0D5E91E, \$97D2D988,
\$09B64C2B, \$7EB17CBD, \$E7B82D07, \$90BF1D91, \$1DB71064, \$6AB020F2,
\$136C9856, \$646BA8C0, \$FD62F97A, \$8A65C9EC, \$14015C4F, \$63066CD9,
\$FA0F3D63, \$8D080DF5, \$3B6E20C8, \$4C69105E, \$D56041E4, \$A2677172,
\$3C03E4D1, \$4B04D447, \$D20D85FD, \$A50AB56B, \$35B5A8FA, \$42B2986C,
\$DBBBC9D6, \$ACBCF940, \$32D86CE3, \$45DF5C75, \$DCD60DCF, \$ABD13D59,
\$26D930AC, \$51DE003A, \$C8D75180, \$BFD06116, \$21B4F4B5, \$56B3C423,
\$CFBA9599, \$B8BDA50F, \$2802B89E, \$5F058808, \$C60CD9B2, \$B10BE924,
\$2F6F7C87, \$58684C11, \$C1611DAB, \$B6662D3D, \$76DC4190, \$01DB7106,
\$98D220BC, \$EFD5102A, \$71B18589, \$06B6B51F, \$9FBFE4A5, \$E8B8D433,
\$7807C9A2, \$0F00F934, \$9609A88E, \$E10E9818, \$7F6A0DBB, \$086D3D2D,
\$91646C97, \$E6635C01, \$6B6B51F4, \$1C6C6162, \$856530D8, \$F262004E,
\$6C0695ED, \$1B01A57B, \$8208F4C1, \$F50FC457, \$65B0D9C6, \$12B7E950,
\$8BBEB8EA, \$FCB9887C, \$62DD1DDF, \$15DA2D49, \$8CD37CF3, \$FBD44C65,
\$4DB26158, \$3AB551CE, \$A3BC0074, \$D4BB30E2, \$4ADFA541, \$3DD895D7,
\$A4D1C46D, \$D3D6F4FB, \$4369E96A, \$346ED9FC, \$AD678846, \$DA60B8D0,
\$44042D73, \$33031DE5, \$AA0A4C5F, \$DD0D7CC9, \$5005713C, \$270241AA,
\$BE0B1010, \$C90C2086, \$5768B525, \$206F85B3, \$B966D409, \$CE61E49F,
\$5EDEF90E, \$29D9C998, \$B0D09822, \$C7D7A8B4, \$59B33D17, \$2EB40D81,
\$B7BD5C3B, \$C0BA6CAD, \$EDB88320, \$9ABFB3B6, \$03B6E20C, \$74B1D29A,
\$EAD54739, \$9DD277AF, \$04DB2615, \$73DC1683, \$E3630B12, \$94643B84,
\$0D6D6A3E, \$7A6A5AA8, \$E40ECF0B, \$9309FF9D, \$0A00AE27, \$7D079EB1,
\$F00F9344, \$8708A3D2, \$1E01F268, \$6906C2FE, \$F762575D, \$806567CB,
\$196C3671, \$6E6B06E7, \$FED41B76, \$89D32BE0, \$10DA7A5A, \$67DD4ACC,
\$F9B9DF6F, \$8EBEEFF9, \$17B7BE43, \$60B08ED5, \$D6D6A3E8, \$A1D1937E,
\$38D8C2C4, \$4FDFF252, \$D1BB67F1, \$A6BC5767, \$3FB506DD, \$48B2364B,
\$D80D2BDA, \$AF0A1B4C, \$36034AF6, \$41047A60, \$DF60EFC3, \$A867DF55,
\$316E8EEF, \$4669BE79, \$CB61B38C, \$BC66831A, \$256FD2A0, \$5268E236,
\$CC0C7795, \$BB0B4703, \$220216B9, \$5505262F, \$C5BA3BBE, \$B2BD0B28,
\$2BB45A92, \$5CB36A04, \$C2D7FFA7, \$B5D0CF31, \$2CD99E8B, \$5BDEAE1D,
\$9B64C2B0, \$EC63F226, \$756AA39C, \$026D930A, \$9C0906A9, \$EB0E363F,
\$72076785, \$05005713, \$95BF4A82, \$E2B87A14, \$7BB12BAE, \$0CB61B38,
\$92D28E9B, \$E5D5BE0D, \$7CDCEFB7, \$0BDBDF21, \$86D3D2D4, \$F1D4E242,
\$68DDB3F8, \$1FDA836E, \$81BE16CD, \$F6B9265B, \$6FB077E1, \$18B74777,
\$88085AE6, \$FF0F6A70, \$66063BCA, \$11010B5C, \$8F659EFF, \$F862AE69,
\$616BFFD3, \$166CCF45, \$A00AE278, \$D70DD2EE, \$4E048354, \$3903B3C2,
\$A7672661, \$D06016F7, \$4969474D, \$3E6E77DB, \$AED16A4A, \$D9D65ADC,
\$40DF0B66, \$37D83BF0, \$A9BCAE53, \$DEBB9EC5, \$47B2CF7F, \$30B5FFE9,
\$BDBDF21C, \$CABAC28A, \$53B39330, \$24B4A3A6, \$BAD03605, \$CDD70693,
\$54DE5729, \$23D967BF, \$B3667A2E, \$C4614AB8, \$5D681B02, \$2A6F2B94,
\$B40BBE37, \$C30C8EA1, \$5A05DF1B, \$2D02EF8D);

////////////////////////////////////////////////////////////////////////////////
//   Longitudinal and Vertical redundancy checks
////////////////////////////////////////////////////////////////////////////////
function   Lrc(lpBuffer: Pointer; dwSize: Cardinal): Byte; assembler;
function   Vrc(lpBuffer: Pointer; dwSize: Cardinal): Byte; assembler;

////////////////////////////////////////////////////////////////////////////////
//   Cyclic redundancy checks
////////////////////////////////////////////////////////////////////////////////
function   Crc16(lpBuffer: Pointer; dwSize: Cardinal; wSeed: Word): Word;
function   Crc32(lpBuffer: Pointer; dwSize: Cardinal; dwSeed: LongWord): LongWord;

////////////////////////////////////////////////////////////////////////////////
//   File handling checks
////////////////////////////////////////////////////////////////////////////////
function   FileCrc32(FileName: String; out CrcValue: LongWord): Integer;
function   FileCrc16(FileName: String; out CrcValue: Word): Integer;

implementation

function FileCrc16(FileName: String; out CrcValue: Word): Integer;
var  hFile:         THandle;
hMapping:      THandle;
dwSize:        DWORD;
lpData:        Pointer;
begin

// Open the file for reading

// Check handle
if (hFile <> THandle(-1)) then
begin
// Resource protection
try
// Get the file size
dwSize:=GetFileSize(hFile, nil);
// Create the file mapping
hMapping:=CreateFileMapping(hFile, nil, PAGE_READONLY or SEC_COMMIT, 0, 0, nil);
// Check mapping
if (hMapping > 0) then
begin
// Resource protection
try
// Map view of file
// Check data
if Assigned(lpData) then
begin
// Resource protection
try
// Calculate the crc for the file data
CrcValue:=Crc16(lpData, dwSize, 0);
// Success
result:=ERROR_SUCCESS;
finally
// Unmap view of file
UnmapViewOfFile(lpData);
end;
end
else
// Return error
result:=GetLastError;
finally
// Close the handle
CloseHandle(hMapping);
end;
end
else
// Return error
result:=GetLastError;
finally
// Close the handle
CloseHandle(hFile);
end;
end
else
// Return error
result:=GetLastError;

end;

function FileCrc32(FileName: String; out CrcValue: LongWord): Integer;
var  hFile:         THandle;
hMapping:      THandle;
dwSize:        DWORD;
lpData:        Pointer;
begin

// Open the file for reading

// Check handle
if (hFile <> THandle(-1)) then
begin
// Resource protection
try
// Get the file size
dwSize:=GetFileSize(hFile, nil);
// Create the file mapping
hMapping:=CreateFileMapping(hFile, nil, PAGE_READONLY or SEC_COMMIT, 0, 0, nil);
// Check mapping
if (hMapping > 0) then
begin
// Resource protection
try
// Map view of file
// Check data
if Assigned(lpData) then
begin
// Resource protection
try
// Calculate the crc for the file data
CrcValue:=Crc32(lpData, dwSize, 0);
// Success
result:=ERROR_SUCCESS;
finally
// Unmap view of file
UnmapViewOfFile(lpData);
end;
end
else
// Return error
result:=GetLastError;
finally
// Close the handle
CloseHandle(hMapping);
end;
end
else
// Return error
result:=GetLastError;
finally
// Close the handle
CloseHandle(hFile);
end;
end
else
// Return error
result:=GetLastError;

end;

function Crc32(lpBuffer: Pointer; dwSize: Cardinal; dwSeed: LongWord): LongWord;
var  lpszBuffer:    PChar;
dwIndex:       Integer;
begin

// Set the starting seed
result:=dwSeed;

// Cast the data buffer as pchar
lpszBuffer:=lpBuffer;

// Calculate the 32 bit crc
for dwIndex:=0 to Pred(dwSize) do
begin
// Update the crc value
result:=CT32[Byte(result xor Ord(lpszBuffer^))] xor ((result shr 8) and \$00FFFFFF);
// Push next
Inc(lpszBuffer);
end;

end;

function Crc16(lpBuffer: Pointer; dwSize: Cardinal; wSeed: Word): Word;
var  lpszBuffer:    PChar;
dwIndex:       Integer;
begin

// Cast the data buffer as pchar
lpszBuffer:=lpBuffer;

// Set the starting seed
result:=wSeed;

// Calculate the 16 bit crc of the data
for dwIndex:=0 to Pred(dwSize) do
begin
// Update the crc value
result:=Hi(result) xor CT16[Ord(lpszBuffer^)] xor Lo(result);
// Push next
Inc(lpszBuffer);
end;

end;

function Vrc(lpBuffer: Pointer; dwSize: Cardinal): Byte;
asm
push  esi
push  edi
push  ebx
mov   ebx, 0
mov   esi, eax
mov   edi, edx
@@loop:
test  edi, edi
jz    @@exit
mov   al, [esi]
inc   esi
dec   edi
jmp   @@loop
@@exit:
mov   eax, ebx
pop   ebx
pop   edi
pop   esi
end;

function Lrc(lpBuffer: Pointer; dwSize: Cardinal): Byte;
asm
push  esi
push  edi
push  ebx
mov   ebx, 0
mov   esi, eax
mov   edi, edx
@@loop:
test  edi, edi
jz    @@exit
mov   al, [esi]
xor   bl, al
inc   esi
dec   edi
jmp   @@loop
@@exit:
mov   eax, ebx
pop   ebx
pop   edi
pop   esi
end;

end.
0

Author Commented:
Thanks for all
irvan
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.