decfmt.pas

cipher 5.1。一个几乎包含了所有常见的加密算法的控件

  while S < L do
  begin
    B := 0;
    J := 4;
    while (J > 0) and (S < L) do
    begin
      I := TableFind(S^, T, 65);
      Inc(S);
      if I >= 0 then
        if I < 64 then
        begin
          B := B shl 6 or Byte(I);
          Dec(J);
        end else L := S;
    end;
    if J > 0 then
      if J >= 4 then
      begin
        J := 0;
        Break;
      end else B := B shl (6 * J);
    I := 2;
    while I >= 0 do
    begin
      D[I] := Char(B);
      B := B shr 8;
      Dec(I);
    end;
    Inc(D, 3);
  end;
  SetLength(Result, D - PChar(Result) - J);
end;

class function TFormat_MIME64.CharTable: PChar; assembler;
asm
      MOV  EAX,OFFSET @@1
      RET  // must be >= 65 Chars
@@1:  DB  'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/='
      DB  ' $()[]{},;:-_\*"''',9,10,13,0  // special and skipped chars
end;

class function TFormat_PGP.DoExtractCRC(const Value; var Size: Integer): LongWord;
var
  L: PChar;
  C: Char;
  R: String;
begin
  Result := $FFFFFFFF;
  C := CharTable[64];                      // get padding char, per default '='
  L := PChar(@Value) + Size;
  while L <> PChar(@Value) do
    if L^ = C then Break else Dec(L);      // scan reverse for padding char
  if L - PChar(@Value) >= Size - 5 then    // remaining chars must be > 4 ,i.e. '=XQRT'
  try
    Inc(L);
    R := inherited DoDecode(L^, Size - (L - PChar(@Value)));
    if Length(R) >= 3 then
    begin
      Result := 0;
      Move(PChar(R)^, Result, 3);
      Size := L - PChar(@Value);
    end;
  except
  end;
end;

class function TFormat_PGP.DoEncode(const Value; Size: Integer): Binary;
var
  CRC: LongWord;
begin
  Result := '';
  if Size <= 0 then Exit;
  Result := InsertCR(inherited DoEncode(Value, Size), PGPCharsPerLine); // 80 chars per line
  CRC := CRCCalc(CRC_24, Value, Size);                               // calculate 24Bit Checksum
  SwapBytes(CRC, 3);                                                 // PGP use Big Endian
  if Result[Length(Result)] <> #10 then Result := Result + #13#10;   // insert CR iff needed, CRC must be in next line
  Result := Result + '=' + inherited DoEncode(CRC, 3);                 // append CRC
end;

class function TFormat_PGP.DoDecode(const Value; Size: Integer): Binary;
var
  CRC: LongWord;
begin
  Result := '';
  if Size <= 0 then Exit;
  CRC := DoExtractCRC(Value, Size);
  Result := inherited DoDecode(Value, Size);
  if CRC <> $FFFFFFFF then // iff CRC found check it
  begin
    SwapBytes(CRC, 3);
    if CRC <> CRCCalc(CRC_24, PChar(Result)^, Length(Result)) then
      raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassname(Self)]);
  end;
end;

class function TFormat_UU.DoEncode(const Value; Size: Integer): Binary;
var
  S,T,D: PChar;
  L,I: Integer;
  B: Cardinal;
begin
  Result := '';
  if Size <= 0 then Exit;
  SetLength(Result, Size * 4 div 3 + Size div 45 + 10);
  D := PChar(Result);
  T := CharTable;
  S := PChar(@Value);
  while Size > 0 do
  begin
    L := Size;
    if L > 45 then L := 45;
    Dec(Size, L);
    D^ := T[L];
    while L > 0 do
    begin
      B := 0;
      for I := 0 to 2 do
      begin
        B := B shl 8;
        if L > 0 then
        begin
          B := B or Byte(S^);
          Inc(S);
        end;
        Dec(L);
      end;
      for I := 4 downto 1 do
      begin
        D[I] := T[B and $3F];
        B := B shr 6;
      end;
      Inc(D, 4);
    end;
    Inc(D);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TFormat_UU.DoDecode(const Value; Size: Integer): Binary;
var
  T,D,L,S: PChar;
  I,E: Integer;
  B: Cardinal;
begin
  Result := '';
  if Size <= 0 then Exit;
  SetLength(Result, Size);
  S := PChar(@Value);
  L := S + Size;
  D := PChar(Result);
  T := CharTable;
  repeat
    Size := TableFind(S^, T, 64);
    if (Size < 0) or (Size > 45) then
      raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]);
    Inc(S);
    while Size > 0 do
    begin
      B := 0;
      I := 4;
      while (I > 0) and (S <= L) do
      begin
        E := TableFind(S^, T, 64);
        if E >= 0 then
        begin
          B := B shl 6 or Byte(E);
          Dec(I);
        end;
        Inc(S);
      end;
      I := 2;
      repeat
        D[I] := Char(B);
        B    := B shr 8;
        Dec(I);
      until I < 0;
      if Size > 3 then Inc(D, 3) else Inc(D, Size);
      Dec(Size, 3);
    end;
  until S >= L;
  SetLength(Result, D - PChar(Result));
end;

class function TFormat_UU.DoIsValid(const Value; Size: Integer): Boolean;
var
  S,T: PChar;
  L,I,P: Integer;
begin
  Result := False;
  T := CharTable;
  L := StrLen(T);
  S := PChar(@Value);
  P := 0;
  while Size > 0 do
  begin
    I := TableFind(S^, T, L);
    if I >= 0 then
    begin
      Dec(Size);
      Inc(S);
      if P = 0 then
      begin
        if I > 45 then Exit;
        P := (I * 4 + 2) div 3;
      end else
        if I < 64 then Dec(P);
    end else Exit;
  end;
  if P <> 0 then Exit;
  Result := True;
end;

class function TFormat_UU.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET  // must be >= 64 Chars
@@1:  DB   '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'
      DB   ' ',9,10,13,0
end;

class function TFormat_XX.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
      DB   ' "()[]''',9,10,13,0
end;

const
  ESCAPE_CodesL: PChar = 'abtnvfr';
  ESCAPE_CodesU: PChar = 'ABTNVFR';

class function TFormat_ESCAPE.DoDecode(const Value; Size: Integer): Binary;
var
  D,S,T: PChar;
  I: Integer;
begin
  Result := '';
  if Size <= 0 then Exit;
  SetLength(Result, Size);
  D := PChar(Result);
  S := PChar(@Value);
  T := S + Size;
  while S < T do
  begin
    if S^ = '\' then
    begin
      Inc(S);
      if S > T then Break;
      if UpCase(S^) = 'X' then
      begin
        if S + 2 > T then
          raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]);
        I := TableFind(UpCase(S[1]), TFormat_HEX.CharTable, 16);
        if I < 0 then
          raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]);
        D^ := Char(I shl 4);
        I := TableFind(UpCase(S[2]), TFormat_HEX.CharTable, 16);
        if I < 0 then
          raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassName(Self)]);
        D^ := Char(Byte(D^) or I);
        Inc(S, 2);
      end else
      begin
        I := TableFind(UpCase(S^), ESCAPE_CodesU, 7);
        if I >= 0 then D^ := Char(I + 7)
          else D^ := S^;
      end;
    end else D^ := S^;
    Inc(D);
    Inc(S);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TFormat_ESCAPE.DoEncode(const Value; Size: Integer): Binary;
var
  S: PByte;
  D,T: PChar;
  I: Integer;
begin
  Result := '';
  if Size = 0 then Exit;
  SetLength(Result, Size + 8);
  I := Size;
  D := PChar(Result);
  S := PByte(@Value);
  T := TFormat_HEX.CharTable;
  while Size > 0 do
  begin
    if I <= 0 then
    begin
      I := D - PChar(Result);
      SetLength(Result, I + Size + 8);
      D := PChar(Result) + I;
      I := Size;
    end;
    if (S^ < 32) {or (S^ > $7F)} then
      if (S^ >= 7) and (S^ <= 13) then
      begin
        D[0] := '\';
        D[1] := ESCAPE_CodesL[S^ - 7];
        Inc(D, 2);
        Dec(I, 2);
      end else
      begin
        D[0] := '\';
        D[1] := 'x';
        D[2] := T[S^ shr 4];
        D[3] := T[S^ and $F];
        Inc(D, 4);
        Dec(I, 4);
      end
    else
      if S^ = Ord('\') then
      begin
        D[0] := '\';
        D[1] := '\';
        Inc(D, 2);
        Dec(I, 2);
      end else
        if S^ = Ord('"') then
        begin
          D[0] := '\';
          D[1] := '"';
          Inc(D, 2);
          Dec(I, 2);
        end else
        begin
          D^ := Char(S^);
          Inc(D);
          Dec(I);
        end;
    Dec(Size);
    Inc(S);
  end;
  SetLength(Result, D - PChar(Result));
end;

function InsertCR(const Value: String; BlockSize: Integer): String;
var
  I: Integer;
  S,D: PChar;
begin
  if (BlockSize <= 0) or (Length(Value) <= BlockSize) then
  begin
    Result := Value;
    Exit;
  end;
  I := Length(Value);
  SetLength(Result, I + I * 2 div BlockSize + 2);
  S := PChar(Value);
  D := PChar(Result);
  repeat
    Move(S^, D^, BlockSize);
    Inc(S, BlockSize);
    Inc(D, BlockSize);
    D^ := #13; Inc(D);
    D^ := #10; Inc(D);
    Dec(I, BlockSize);
  until I < BlockSize;
  Move(S^, D^, I);
  Inc(D, I);
  SetLength(Result, D - PChar(Result));
end;

function DeleteCR(const Value: String): String;
var
  S,D: PChar;
  I: Integer;
begin
  I := Length(Value);
  SetLength(Result, I);
  D := PChar(Result);
  S := PChar(Value);
  while I > 0 do
  begin
    if (S^ <> #10) and (S^ <> #13) then
    begin
      D^ := S^;
      Inc(D);
    end;
    Inc(S);
    Dec(I);
  end;
  SetLength(Result, D - PChar(Result));
end;

function InsertBlocks(const Value, BlockStart, BlockEnd: String; BlockSize: Integer): String;
var
  I,LS,LE: Integer;
  D,S: PChar;
begin
  if (BlockSize <= 0) or (Length(Value) <= BlockSize) then
  begin
    Result := Value;
    Exit;
  end;
  I := Length(Value);
  LS := Length(BlockStart);
  LE := Length(BlockEnd);
  SetLength(Result, I + (I div BlockSize + 1) * (LS + LE));
  S := PChar(Value);
  D := PChar(Result);
  repeat
    Move(PChar(BlockStart)^, D^, LS); Inc(D, LS);
    Move(S^, D^, BlockSize);          Inc(D, BlockSize);
    Move(PChar(BlockEnd)^, D^, LE);   Inc(D, LE);
    Dec(I, BlockSize);
    Inc(S, BlockSize);
  until I < BlockSize;
  if I > 0 then
  begin
    Move(PChar(BlockStart)^, D^, LS); Inc(D, LS);
    Move(S^, D^, I);                  Inc(D, I);
    Move(PChar(BlockEnd)^, D^, LE);   Inc(D, LE);
  end;
  SetLength(Result, D - PChar(Result));
end;

function RemoveBlocks(const Value, BlockStart, BlockEnd: String): String;
var
  LS,LE: Integer;
  S,D,L,K: PChar;
begin
  SetLength(Result, Length(Value));
  LS := Length(BlockStart);
  LE := Length(BlockEnd);
  D := PChar(Result);
  S := PChar(Value);
  L := S + Length(Value);
  repeat
    if S > L then Break;
    if LS > 0 then
    begin
      S := StrPos(S, PChar(BlockStart));
      if S = nil then Break;
      Inc(S, LS);
      if S > L then Break;
    end;
    K := StrPos(S, PChar(BlockEnd));
    if K = nil then K := L;
    Move(S^, D^, K - S);
    Inc(D, K - S);
    S := K + LE;
  until S >= L;
  SetLength(Result, D - PChar(Result));
end;

end.