⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 base64.pas

📁 加密算法源代码应用
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Base64;

interface

uses
 Classes;

function MimeEncodeString (const s: AnsiString): AnsiString;
{ MimeEncodeString takes a string, encodes it, and returns the result as a string.
  To decode the result string, use MimeDecodeString. }

function MimeEncodeStringNoCRLF (const s: AnsiString): AnsiString;
{ MimeEncodeStringNoCRLF is just like MimeEncodeString, but does NOT insert line breaks. }

function MimeDecodeString (const s: AnsiString): AnsiString;
{ MimeDecodeString takes a a string, decodes it, and returns the result as a string.
Use MimeDecodeString to decode a string previously encoded with MimeEncodeString. }

procedure MimeEncodeStream (const InputStream: TStream; const OutputStream: TStream);
{ MimeEncodeStream encodes InputStream WITH inserting line breaks.
  Encoding starts at the InputStream's current position and continues until the end.
  Decoded output is written to OutputStream, again starting at the current position.
  When done, the function will not reset either stream's positions,
  but leave InputStream at the last read position (i.e. the end) and
  OutputStream at the last write position (which can, but most not be the end).
  To encode the entire InputStream from beginning to end, make sure
  that its offset is positioned at the beginning of the stream. You can
  force this by issuing

       InputStream.Seek (0, soFromBeginning);

  before calling this function. }

procedure MimeEncodeStreamNoCRLF (const InputStream: TStream; const OutputStream: TStream);
{ MimeEncodeStreamNoCRLF is just like MimeEncodeStream, but does NOT insert line breaks. }

procedure MimeDecodeStream (const InputStream: TStream; const OutputStream: TStream);
{ MimeDecodeStream decodes InputStream starting at the current position
  up to the end and writes the result to OutputStream, again starting at
  the current position. When done, it will not reset either stream's positions,
  but leave InputStream at the last read position (i.e. the end) and
  OutputStream at the last write position (which can, but most not be the end).
  To decode the entire InputStream from beginning to end, make sure
  that its offset is positioned at the beginning of the stream. You can
  force this by issuing Seek (0, soFromBeginning) before calling this function. }

function MimeEncodedSize (const i: Cardinal): Cardinal;
{ Calculates the output size of i MimeEncoded bytes, i.e. the memory required
  for all decoded data plus the line breaks. Use for MimeEncode only. }

function MimeEncodedSizeNoCRLF (const i: Cardinal): Cardinal;
{ Calculates the output size of i MimeEncodedNoCRLF bytes, i.e. the memory
  required for all decoded data. Use for MimeEncodedNoCRLF only. }

function MimeDecodedSize (const i: Cardinal): Cardinal;
{ Calculates the maximum output size of i MimeDecoded bytes.
  You may use it for MimeDecode to calculate the maximum amount of memory
  required for decoding in one single pass. }

procedure DecodeHttpBasicAuthentication (const BasicCredentials: AnsiString; 
  out UserId, PassWord: AnsiString);
{ Decodes the UserID and Password for HTTP Basic Authentication. Pass the
  contents of the Authorization Header as BasicCredentials and DecodeHttpBasicAuthentication
  will return the unencoded UserID and Password. If either of the two can not be
  decoded or found, they will result in an empty string (''). This procedure is
  inspired by Shiv.

  The following quote from "Request for Comments (RFC) 1945: Hypertext Transfer
  Protocol -- HTTP/1.0" has the details:

  11.1  Basic Authentication Scheme

   The "basic" authentication scheme is based on the model that the user
   agent must authenticate itself with a user-ID and a password for each
   realm. The realm value should be considered an opaque string which
   can only be compared for equality with other realms on that server.
   The server will authorize the request only if it can validate the
   user-ID and password for the protection space of the Request-URI.
   There are no optional authentication parameters.

   Upon receipt of an unauthorized request for a URI within the
   protection space, the server should respond with a challenge like the
   following:

       WWW-Authenticate: Basic realm="WallyWorld"

   where "WallyWorld" is the string assigned by the server to identify
   the protection space of the Request-URI.

   To receive authorization, the client sends the user-ID and password,
   separated by a single colon (":") character, within a base64 [5]
   encoded string in the credentials.

       basic-credentials = "Basic" SP basic-cookie

       basic-cookie      = <base64 [5] encoding of userid-password,
                            except not limited to 76 char/line>

       userid-password   = [ token ] ":" *TEXT

   If the user agent wishes to send the user-ID "Aladdin" and password
   "open sesame", it would use the following header field:

       Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==

   The basic authentication scheme is a non-secure method of filtering
   unauthorized access to resources on an HTTP server. It is based on
   the assumption that the connection between the client and the server
   can be regarded as a trusted carrier. As this is not generally true
   on an open network, the basic authentication scheme should be used
   accordingly. In spite of this, clients should implement the scheme in
   order to communicate with servers that use it. }

procedure MimeEncode (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
{ MimeEncode is the primary Mime encoding routine.
  Line breaks will be inserted after each full line.

  CAUTTION: OutputBuffer must have enough memory allocated to take all encoded output.
  MimeEncodedSize (InputBytesCount) calculates this amount in bytes. MimeEncode will
  then fill the entire OutputBuffer, so there is no OutputBytesCount result for
  this procedure. Preallocating all memory at once (as required by MimeEncode)
  avoids the time-cosuming process of reallocation.

  If not all data fits into memory at once, you can NOT use MimeEncode multiple times.
  Instead, use a combintion of MimeEncodeFullLines and MimeEncodeNoCRLF. }

procedure MimeEncodeNoCRLF (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
{ MimeEncodeNoCRLF is just like MimeEncode, but does NOT insert line breaks.

  Unlike MimeEncode, you can use MimeEncodeNoCRLF multiple times if not all data
  fits into memory at once. But you must be very careful about the size
  of the InputBuffer. See comments on BUFFER_SIZE below for details
  and MimeEncodeStreamNoCRLF for an example. }

procedure MimeEncodeFullLines (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
{ MimeEncodeFullLines will decode full lines of MIME_ENCODED_LINE_BREAK length.
  A line break (CRLF) will be inserted after each line including the last one.
  Any remaining input which would not result in a full line will not be encoded.
  To encode the remaining partial line, use MimeEncodeNoCRLF with the appropriate parameters.
  MimeEncodeFullLines requires an OutputBuffer large enough for all encoded output.
  The required size of the OutputBuffer can be calculated with

      (InputByteCount + 2) div 3 * 4 + InputByteCount div MIME_DECODED_LINE_BREAK * 2

  MimeEncodeFullLines will fill the entire OutputBuffer of that size. }

function MimeDecode (const InputBuffer; const InputBytesCount: Cardinal; out OutputBuffer): Cardinal;
{ The primary Mime decoding routines. MimeDecode works with all MimeEncoded data,
  no matter if it was encoded with or without line breaks. Line breaks characters
  are outside of the base64 alphabet and will be ignored.

  CAUTION: OutputBuffer must have enough memory allocated to take all output.
  MimeDecodedSize (InputBytesCount) calculates this amount in bytes. There is
  no guarantee that all output will be filled after decoding. All decoding
  functions therefore return the acutal number of bytes written to OutputBuffer.
  Preallocating all memory at once (as is required by MimeDecode)
  avoids the time-cosuming process of reallocation. After calling
  MimeDecode, simply cut the allocated memory down to OutputBytesCount,
  i.e. SetLength (OutString, OutputBytesCount).

  If not all data fits into memory at once, you may NOT use MimeDecode multiple times.
  Instead, you must use the MimeDecodePartial_ functions.
  See MimeDecodeStream for an example. }

function MimeDecodePartial (const InputBuffer; const InputBytesCount: Cardinal; 
  out OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal;
function MimeDecodePartialEnd (out OutputBuffer; const ByteBuffer: Cardinal; 
  const ByteBufferSpace: Cardinal): Cardinal;
{ The MimeDecodePartial_ functions are mostly for internal use.
  They serve the purpose of decoding very large data in multiple parts of
  smaller chunks, as used in MimeDecodeStream. }

procedure Base64Encode(InputFile, OutputFile: string);
procedure Base64Decode(InputFile, OutputFile: string);

implementation

const
 MIME_ENCODED_LINE_BREAK = 76;
 { According to RFC 1521, MIME_ENCODED_LINE_BREAK defaults to 76.
   If you ever need to change it, make sure it is a multiple of 4. }
 
 MIME_DECODED_LINE_BREAK = MIME_ENCODED_LINE_BREAK div 4 * 3;
 { Do not change this, even if you change MIME_ENCODED_LINE_BREAK above.
   MIME_DECODED_LINE_BREAK will always be a multiple of 3. }
 
 BUFFER_SIZE        = MIME_DECODED_LINE_BREAK * 3 * 4 * 16;
 { Fhe formula of BUFFER_SIZE is explained by the needs of MimeEncodeStream_
   and all other kinds of buffered Mime encodings (i.e. Files etc.).
   MimeEncodeFullLines only works if InputByteCount is a multiple of
   MIME_DECODED_LINE_BREAK. For MimeEncodeNoCRLF InputByteCount must be a
   multiple of 3 if used repeatedly, like in MimeEncodeStreamNoCRLF. In
   addition, a multiple of 4 makes sure memory is properly aligned. The factor
   16 just enlarges BUFFER_SIZE to a decent value. }
 
 MIME_ENCODE_TABLE  : array[0..63] of Byte = (
  065, 066, 067, 068, 069, 070, 071, 072, // 00 - 07
  073, 074, 075, 076, 077, 078, 079, 080, // 08 - 15
  081, 082, 083, 084, 085, 086, 087, 088, // 16 - 23
  089, 090, 097, 098, 099, 100, 101, 102, // 24 - 31
  103, 104, 105, 106, 107, 108, 109, 110, // 32 - 39
  111, 112, 113, 114, 115, 116, 117, 118, // 40 - 47
  119, 120, 121, 122, 048, 049, 050, 051, // 48 - 55
  052, 053, 054, 055, 056, 057, 043, 047); // 56 - 63
 
 MIME_PAD_CHAR      = Byte ('=');
 
 MIME_DECODE_TABLE  : array[Byte] of Cardinal = (
  255, 255, 255, 255, 255, 255, 255, 255, //  00 -  07
  255, 255, 255, 255, 255, 255, 255, 255, //  08 -  15
  255, 255, 255, 255, 255, 255, 255, 255, //  16 -  23
  255, 255, 255, 255, 255, 255, 255, 255, //  24 -  31
  255, 255, 255, 255, 255, 255, 255, 255, //  32 -  39
  255, 255, 255, 062, 255, 255, 255, 063, //  40 -  47
  052, 053, 054, 055, 056, 057, 058, 059, //  48 -  55
  060, 061, 255, 255, 255, 255, 255, 255, //  56 -  63
  255, 000, 001, 002, 003, 004, 005, 006, //  64 -  71
  007, 008, 009, 010, 011, 012, 013, 014, //  72 -  79
  015, 016, 017, 018, 019, 020, 021, 022, //  80 -  87
  023, 024, 025, 255, 255, 255, 255, 255, //  88 -  95
  255, 026, 027, 028, 029, 030, 031, 032, //  96 - 103
  033, 034, 035, 036, 037, 038, 039, 040, // 104 - 111
  041, 042, 043, 044, 045, 046, 047, 048, // 112 - 119
  049, 050, 051, 255, 255, 255, 255, 255, // 120 - 127
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255,
  255, 255, 255, 255, 255, 255, 255, 255);
 
type
 PByte4 = ^TByte4;
 TByte4 = packed record
  b1: Byte;
  b2: Byte;
  b3: Byte;
  b4: Byte;
 end;
 
 PByte3 = ^TByte3;
 TByte3 = packed record
  b1: Byte;
  b2: Byte;
  b3: Byte;
 end;
 
 { ---------------------------------------------------------------------------- }
 { String Encoding & Decoding
 { ---------------------------------------------------------------------------- }
 
function MimeEncodeString (const s: AnsiString): AnsiString;
var
 l                  : Cardinal;
begin
 if Pointer (s) <> nil then
  begin
   l := Cardinal (Pointer (Cardinal (s) - 4)^);
   SetLength (Result, MimeEncodedSize (l));
   MimeEncode (Pointer (s)^, l, Pointer (Result)^);
  end
 else
  Result := '';
end;

function MimeEncodeStringNoCRLF (const s: AnsiString): AnsiString;
var
 l                  : Cardinal;
begin
 if Pointer (s) <> nil then
  begin
   l := Cardinal (Pointer (Cardinal (s) - 4)^);
   SetLength (Result, MimeEncodedSizeNoCRLF (l));
   MimeEncodeNoCRLF (Pointer (s)^, l, Pointer (Result)^);
  end
 else
  Result := '';
end;

function MimeDecodeString (const s: AnsiString): AnsiString;
var
 ByteBuffer, ByteBufferSpace: Cardinal;
 l                  : Cardinal;
begin
 if Pointer (s) <> nil then
  begin
   l := Cardinal (Pointer (Cardinal (s) - 4)^);
   SetLength (Result, (l + 3) div 4 * 3);
   ByteBuffer := 0;
   ByteBufferSpace := 4;
   l := MimeDecodePartial (Pointer (s)^, l, Pointer (Result)^, ByteBuffer, ByteBufferSpace);
   Inc (l, MimeDecodePartialEnd (Pointer (Cardinal (Result) + l)^,
     ByteBuffer, ByteBufferSpace));
   SetLength (Result, l);
  end
 else
  Result := '';
end;

{ ---------------------------------------------------------------------------- }
{ Stream Encoding & Decoding
{ ---------------------------------------------------------------------------- }

procedure MimeEncodeStream (const InputStream: TStream; const OutputStream: TStream);
var
 InputBuffer : array[0..BUFFER_SIZE - 1] of Byte;
 OutputBuffer : array[0.. (BUFFER_SIZE + 2) div 3 * 4 + BUFFER_SIZE div 
   MIME_DECODED_LINE_BREAK * 2 - 1] of Byte;
 BytesRead : Cardinal;
 IDelta, ODelta : Cardinal;
begin
 BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
 
 while BytesRead = SizeOf (InputBuffer) do
  begin
   MimeEncodeFullLines (InputBuffer, SizeOf (InputBuffer), OutputBuffer);
   OutputStream.Write (OutputBuffer, SizeOf (OutputBuffer));
   BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
  end;

 MimeEncodeFullLines (InputBuffer, BytesRead, OutputBuffer);
 
 IDelta := BytesRead div MIME_DECODED_LINE_BREAK; // Number of lines processed.
 ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2);
 IDelta := IDelta * MIME_DECODED_LINE_BREAK;
 MimeEncodeNoCRLF(Pointer(Cardinal (@InputBuffer) + IDelta)^, BytesRead - IDelta, 
   Pointer (Cardinal (@OutputBuffer) + ODelta)^);
 
 OutputStream.Write (OutputBuffer, MimeEncodedSize (BytesRead));
end;

procedure MimeEncodeStreamNoCRLF (const InputStream: TStream; const OutputStream: TStream);
var
 InputBuffer        : array[0..BUFFER_SIZE - 1] of Byte;
 OutputBuffer       : array[0.. ((BUFFER_SIZE + 2) div 3) * 4 - 1] of Byte;
 BytesRead          : Cardinal;
begin
 BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
 while BytesRead = SizeOf (InputBuffer) do
  begin
   MimeEncodeNoCRLF (InputBuffer, SizeOf (InputBuffer), OutputBuffer);
   OutputStream.Write (OutputBuffer, SizeOf (OutputBuffer));
   BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
  end;
 
 MimeEncodeNoCRLF (InputBuffer, BytesRead, OutputBuffer);
 OutputStream.Write (OutputBuffer, (BytesRead + 2) div 3 * 4);
end;

procedure MimeDecodeStream (const InputStream: TStream; const OutputStream: TStream);
var
 ByteBuffer, ByteBufferSpace: Cardinal;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -