[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

calculate CRC16 for strings in Delphi?

Posted on 2006-06-04
3
Medium Priority
?
3,797 Views
Last Modified: 2008-02-20
Any body, can help me calculate CRC 16 for strings in Delphi programming?

thanks
irvann
0
Comment
Question by:irvann
3 Comments
 
LVL 28

Accepted Solution

by:
2266180 earned 375 total points
ID: 16830810
see this link for pretty complete information: http://www.efg2.com/Lab/Mathematics/CRC.htm
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 16833760
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,
              $F3B97148, $84BE41DE, $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
              $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
  hFile:=FileOpen(FileName, fmOpenRead or fmShareDenyNone);

  // 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
              lpData:=MapViewOfFile(hMapping, FILE_MAP_READ, 0, 0, 0);
              // 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
  hFile:=FileOpen(FileName, fmOpenRead or fmShareDenyNone);

  // 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
              lpData:=MapViewOfFile(hMapping, FILE_MAP_READ, 0, 0, 0);
              // 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]
  add   bl, al
  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 Comment

by:irvann
ID: 16848921
Thanks for all
irvan
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
Despite its rising prevalence in the business world, "the cloud" is still misunderstood. Some companies still believe common misconceptions about lack of security in cloud solutions and many misuses of cloud storage options still occur every day. …
Suggested Courses
Course of the Month20 days, 2 hours left to enroll

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question