base64.pas

加密算法源代码应用

 InputBuffer        : array[0..BUFFER_SIZE - 1] of Byte;
 OutputBuffer       : array[0.. (BUFFER_SIZE + 3) div 4 * 3 - 1] of Byte;
 BytesRead          : Cardinal;
begin
 ByteBuffer := 0;
 ByteBufferSpace := 4;
 BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
 while BytesRead > 0 do
  begin
   OutputStream.Write(OutputBuffer, MimeDecodePartial(InputBuffer, BytesRead, 
     OutputBuffer, ByteBuffer, ByteBufferSpace));
   BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
  end;
 OutputStream.Write (OutputBuffer, MimeDecodePartialEnd (OutputBuffer, ByteBuffer, 
   ByteBufferSpace));
end;

procedure DecodeHttpBasicAuthentication (const BasicCredentials: AnsiString; out UserId, PassWord: AnsiString);
label
 Fail;
const
 LBasic = 6;                { Length ('Basic ') }
var
 DecodedPtr, p      : PAnsiChar;
 i, l               : Cardinal;
begin
 p := Pointer (BasicCredentials);
 if p = nil then goto Fail;
 
 l := Cardinal (Pointer (p - 4)^);
 if l <= LBasic then goto Fail;
 
 Dec (l, LBasic);
 Inc (p, LBasic);
 
 GetMem (DecodedPtr, (l + 3) div 4 * 3 { MimeDecodedSize (l) });
 l := MimeDecode (p^, l, DecodedPtr^);
 
 { Look for colon. }
 i := 0;
 p := DecodedPtr;
 while (l > 0) and (p[i] <> ':') do
  begin
   Inc (i);
   Dec (l);
  end;

 { Store UserId and Password. }
 SetString (UserId, DecodedPtr, i);
 if l > 1 then
  SetString (PassWord, DecodedPtr + i + 1, l - 1)
 else
  PassWord := '';
 
 FreeMem (DecodedPtr);
 Exit;
 
 Fail:
 UserId := '';
 PassWord := '';
end;

{ ---------------------------------------------------------------------------- }
{ Size Functions
{ ---------------------------------------------------------------------------- }

function MimeEncodedSize (const i: Cardinal): Cardinal;
begin
 Result := (i + 2) div 3 * 4 + (i - 1) div MIME_DECODED_LINE_BREAK * 2;
end;

function MimeEncodedSizeNoCRLF (const i: Cardinal): Cardinal;
begin
 Result := (i + 2) div 3 * 4;
end;

function MimeDecodedSize (const i: Cardinal): Cardinal;
begin
 Result := (i + 3) div 4 * 3;
end;

{ ---------------------------------------------------------------------------- }
{ Encoding Core
{ ---------------------------------------------------------------------------- }

procedure MimeEncode (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
 IDelta, ODelta     : Cardinal;
begin
 MimeEncodeFullLines (InputBuffer, InputByteCount, OutputBuffer);
 IDelta := InputByteCount div MIME_DECODED_LINE_BREAK; // Number of lines processed so far.
 ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2);
 IDelta := IDelta * MIME_DECODED_LINE_BREAK;
 MimeEncodeNoCRLF (Pointer (Cardinal (@InputBuffer) + IDelta)^, 
  InputByteCount - IDelta, Pointer (Cardinal (@OutputBuffer) + ODelta)^);
end;

procedure MimeEncodeFullLines (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
 b, OuterLimit      : Cardinal;
 InPtr, InnerLimit  : ^Byte;
 OutPtr             : PByte4;
begin
 if InputByteCount = 0 then Exit;
 InPtr := @InputBuffer;
 OutPtr := @OutputBuffer;
 
 InnerLimit := InPtr;
 Inc (Cardinal (InnerLimit), MIME_DECODED_LINE_BREAK);
 
 OuterLimit := Cardinal (InPtr);
 Inc (OuterLimit, InputByteCount);
 
 { Multiple line loop. }
 while Cardinal (InnerLimit) <= OuterLimit do
  begin

   while InPtr <> InnerLimit do
    begin
     { Read 3 bytes from InputBuffer. }
     b := InPtr^;
     b := b shl 8;
     Inc (InPtr);
     b := b or InPtr^;
     b := b shl 8;
     Inc (InPtr);
     b := b or InPtr^;
     Inc (InPtr);
     { Write 4 bytes to OutputBuffer (in reverse order). }
     OutPtr^.b4 := MIME_ENCODE_TABLE[b and $3F];
     b := b shr 6;
     OutPtr^.b3 := MIME_ENCODE_TABLE[b and $3F];
     b := b shr 6;
     OutPtr^.b2 := MIME_ENCODE_TABLE[b and $3F];
     b := b shr 6;
     OutPtr^.b1 := MIME_ENCODE_TABLE[b];
     Inc (OutPtr);
    end;
   { Write line break (CRLF). }
   OutPtr^.b1 := 13;
   OutPtr^.b2 := 10;
   Inc (Cardinal (OutPtr), 2);

   Inc (InnerLimit, MIME_DECODED_LINE_BREAK);
  end;
 
end;

{ ---------- }

procedure MimeEncodeNoCRLF (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
 b, OuterLimit      : Cardinal;
 InPtr, InnerLimit  : ^Byte;
 OutPtr             : PByte4;
begin
 if InputByteCount = 0 then Exit;
 InPtr := @InputBuffer;
 OutPtr := @OutputBuffer;
 
 OuterLimit := InputByteCount div 3 * 3;
 
 InnerLimit := @InputBuffer;
 Inc (Cardinal (InnerLimit), OuterLimit);

 { Last line loop. }
 while InPtr <> InnerLimit do
  begin
   { Read 3 bytes from InputBuffer. }
   b := InPtr^;
   b := b shl 8;
   Inc (InPtr);
   b := b or InPtr^;
   b := b shl 8;
   Inc (InPtr);
   b := b or InPtr^;
   Inc (InPtr);
   { Write 4 bytes to OutputBuffer (in reverse order). }
   OutPtr^.b4 := MIME_ENCODE_TABLE[b and $3F];
   b := b shr 6;
   OutPtr^.b3 := MIME_ENCODE_TABLE[b and $3F];
   b := b shr 6;
   OutPtr^.b2 := MIME_ENCODE_TABLE[b and $3F];
   b := b shr 6;
   OutPtr^.b1 := MIME_ENCODE_TABLE[b];
   Inc (OutPtr);
  end;
 
 { End of data & padding. }
 case InputByteCount - OuterLimit of
  1:
   begin
    b := InPtr^;
    b := b shl 4;
    OutPtr.b2 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr.b1 := MIME_ENCODE_TABLE[b];
    OutPtr.b3 := MIME_PAD_CHAR;         { Pad remaining 2 bytes. }
    OutPtr.b4 := MIME_PAD_CHAR;
   end;
  2:
   begin
    b := InPtr^;
    Inc (InPtr);
    b := b shl 8;
    b := b or InPtr^;
    b := b shl 2;
    OutPtr.b3 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr.b2 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr.b1 := MIME_ENCODE_TABLE[b];
    OutPtr.b4 := MIME_PAD_CHAR;         { Pad remaining byte. }
   end;
 end;
end;

{ ---------------------------------------------------------------------------- }
{ Decoding Core
{ ---------------------------------------------------------------------------- }

function MimeDecode (const InputBuffer; const InputBytesCount: Cardinal; 
  out OutputBuffer): Cardinal;
var
 ByteBuffer, ByteBufferSpace: Cardinal;
begin
 ByteBuffer := 0;
 ByteBufferSpace := 4;
 Result := MimeDecodePartial(InputBuffer, InputBytesCount, 
  OutputBuffer, ByteBuffer, ByteBufferSpace);
 Inc (Result, MimeDecodePartialEnd(Pointer (Cardinal(@OutputBuffer) + Result)^, 
  ByteBuffer, ByteBufferSpace));
end;

{ ---------- }

function MimeDecodePartial (const InputBuffer; const InputBytesCount: Cardinal; 
  out OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal;
var
 lByteBuffer, lByteBufferSpace, c: Cardinal;
 InPtr, OuterLimit  : ^Byte;
 OutPtr             : PByte3;
begin
 if InputBytesCount > 0 then
  begin
   InPtr := @InputBuffer;
   Cardinal (OuterLimit) := Cardinal (InPtr) + InputBytesCount;
   OutPtr := @OutputBuffer;
   lByteBuffer := ByteBuffer;
   lByteBufferSpace := ByteBufferSpace;
   while InPtr <> OuterLimit do
    begin
     { Read from InputBuffer. }
     c := MIME_DECODE_TABLE[InPtr^];
     Inc (InPtr);
     if c = $FF then Continue;
     lByteBuffer := lByteBuffer shl 6;
     lByteBuffer := lByteBuffer or c;
     Dec (lByteBufferSpace);
     { Have we read 4 bytes from InputBuffer? }
     if lByteBufferSpace <> 0 then Continue;

     { Write 3 bytes to OutputBuffer (in reverse order). }
     OutPtr^.b3 := Byte (lByteBuffer);
     lByteBuffer := lByteBuffer shr 8;
     OutPtr^.b2 := Byte (lByteBuffer);
     lByteBuffer := lByteBuffer shr 8;
     OutPtr^.b1 := Byte (lByteBuffer);
     lByteBuffer := 0;
     Inc (OutPtr);
     lByteBufferSpace := 4;
    end;
   ByteBuffer := lByteBuffer;
   ByteBufferSpace := lByteBufferSpace;
   Result := Cardinal (OutPtr) - Cardinal (@OutputBuffer);
  end
 else
  Result := 0;
end;

function MimeDecodePartialEnd (out OutputBuffer; const ByteBuffer: Cardinal; 
  const ByteBufferSpace: Cardinal): Cardinal;
var
 lByteBuffer : Cardinal;
begin
 case ByteBufferSpace of
  1:
   begin
    lByteBuffer := ByteBuffer shr 2;
    PByte3 (@OutputBuffer)^.b2 := Byte (lByteBuffer);
    lByteBuffer := lByteBuffer shr 8;
    PByte3 (@OutputBuffer)^.b1 := Byte (lByteBuffer);
    Result := 2;
   end;
  2:
   begin
    lByteBuffer := ByteBuffer shr 4;
    PByte3 (@OutputBuffer)^.b1 := Byte (lByteBuffer);
    Result := 1;
   end;
  else
   Result := 0;
 end;
end;

procedure Base64Encode(InputFile, OutputFile: string);
var
  Ms: TMemoryStream;
  Ss: TStringStream;
  Str: string;
  List: TStringList;
begin {Base64 encode} 
  Ms := TMemoryStream.Create;
  try
    Ms.LoadFromFile(InputFile);
    Ss := TStringStream.Create(Str);
    try
      MimeEncodeStream(Ms, Ss);
      List := TStringList.Create;
      try
        List.Text := Ss.DataString;
        List.SaveToFile(OutputFile);
      finally
        List.Free;
      end;
    finally
      Ss.Free;
    end;
  finally
    Ms.Free;
  end;
end;

procedure Base64Decode(InputFile, OutputFile: string);
var
  Ms: TMemoryStream;
  Ss: TStringStream;
  List: TStringList;
begin {Base64 decode}
  List := TStringList.Create;
  try
    List.LoadFromFile(InputFile);
    Ss := TStringStream.Create(List.Text);
    try
      Ms := TMemoryStream.Create;
      try
        MimeDecodeStream(Ss, Ms);
        Ms.SaveToFile(OutputFile);
      finally
        Ms.Free;
      end;
    finally
      Ss.Free;
    end;
  finally
    List.Free;
  end;
end;

end.