ecc200.~pas

delphi实现的二 维 码 生成 控制代 码

        begin
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1;
          Inc(BufferIndex);
          Result := emASCII;
          Exit;
        end;

        else
        begin
          SwitchTriByteBack(Buffer, BufferIndex);
          Result := emASCII;
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1;
          Inc(BufferIndex);
          Exit;
        end;
      end;
    end;

    tsByte2:
    begin
      case NearestSize(Shape, BufferIndex) - BufferIndex of
        2:
        begin
          Byte3 := 0;
          TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
          Inc(BufferIndex, 2);
        end;

        else
        begin
          SwitchTriByteBack(Buffer, BufferIndex);
          Result := emASCII;
          Buffer[BufferIndex] := Source[SourceIndex - 2] + 1; Inc(BufferIndex);
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; Inc(BufferIndex);
        end;
      end;
    end;
  end;
end;

function X12Value(ASCII: Byte) : Byte;
begin
  case ASCII of
    13: Result := 0;
    42: Result := 1;
    62: Result := 2;
    32: Result := 3;
    48..57: Result := ASCII - 48 + 4;
    65..90: Result := ASCII - 65 + 14; 
  end;
end;

//X12字符集没有Unlatch和Pad字符，因此，必须三个X12字符一组进行编码。如果
//可编码字符不足三个，必须退出X12编码模式
function X12_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode;
var
  State: TTriByteState;
  NewMode: TEncodeMode;
  Byte1, Byte2, Byte3: Byte;
begin
  State := tsReady;
  while (SourceIndex <= Length(Source) - 3)
  and (Source[SourceIndex] in X12Set)
  and (Source[SourceIndex + 1] in X12Set)
  and (Source[SourceIndex + 2] in X12Set) do
  begin
    TriByteEncode(
        X12Value(Source[SourceIndex]),
        X12Value(Source[SourceIndex + 1]),
        X12Value(Source[SourceIndex + 2]),
        Buffer[BufferIndex],
        Buffer[BufferIndex + 1]);
        Inc(SourceIndex, 3);
        Inc(BufferIndex, 2);
  end;

  if SourceIndex < Length(Source) then
  begin
    case Length(Source) - SourceIndex of
      1:
      begin
        case NearestSize(Shape, BufferIndex) - BufferIndex of
          1:
          begin
            ASCII_EncodeData(Source, SourceIndex, Buffer, BufferIndex);
            Result := emASCII;
            Exit;
          end;

          else
          begin
            SwitchTriByteBack(Buffer, BufferIndex);
            ASCII_EncodeData(Source, SourceIndex, Buffer, BufferIndex);
            Result := emASCII;
          end;

        end;
      end;

      2:
      begin
        case NearestSize(Shape, BufferIndex) - BufferIndex of
          2:
          begin
            TriByteEncode(
              X12Value(Source[SourceIndex]),
              X12Value(Source[SourceIndex + 1]),
              0,
              Source[SourceIndex],
              Source[SourceIndex + 1]);
          end;

          else
          begin
            SwitchTriByteBack(Buffer, BufferIndex);
            Result := emASCII;
          end;
        end;
      end;
    end;
  end;

  if UptoBound(Shape, BufferIndex) then Exit;
  if NearestSize(Shape, BufferIndex) - BufferIndex <= 1 then Exit;
  SwitchTriByteBack(Buffer, BufferIndex);
  Result := emASCII;
end;

type
  TFourBytes = array[0..3] of Byte;

procedure EDIFACT_EncodeFourBytes(var Bytes: TFourBytes; var Buffer: TByteArray; var BufferIndex: Integer);
var
  T: Longword;
begin
  T := (((Bytes[0] * 64 + Bytes[1]) * 64 + Bytes[2]) * 64) + Bytes[3];
  Buffer[BufferIndex] := T div $10000;  T := T mod $10000;  Inc(BufferIndex);
  Buffer[BufferIndex] := T div $100;    T := T mod $100;    Inc(BufferIndex);
  Buffer[BufferIndex] := T;                                 Inc(BufferIndex);
end;

function EDIFACTValue(ASCII: Byte): Byte;
begin
  if ASCII in [64..94] then Result := ASCII - 64
  else if ASCII in [32..63] then Result := ASCII
  else raise Exception.Create('EDIFACT 求值错误，ASCII超出EDIFACT字符集范围！');
end;

function EDIFACT_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode;
var
  Index, I: Integer;
  Bytes: TFourBytes;
begin
  Index := 0;
  while SourceIndex < Length(Source) do
  begin
    if Index = 0 then
    begin
      Result := LookAhead(Source, SourceIndex, EncodeMode);
      if Result <> EncodeMode then
      begin
        Bytes[Index] := 31;
        Inc(Index);
        for I := Index to 3 do Bytes[I] := 0;
        EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex);
        Exit;
      end;
    end;
    if (Source[SourceIndex] in EDIFACTSet) then
    begin
      Bytes[Index] := EDIFACTValue(Source[SourceIndex]);
      Inc(Index);
      Inc(SourceIndex);
      if Index = 4 then
      begin
        EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex);
        Index := 0;
      end;
    end
    else
    begin
      Bytes[Index] := 31;
      Inc(Index);
      for I := Index to 3 do Bytes[I] := 0;
      EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex);
      Result := emASCII;
      Exit;
    end;
  end;

  case Index of
    0:
    begin
      if UptoBound(Shape, BufferIndex) then Exit;
    end;

    1:
    begin
      case NearestSize(Shape, BufferIndex) - BufferIndex of
        1..2:
        begin
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1;
          Inc(BufferIndex);
          Result := emASCII;
          Exit;
        end;

        else
        begin
          Bytes[1] := 31;
          Bytes[2] := 0;
          Bytes[3] := 0;
          EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex);
          Result := emASCII;
          Exit;
        end;
      end;
    end;

    2:
    begin
      case NearestSize(Shape, BufferIndex) - BufferIndex of
        1..2:
        begin
          Buffer[BufferIndex] := Source[SourceIndex - 2] + 1;
          Inc(BufferIndex);
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1;
          Inc(BufferIndex);
          Result := emASCII;
          Exit;
        end;

        else
        begin
          Bytes[2] := 31;
          Bytes[3] := 0;
          EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex);
          Result := emASCII;
          Exit;
        end;
      end;
    end;

    3:
    begin
      Bytes[3] := 31;
      EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex);
      Result := emASCII;
      Exit;
    end;
  end;

  Bytes[Index] := 31;
  Inc(Index);
  for I := Index to 3 do Bytes[I] := 0;
  EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex);
  Result := emASCII;
end;

function Base256_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode;
var
  Len: Integer;
  Bytes: array [0..5000] of Byte;
  I: Integer;
begin
  Len := 0;
  while SourceIndex < Length(Source) do
  begin
    Result := LookAhead(Source, SourceIndex, EncodeMode);
    if (Result <> emBase256) or (Len > 1555) then
    begin
      Result := emASCII;
      case Len of
        0:
        begin
          Buffer[BufferIndex] := Random255(Len, BufferIndex + 1);
          Inc(BufferIndex);
          Exit;
        end;

        1..249:
        begin
          Buffer[BufferIndex] := Random255(Len, BufferIndex + 1);
          Inc(BufferIndex);
          for I := 0 to Len - 1 do
          begin
            Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1);
            Inc(BufferIndex);
          end;
          Exit;
        end;

        250..1555:
        begin
          Buffer[BufferIndex] := Random255(Len div 250 + 249, BufferIndex + 1);
          Inc(BufferIndex);
          Buffer[BufferIndex] := Random255(Len mod 250, BufferIndex + 1);
          Inc(BufferIndex);
          for I := 0 to Len - 1 do
          begin
            Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1);
            Inc(BufferIndex);
          end;
          Exit;
        end;

        else raise Exception.Create('Base256数据块大于1555字节！');
      end;
    end
    else
    begin
      Bytes[Len] := Source[SourceIndex];
      Inc(SourceIndex);
      Inc(Len);
    end;
  end;

  case Len of
    0:
    begin
      Buffer[BufferIndex] := Random255(Len, BufferIndex + 1);;
      Inc(BufferIndex);
    end;

    1..249:
    begin
      Buffer[BufferIndex] := Random255(Len, BufferIndex + 1);
      Inc(BufferIndex);
      for I := 0 to Len - 1 do
      begin
        Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1);
        Inc(BufferIndex);
      end;
    end;

    250..1555:
    begin
      Buffer[BufferIndex] := Random255(Len div 250 + 249, BufferIndex + 1);
      Inc(BufferIndex);
      Buffer[BufferIndex] := Random255(Len mod 250, BufferIndex + 1);
      Inc(BufferIndex);
      for I := 0 to Len - 1 do
      begin
        Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1);
        Inc(BufferIndex);
      end;
    end;

    else raise Exception.Create('Base256数据块大于1555字节！');
  end;
  Result := emASCII;
end;

procedure MakeCodeword(Source : TByteArray; Size : TECC200Size; Shape : TEcc200Shape; var EncodeStream : TByteArray; var EncodeSize : TECC200Size);
var
  Buffer : TByteArray;
  SourceIndex, BufferIndex: Integer;
  EncodeMode: TEncodeMode;
  s: TECC200Size;
  outlen, i: Integer;
begin
  SetLength(Buffer, 5000);
  EncodeMode := emASCII;
  SourceIndex := 0;
  BufferIndex := 0;
  while SourceIndex < Length(Source) do
  begin
    while (EncodeMode = emASCII)    and (SourceIndex < Length(Source)) do EncodeMode := ASCII_Encode   (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex);
    while (EncodeMode = emC40)      and (SourceIndex < Length(Source)) do EncodeMode := C40_Encode     (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex);
    while (EncodeMode = emText)     and (SourceIndex < Length(Source)) do EncodeMode := Text_Encode    (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex);
    while (EncodeMode = emX12)      and (SourceIndex < Length(Source)) do EncodeMode := X12_Encode     (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex);
    while (EncodeMode = emEDIFACT)  and (SourceIndex < Length(Source)) do EncodeMode := EDIFACT_Encode (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex);
    while (EncodeMode = emBase256)  and (SourceIndex < Length(Source)) do EncodeMode := Base256_Encode (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex);
  end;

  if Size = ecc200_Autosize then
  begin
    if Shape = ecc200_Square then
    begin
      for s := ecc200_10x10 to ecc200_144x144 do
      begin
        outlen := ECC200SymbolParams[s].DataLength;
        if outlen >= BufferIndex then
        begin
          EncodeSize := s;
          break;
        end;
      end;
    end
    else
    begin
      for s := ecc200_8x18 to ecc200_16x48 do
      begin
        outlen := ECC200SymbolParams[s].DataLength;
        if outlen >= BufferIndex then
        begin
          EncodeSize := s;
          break;
        end;
      end;
    end;
    if outlen < BufferIndex then raise Exception.Create('数据超出二维码容量！');
  end
  else
  begin
    EncodeSize := Size;
    outlen := ECC200SymbolParams[Size].DataLength;
    if outlen < BufferIndex then raise Exception.Create('数据超出二维码容量！');
  end;

  SetLength(EncodeStream, outlen);
  for i := 0 to BufferIndex - 1 do
  begin
    EncodeStream[i] := Buffer[i];
  end;
  if BufferIndex < outlen then
  begin
    EncodeStream[BufferIndex] := 129;
    for i := BufferIndex + 1 to outlen - 1 do
    begin
      EncodeStream[i] := Random253(129, i + 1);
    end;
  end;
end;

function Encode(CodewordStream : TByteArray; Size : TECC200Size) : TByteArray;
var
  x, y, z : TPloy;
  i, j, p : integer;
  BlockCount, DataLen, ErrorLen : integer;
begin
  case Size of
    ecc200_10x10 :
    begin
      SetLength(y, Length(Ploy5));
      for i := 0 to 5 do y[i] := Ploy5[i];
    end;
    ecc200_12x12 :
    begin
      SetLength(y, Length(Ploy7));
      for i := 0 to 7 do y[i] := Ploy7[i];
    end;
    ecc200_14x14 :
    begin
      SetLength(y, Length(Ploy10));
      for i := 0 to 10 do y[i] := Ploy10[i];
    end;
    ecc200_16x16 :
    begin
      SetLengt