decfmt.pas

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

{Copyright:      Hagen Reddmann  HaReddmann at T-Online dot de
 Author:         Hagen Reddmann
 Version:        5.1, Delphi Encryption Compendium
                 Delphi 5-7, BCB 3-4, designed and testet under D5
 Description:    Format Konvertion Utilitys for the DEC Packages
 known Problems: none
 Remarks:        freeware, but this Copyright must be included
                 add about 10Kb code if all TFormats used
                 designed to made universal code, not very fast implementations
                 use lookup tables and formats can contains special chars

 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
 * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}

unit DECFmt;

interface

uses Windows, SysUtils, Classes, DECUtil;

{$I VER.INC}

type
  TDECFormat      = class;

  TFormat_Copy    = class;    // copy input to output, it's the Default Format, eg FormaClass = nil
  TFormat_HEX     = class;    // HEXadecimal in UpperCase
  TFormat_HEXL    = class;    // HEXadecimal in Lowercase
  TFormat_MIME32  = class;    // MIME like format for Base 32
  TFormat_MIME64  = class;    // MIME Base 64 format
  TFormat_PGP     = class;    // PGP's MIME Base 64 with PGP's Checksums
  TFormat_UU      = class;    // Unix UU Base 64
  TFormat_XX      = class;    // Unix XX base 64
  TFormat_ESCAPE  = class;    // Escaped Strings

  TDECFormatClass = class of TDECFormat;

  TDECFormat = class(TDECObject) // for binary one to one convert = fmtCOPY
  protected
    class function DoEncode(const Value; Size: Integer): Binary; virtual; abstract;
    class function DoDecode(const Value; Size: Integer): Binary; virtual; abstract;
    class function DoIsValid(const Value; Size: Integer): Boolean; virtual; abstract;
  public
    class function Encode(const Value: Binary): Binary; overload;
    class function Encode(const Value; Size: Integer): Binary; overload;
    class function Decode(const Value: Binary): Binary; overload;
    class function Decode(const Value; Size: Integer): Binary; overload;
    class function IsValid(const Value: Binary): Boolean; overload;
    class function IsValid(const Value; Size: Integer): Boolean; overload;
  end;

  TFormat_Copy = class(TDECFormat)
  protected
    class function DoEncode(const Value; Size: Integer): Binary; override;
    class function DoDecode(const Value; Size: Integer): Binary; override;
    class function DoIsValid(const Value; Size: Integer): Boolean; override;
  end;

  TFormat_HEX = class(TDECFormat) // Hexadecimal = fmtHEX
  protected
    class function DoEncode(const Value; Size: Integer): Binary; override;
    class function DoDecode(const Value; Size: Integer): Binary; override;
    class function DoIsValid(const Value; Size: Integer): Boolean; override;
  public
    class function CharTable: PChar; virtual;
  end;

  TFormat_HEXL = class(TFormat_HEX) // Hexadecimal lowercase = fmtHEXL
  public
    class function CharTable: PChar; override;
  end;

  TFormat_MIME32 = class(TFormat_HEX)  // MIME Base 32 = fmtMIME32
  protected
    class function DoEncode(const Value; Size: Integer): Binary; override;
    class function DoDecode(const Value; Size: Integer): Binary; override;
  public
    class function CharTable: PChar; override;
  end;

  TFormat_MIME64 = class(TFormat_HEX)  // MIME Base 64 = fmtMIME64
  protected
    class function DoEncode(const Value; Size: Integer): Binary; override;
    class function DoDecode(const Value; Size: Integer): Binary; override;
  public
    class function CharTable: PChar; override;
  end;

  TFormat_PGP = class(TFormat_MIME64)
  protected
    class function DoExtractCRC(const Value; var Size: Integer): LongWord;
    class function DoEncode(const Value; Size: Integer): Binary; override;
    class function DoDecode(const Value; Size: Integer): Binary; override;
  end;

  TFormat_UU = class(TDECFormat) // UU Encode = fmtUU
  protected
    class function DoEncode(const Value; Size: Integer): Binary; override;
    class function DoDecode(const Value; Size: Integer): Binary; override;
    class function DoIsValid(const Value; Size: Integer): Boolean; override;
  public
    class function CharTable: PChar; virtual;
  end;

  TFormat_XX = class(TFormat_UU) // XX Encode = fmtXX
  public
    class function CharTable: PChar; override;
  end;

  TFormat_ESCAPE = class(TDECFormat)
  protected
    class function DoEncode(const Value; Size: Integer): Binary; override;
    class function DoDecode(const Value; Size: Integer): Binary; override;
  end;

function  ValidFormat(FormatClass: TDECFormatClass = nil): TDECFormatClass;
function  FormatByName(const Name: String): TDECFormatClass;
function  FormatByIdentity(Identity: LongWord): TDECFormatClass;
// insert #13#10 Chars in Blocks from BlockSize
function InsertCR(const Value: String; BlockSize: Integer): String;
// delete all #13 and #10 Chars
function DeleteCR(const Value: String): String;
// format any String to a Block
function InsertBlocks(const Value, BlockStart, BlockEnd: String; BlockSize: Integer): String;
// remove any Block format
function RemoveBlocks(const Value, BlockStart, BlockEnd: String): String;

var
  PGPCharsPerLine: Integer = 80;

implementation

uses CRC;

resourcestring
  sStringFormatExists     = 'String format "%d" not exists.';
  sInvalidStringFormat    = 'Input is not an valid %s Format.';
  sInvalidFormatString    = 'Input can not be convert to %s Format.';
  sFormatNotRegistered    = 'String format not registered.';

function ValidFormat(FormatClass: TDECFormatClass = nil): TDECFormatClass;
begin
  if FormatClass <> nil then Result := FormatClass
    else Result := TFormat_Copy;
end;

function FormatByName(const Name: String): TDECFormatClass;
begin
  Result := TDECFormatClass(DECClassByName(Name, TDECFormat));
end;

function FormatByIdentity(Identity: LongWord): TDECFormatClass;
begin
  Result := TDECFormatClass(DECClassByIdentity(Identity, TDECFormat));
end;

class function TDECFormat.Encode(const Value: Binary): Binary;
begin
  Result := DoEncode(Value[1], Length(Value));
end;

class function TDECFormat.Encode(const Value; Size: Integer): Binary;
begin
  Result := DoEncode(Value, Size);
end;

class function TDECFormat.Decode(const Value: Binary): Binary;
begin
  Result := DoDecode(Value[1], Length(Value));
end;

class function TDECFormat.Decode(const Value; Size: Integer): Binary;
begin
  Result := DoDecode(Value, Size);
end;

class function TDECFormat.IsValid(const Value: Binary): Boolean;
begin
  Result := DoIsValid(Value[1], Length(Value));
end;

class function TDECFormat.IsValid(const Value; Size: Integer): Boolean;
begin
  Result := DoIsValid(Value, Size);
end;

// .TFormat_Copy
class function TFormat_Copy.DoEncode(const Value; Size: Integer): Binary;
begin
  SetLength(Result, Size);
  Move(Value, Result[1], Size);
end;

class function  TFormat_Copy.DoDecode(const Value; Size: Integer): Binary;
begin
  SetLength(Result, Size);
  Move(Value, Result[1], Size);
end;

class function  TFormat_Copy.DoIsValid(const Value; Size: Integer): Boolean;
begin
  Result := Size >= 0;
end;

function TableFind(Value: Char; Table: PChar; Len: Integer): Integer; assembler;
asm // Utility for TStringFormat_XXXXX
      PUSH  EDI
      MOV   EDI,EDX
      REPNE SCASB
      MOV   EAX,0
      JNE   @@1
      MOV   EAX,EDI
      SUB   EAX,EDX
@@1:  DEC   EAX
      POP   EDI
end;

class function TFormat_HEX.DoEncode(const Value; Size: Integer): Binary;
var
  S: PByte;
  D,T: PChar;
begin
  Result := '';
  if Size <= 0 then Exit;
  SetLength(Result, Size * 2);
  T := CharTable;
  D := PChar(Result);
  S := PByte(@Value);
  while Size > 0 do
  begin
    D[0] := T[S^ shr  4];
    D[1] := T[S^ and $F];
    Inc(D, 2);
    Inc(S);
    Dec(Size);
  end;
end;

class function TFormat_HEX.DoDecode(const Value; Size: Integer): Binary;
var
  S: PChar;
  D: PByte;
  T: PChar;
  I,P: Integer;
  HasIdent: Boolean;
begin
  Result := '';
  if Size <= 0 then Exit;
  SetLength(Result, Size div 2 +1);
  T := CharTable;
  D := PByte(Result);
  S := PChar(@Value);
  I := 0;
  HasIdent := False;
  while Size > 0 do
  begin
    P := TableFind(S^, T, 18);
    if P < 0 then P := TableFind(UpCase(S^), T, 16);
    if P < 0 then
      raise EDECException.CreateFmt(sInvalidStringFormat, [DECClassname(Self)]);
    Inc(S);
    if P >= 0 then
      if P > 16 then
      begin
        if not HasIdent then
        begin
          HasIdent := True;
          I := 0;
          D := PByte(Result);
        end;
      end else
      begin
        if Odd(I) then
        begin
          D^ := D^ or P;
          Inc(D);
        end else D^ := P shl 4;
        Inc(I);
      end;
    Dec(Size);
  end;
  SetLength(Result, PChar(D) - PChar(Result));
end;

class function TFormat_HEX.DoIsValid(const Value; Size: Integer): Boolean;
var
  S,T: PChar;
  L: Integer;
begin
  Result := True;
  T := CharTable;
  L := StrLen(T);
  S := PChar(@Value);
  while Result and (Size > 0) do
    if TableFind(S^, T, L) >= 0 then
    begin
      Dec(Size);
      Inc(S);
    end else Result := False;
end;

class function TFormat_HEX.CharTable: PChar; assembler;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '0123456789ABCDEF'     // Table must be >= 18 Chars
      DB   'X$ abcdefhHx()[]{},;:-_/\*+"''',9,10,13,0
end;

class function TFormat_HEXL.CharTable: PChar;
asm
      MOV  EAX,OFFSET @@1
      RET
@@1:  DB   '0123456789abcdef'     // Table must be >= 18 Chars
      DB   'X$ ABCDEFhHx()[]{},;:-_/\*+"''',9,10,13,0
end;

class function TFormat_MIME32.DoEncode(const Value; Size: Integer): Binary;
var
  S: PByteArray;
  D,T: PChar;
  I: Integer;
begin
  Result := '';
  if Size <= 0 then Exit;
  Size := Size * 8;
  SetLength(Result, Size div 5 + 5);
  D := PChar(Result);
  T := CharTable;
  S := PByteArray(@Value);
  I := 0;
  while I < Size do
  begin
    D^ := T[PWord(@S[I shr 3])^ shr (I and $7) and $1F];
    Inc(D);
    Inc(I, 5);
  end;
  SetLength(Result, D - PChar(Result));
end;

class function TFormat_MIME32.DoDecode(const Value; Size: Integer): Binary;
var
  S,T,D: PChar;
  I,V: Integer;
begin
  Result := '';
  if Size <= 0 then Exit;
  T := CharTable;
  SetLength(Result, Size * 5 div 8);
  D := PChar(Result);
  FillChar(D^, Length(Result), 0);
  S := PChar(@Value);
  Size := Size * 5;
  I := 0;
  while I < Size do
  begin
    V := TableFind(S^, T, 32);
    if V < 0 then V := TableFind(UpCase(S^), T, 32);
    if V >= 0 then
    begin
      PWord(@D[I shr 3])^ := PWord(@D[I shr 3])^ or (V shl (I and $7));
      Inc(I, 5);
    end else Dec(Size, 5);
    Inc(S);
  end;
  SetLength(Result, Size div 8);
end;

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

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

class function TFormat_MIME64.DoDecode(const Value; Size: Integer): Binary;
var
  B: Cardinal;
  J,I: Integer;
  S,D,L,T: PChar;
begin
  Result := '';
  if Size <= 0 then Exit;
  SetLength(Result, Size);
  Move(Value, PChar(Result)^, Size);
  T := CharTable;
  D := PChar(Result);
  S := D;
  L := S + Size;
  J := 0;