mitec_base64.pas

一个很不错的系统信息控件

unit MiTeC_Base64;

interface

uses Windows, Classes, SysUtils;

type
  TBase64EncodingStream = class(TStream)
  private
    Source: TMemoryStream;
    Buf: array[0..2] of Byte;
  protected
    OutputStream: TStream;
    TotalBytesProcessed: Longint;
    BytesWritten: Longint;
  public
    constructor Create(AOutputStream: TStream);
    destructor Destroy; override;

    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;


  TBase64DecodingStream = class(TStream)
  private
    Source: TMemoryStream;
    BuffToDecode: array[0..3] of byte;
    BytesReaded: longint;
    BytesWritten: Longint;
  protected
    OutputStream: TStream;
  public
    constructor Create(AOutputStream: TStream);
    destructor Destroy; override;

    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;

function Base64Encode(const s: string): string;
function Base64Decode(const s: string): string;

function CodesToStr(const S: string): string;
function StrToCodes(const S: string): string;

implementation

const
  EncodingTable: PChar =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

  DecodingTable: array[Byte] of Byte =
    (99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,  // 0-15
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,  // 16-31
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 62, 99, 99, 99, 63,  // 32-47
     52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 99, 99, 99, 64, 99, 99,  // 48-63
     99, 00, 01, 02, 03, 04, 05, 06, 07, 08, 09, 10, 11, 12, 13, 14,  // 64-79
     15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 99, 99, 99, 99, 99,  // 80-95
     99, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,  // 96-111
     41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 99, 99, 99, 99, 99,  // 112-127
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99);

{  Base64: string = '23456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz~#%&*+-';
    UnBase64: array[0..255] of byte =
       (128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128, //0-15
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //16-31
        128,128,128, 58,128, 59, 60,128, 128,128, 61, 62,128, 63,128,128,  //32-47
        128,128,  0,  1,  2,  3,  4,  5,   6,  7,128,128,128,128,128,128,  //48-63
        128,  8,  9, 10, 11, 12, 13, 14,  15,128, 16, 17, 18, 19, 20,128,  //64-79
         21, 22, 23, 24, 25, 26, 27, 28,  29, 30, 31,128,128,128,128,128,  //80-95
        128, 32, 33, 34, 35, 36, 37, 38,  39, 40, 41, 42,128, 43, 44, 45,  //96-111
         46, 47, 48, 49, 50, 51, 52, 53,  54, 55, 56,128,128,128, 57,128,  //112-127
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //128-143
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //144-159
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //160-175
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //176-191
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //192-207
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //208-223
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128,  //224-239
        128,128,128,128,128,128,128,128, 128,128,128,128,128,128,128,128);  //240-255}

function Base64Encode(const s: string): string;
{var
  s4: string;
  i, j, k: integer;
  b: byte;
begin
  Result := '';
  SetLength(s4,4);
  b:=0;
  i:=1;
  j:=2;
  k:=2;
  while i<=length(s) do begin
    b:=b or ((ord(s[i]) and $C0) shr k);
    inc(k,2);
    s4[j]:=Base64[(ord(s[i]) and $3F)+1];
    inc(i);
    inc(j);
    if j>4 then begin
      s4[1]:=Base64[b+1];
      b:=0;
      j:=2;
      k:=2;
      Result:=Result+s4;
    end;
  end;
  if j<>2 then begin
    s4[j]:='.';
    s4[1]:=Base64[b+1];
    Result:=Result+s4;
    SetLength(Result,Length(Result)-(4-j));
  end else
    Result := Result + '.';
end;}
var
  b64Encode: TBase64EncodingStream;
  TextCoded: TMemoryStream;
  Buf: array[0..1024] of char;
  bw: Cardinal;
begin
  TextCoded:=TMemoryStream.Create;
  b64Encode:=TBase64EncodingStream.Create(TextCoded);
  try
    StrPCopy(@Buf,s);
    bw:=b64Encode.Write(Buf,Length(s));
    Result:=string(PChar(TextCoded.Memory));
    SetLength(Result,bw);
  finally
    b64Encode.Free;
    TextCoded.Free;
  end;
end;

function Base64Decode(const s: string): string;
{var
  i, j, k: integer;
  b: byte;
begin
  Result:='';
  b:=0;
  i:=1;
  j:=0;
  while (i<=length(s)) and (s[i]<>'.') do begin
    if j=0 then begin
      b:=UnBase64[ord(s[i])];
      k:=2;
    end else begin
      Result:=Result+chr(UnBase64[ord(s[i])] or ((b shl k) and $C0));
      inc(k,2);
    end;
    inc(j);
    j:=j and 3;
    inc(i);
  end;
end;}
var
  b64Decode: TBase64DecodingStream;
  TextCoded: TMemoryStream;
  Buf: array[0..1024] of char;
  bw: Cardinal;
begin
  TextCoded:=TMemoryStream.Create;
  b64Decode:=TBase64DecodingStream.Create(TextCoded);
  try
    StrPCopy(@Buf,s);
    bw:=b64Decode.Write(Buf,Length(s));
    Result:=string(PChar(TextCoded.Memory));
    SetLength(Result,bw);
  finally
    b64Decode.Free;
    TextCoded.Free;
  end;
end;

constructor TBase64EncodingStream.Create(AOutputStream: TStream);
begin
  inherited Create;
  OutputStream := AOutputStream;
  Source := TMemoryStream.Create;
end;

destructor TBase64EncodingStream.Destroy;
var
  WriteBuf: array[0..3] of Char;
begin
  if OutputStream <> nil then
  // Fill output to multiple of 3
  case (TotalBytesProcessed mod 3) of
    1: begin
        WriteBuf[0] := EncodingTable[Buf[0] shr 2];
        WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4];
        WriteBuf[2] := '=';
        WriteBuf[3] := '=';
        OutputStream.Write(WriteBuf, 4);
      end;
    2: begin
        WriteBuf[0] := EncodingTable[Buf[0] shr 2];
        WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
        WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2];
        WriteBuf[3] := '=';
        OutputStream.Write(WriteBuf, 4);
      end;
  end;
  Source.Free;
  inherited Destroy;
end;

function TBase64EncodingStream.Read(var Buffer; Count: Longint): Longint;
begin
  raise EStreamError.Create('Invalid stream operation');
end;

function TBase64EncodingStream.Write(const Buffer; Count: Longint): Longint;
var
  ReadNow: integer;
  WriteBuf: array[0..3] of Char;
begin
  TotalBytesProcessed := TotalBytesProcessed + Count;

  Source.Write( Buffer, Count);
  Source.Position := 0;
  repeat
    ReadNow := Source.Read( buf, 3);
    if ReadNow < 3 then // Not enough data available
    begin
      Source.Clear;
      Source.Write( buf, ReadNow);
      break;
    end;

    // Encode the 3 bytes in Buf
    WriteBuf[0] := EncodingTable[Buf[0] shr 2];
    WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
    WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2 or (Buf[2] shr 6)];
    WriteBuf[3] := EncodingTable[Buf[2] and 63];
    try
       OutputStream.Write(WriteBuf, 4);
      except
       BytesWritten := 0;
       break;
    end;
    BytesWritten := BytesWritten + 4;
    if (BytesWritten mod 76) = 0 then
      OutputStream.Write( #13#10, 2);
  until (ReadNow < 3);
  result := BytesWritten;
end;

function TBase64EncodingStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  Result := BytesWritten;

  // This stream only supports the Seek modes needed for determining its size
  if not ((((Origin = soFromCurrent) or (Origin = soFromEnd)) and (Offset = 0))
     or ((Origin = soFromBeginning) and (Offset = Result))) then
    raise EStreamError.Create('Invalid stream operation');
end;


// ------------------------------------------------------------------
//  TBase64DecodingStream
// ------------------------------------------------------------------

constructor TBase64DecodingStream.Create(AOutputStream: TStream);
begin
  inherited Create;
  OutputStream := AOutputStream;
  Source := TMemoryStream.Create;
  BytesReaded := 0;
end;

destructor TBase64DecodingStream.Destroy;
begin
  Source.Free;
  inherited Destroy;
end;

function TBase64DecodingStream.Read(var Buffer; Count: Longint): Longint;
begin
  raise EStreamError.Create('Invalid stream operation');
end;

function TBase64DecodingStream.Write(const Buffer; Count: Longint): Longint;
var
  b1: array[0..2] of byte;
  n: integer;
  RealBytes: integer;
  c: byte;
begin
  BytesWritten := 0;
  Source.Write( Buffer, Count);
  Source.Position := 0;

  repeat
    repeat
      n := Source.Read( c, 1);
      if n = 0 then
      begin
        Source.Clear;
        Source.Write( BuffToDecode, BytesReaded);
        break;
      end;
      // we must discard crlf
      if (c <> 13) and (c <> 10) then
      begin
        BuffToDecode[BytesReaded] := c;
        BytesReaded := BytesReaded + 1;
      end;
    until (n = 0) or (BytesReaded = 4);

    if BytesReaded < 4 then break;
    BytesReaded := 0;

    BuffToDecode[0] := DecodingTable[ BuffToDecode[0]];
    BuffToDecode[1] := DecodingTable[ BuffToDecode[1]];
    BuffToDecode[2] := DecodingTable[ BuffToDecode[2]];
    BuffToDecode[3] := DecodingTable[ BuffToDecode[3]];

    RealBytes := 3;
    if BuffToDecode[0] = 64 then
    begin
      RealBytes := 0;
    end else
    if BuffToDecode[2] = 64 then
    begin
      BuffToDecode[2] := 0;
      BuffToDecode[3] := 0;
      RealBytes := 1;
    end else
    if BuffToDecode[3] = 64 then
    begin
      BuffToDecode[3] := 0;
      RealBytes := 2;
    end;

    b1[0] := BuffToDecode[0] * 4 + (BuffToDecode[1] div 16);
    b1[1] := (BuffToDecode[1] mod 16) * 16 + (BuffToDecode[2] div 4);
    b1[2] := (BuffToDecode[2] mod 4) * 64 + BuffToDecode[3];

    try
       OutputStream.Write( b1, RealBytes);
      except
       BytesWritten := 0;
       break;
    end;
    BytesWritten := BytesWritten + RealBytes;  // I don't like inc()
  until (False);
  result := BytesWritten;
end;

function TBase64DecodingStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  // This stream only supports the Seek modes needed for determining its size
{  if (Origin = soFromCurrent) and (Offset = 0) then
    Result := CurPos
  else if (Origin = soFromEnd) and (Offset = 0) then
    Result := DataLen
  else if (Origin = soFromBeginning) and (Offset = CurPos) then
    Result := CurPos
  else}
    raise EStreamError.Create('Invalid stream operation');
end;

procedure ConvertError(const Msg: string);
begin
  raise EConvertError.Create(Msg);
end;        

function CodesToStr(const S: string): string;
const
  Msg: string = 'CodesToStr convert error.';
asm
        TEST    EAX,EAX
        JE      @@cl
        MOV     ECX,[EAX-4]
        SHR     ECX,1
        JC      @@err1
        JE      @@cl
        PUSH    EBX
        PUSH    ESI
        PUSH    EDI
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     EBX,ECX
        MOV     EAX,EDX
        XOR     EDX,EDX
        CALL    System.@LStrFromPCharLen
        MOV     EDI,[EDI]
@@lp:   MOV     AL,BYTE PTR [ESI]
        MOV     DL,BYTE PTR [ESI+1]
        SUB     AL,$30
        JB      @@err0
        SUB     DL,$30
        JB      @@err0
        CMP     AL,$09
        JBE     @@ct1
        SUB     AL,$11
        JB      @@err0
        CMP     AL,$05
        JBE     @@pt1
        SUB     AL,$20
        JB      @@err0
        CMP     AL,$05
        JA      @@err0
@@pt1:  ADD     AL,$0A
@@ct1:  SHL     AL,4
        CMP     DL,$09
        JBE     @@ct2
        SUB     DL,$11
        JB      @@err0
        CMP     DL,$05
        JBE     @@pt2
        SUB     DL,$20
        JB      @@err0
        CMP     DL,$05
        JA      @@err0
@@pt2:  ADD     DL,$0A
@@ct2:  OR      AL,DL
        MOV     BYTE PTR [EDI],AL
        ADD     ESI,2
        INC     EDI
        DEC     EBX
        JNE     @@lp
        POP     EDI
        POP     ESI
        POP     EBX
        RET
@@cl:   MOV     EAX,EDX
        CALL    System.@LStrClr
        RET
@@err0: POP     EDI
        POP     ESI
        POP     EBX
@@err1: MOV     EAX,Msg
        CALL    ConvertError
end;

function StrToCodes(const S: string): string;
asm
        TEST    EAX,EAX
        JE      @@cl
        MOV     ECX,[EAX-4]
        TEST    ECX,ECX
        JE      @@cl
        PUSH    EBX
        PUSH    ESI
        PUSH    EDI
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     EBX,ECX
        MOV     EAX,EDX
        SHL     ECX,1
        XOR     EDX,EDX
        CALL    System.@LStrFromPCharLen
        MOV     EDI,[EDI]
@@lp:   MOV     AL,BYTE PTR [ESI]
        MOV     DL,AL
        SHR     AL,4
        AND     DL,$0F
        CMP     AL,$09
        JA      @@bd1
        ADD     AL,$30
        JMP     @@nx1
@@bd1:  ADD     AL,$37
@@nx1:  MOV     BYTE PTR [EDI],AL
        INC     EDI
        CMP     DL,$09
        JA      @@bd2
        ADD     DL,$30
        JMP     @@nx2
@@bd2:  ADD     DL,$37
@@nx2:  MOV     BYTE PTR [EDI],DL
        INC     ESI
        INC     EDI
        DEC     EBX
        JNE     @@lp
        POP     EDI
        POP     ESI
        POP     EBX
        RET
@@cl:   MOV     EAX,EDX
        CALL    System.@LStrClr
end;

end.