CRC32验证数组问题

奔雷手 2011-04-15 05:46:02



unit uCRC;

interface

  procedure setup_crc_tables;

  function table_driven_crc(crc:Word;bufptr:Pointer;len:Word):Word;

  procedure Trace(const DebugInfo: string);

  procedure Trace2(const DebugFormat: string; const Args: array of const);

var

  crc_table : array[0..255] of Word;

const

  GENPOLY = $1021;

implementation

uses Windows,Dialogs,SysUtils;

function compute_crc( crc:Word;bufptr:Pointer;len:Word):Word;

var i:integer;

begin

    while len >0 do

    begin

      len := len-1;

      crc := crc xor (Byte(bufptr^) shl 8);

      bufptr := Pointer(LongWord(bufptr)   +  1);

      for i:=0  to 7 do

      begin

         if (crc and $8000)<>0 then

           crc := (crc shl 1) xor GENPOLY

         else

           crc := crc shl 1;

      end;

    end;

    Result := crc ;

end;

procedure setup_crc_tables;

var count:integer;

     zero:Byte;

begin

  zero := $0;

  for count:=0 to 255 do

    crc_table[count] := compute_crc(count shl 8, @zero, 1);

end;

function table_driven_crc(crc:Word;bufptr:Pointer;len:Word):Word;

begin

    while len>0 do

    begin

      len := len -1;

      crc := crc_table[ (crc div $100) xor Byte(bufptr^) ] xor (crc shl 8);

      bufptr := Pointer(LongWord(bufptr)   +  1);

    end;

    Result:= crc ;

end;

end;

使用



procedure TMainComm.SendData;

var i:Integer;

    p:Pointer;

    crc:Word;

    SendString:string;

    Ret:Integer;

    Count:Integer;

    SendBuf:array[0..7] of byte;

begin

      SendBuf[0] := $2;

      SendBuf[1] := $0;

      SendBuf[2] := $1;

      SendBuf[3] := $A7;

      SendBuf[4] := $FF;

      SendBuf[5] := $FF;

      SendBuf[6] := $3;

  Count:=7;

  crc := 0;

  p := @Sendbuf;

  p := Pointer(LongWord(p)   +  1);

  crc := table_driven_crc(crc, p,count-4);

  SendBuf[count-3] := (crc and $FF00) shr 8;

  SendBuf[count-2] := crc and $00FF;

end;