base64d2010版

作者：甄之恋 | 来源：互联网 | 2023-09-24 13:08

代码{*******************************************************}{}{DelphiVisualComponentLibrary

代码

{*******************************************************}
{                                                       }
{            Delphi Visual Component Library            }
{                                                       }
{ Copyright(c) 1995-2010 Embarcadero Technologies, Inc. }
{                                                       }
{*******************************************************}

unit EncdDecd;

interface

uses Classes, SysUtils;

procedure EncodeStream(Input, Output: TStream);
procedure DecodeStream(Input, Output: TStream);
function  EncodeString(const Input: string): string;
function  DecodeString(const Input: string): string;

function  DecodeBase64(const Input: AnsiString): TBytes;
function  EncodeBase64(const Input: Pointer; Size: Integer): AnsiString;

implementation

uses RTLConsts;

const
  EncodeTable: array[0..63] of AnsiChar &＃61;
    AnsiString(&＃39;ABCDEFGHIJKLMNOPQRSTUVWXYZ&＃39;) &＃43;
    AnsiString(&＃39;abcdefghijklmnopqrstuvwxyz&＃39;) &＃43;
    AnsiString(&＃39;0123456789&＃43;/&＃39;);

  DecodeTable: array[#0..#127] of Integer &＃61; (
    Byte(&＃39;&＃61;&＃39;), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
           64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
           64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63,
           52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64,
           64,  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14,
           15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64,
           64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
           41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64);

type
  PPacket &＃61; ^TPacket;
  TPacket &＃61; packed record
    case Integer of
      0: (b0, b1, b2, b3: Byte);
      1: (i: Integer);
      2: (a: array[0..3] of Byte);
      3: (c: array[0..3] of AnsiChar);
  end;

  TPointerStream &＃61; class(TCustomMemoryStream)
  public
    constructor Create(P: Pointer; Size: Integer);
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PAnsiChar);
begin
  OutBuf[0] :&＃61; EnCodeTable[Packet.a[0] shr 2];
  OutBuf[1] :&＃61; EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f];
  if NumChars < 2 then
    OutBuf[2] :&＃61; &＃39;&＃61;&＃39;
  else OutBuf[2] :&＃61; EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];
  if NumChars < 3 then
    OutBuf[3] :&＃61; &＃39;&＃61;&＃39;
  else OutBuf[3] :&＃61; EnCodeTable[Packet.a[2] and $0000003f];
end;

function DecodePacket(InBuf: PAnsiChar; var nChars: Integer): TPacket;
begin
  Result.a[0] :&＃61; (DecodeTable[InBuf[0]] shl 2) or
    (DecodeTable[InBuf[1]] shr 4);
  NChars :&＃61; 1;
  if InBuf[2] <> &＃39;&＃61;&＃39; then
  begin
    Inc(NChars);
    Result.a[1] :&＃61; Byte((DecodeTable[InBuf[1]] shl 4) or (DecodeTable[InBuf[2]] shr 2));
  end;
  if InBuf[3] <> &＃39;&＃61;&＃39; then
  begin
    Inc(NChars);
    Result.a[2] :&＃61; Byte((DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]]);
  end;
end;

procedure EncodeStream(Input, Output: TStream);
type
  PInteger &＃61; ^Integer;
var
  InBuf: array[0..509] of Byte;
  OutBuf: array[0..1023] of AnsiChar;
  BufPtr: PAnsiChar;
  I, J, K, BytesRead: Integer;
  Packet: TPacket;
begin
  K :&＃61; 0;
  repeat
    BytesRead :&＃61; Input.Read(InBuf, SizeOf(InBuf));
    I :&＃61; 0;
    BufPtr :&＃61; OutBuf;
    while I < BytesRead do
    begin
      if BytesRead - I < 3 then
        J :&＃61; BytesRead - I
      else J :&＃61; 3;
      Packet.i :&＃61; 0;
      Packet.b0 :&＃61; InBuf[I];
      if J > 1 then
        Packet.b1 :&＃61; InBuf[I &＃43; 1];
      if J > 2 then
        Packet.b2 :&＃61; InBuf[I &＃43; 2];
      EncodePacket(Packet, J, BufPtr);
      Inc(I, 3);
      Inc(BufPtr, 4);
      Inc(K, 4);
      if K > 75 then
      begin
        BufPtr[0] :&＃61; #$0D;
        BufPtr[1] :&＃61; #$0A;
        Inc(BufPtr, 2);
        K :&＃61; 0;
      end;
    end;
    Output.Write(Outbuf, BufPtr - PChar(&＃64;OutBuf));
  until BytesRead &＃61; 0;
end;

procedure DecodeStream(Input, Output: TStream);
var
  InBuf: array[0..75] of AnsiChar;
  OutBuf: array[0..60] of Byte;
  InBufPtr, OutBufPtr: PAnsiChar;
  I, J, K, BytesRead: Integer;
  Packet: TPacket;

  procedure SkipWhite;
  var
    C: AnsiChar;
    NumRead: Integer;
  begin
    while True do
    begin
      NumRead :&＃61; Input.Read(C, 1);
      if NumRead &＃61; 1 then
      begin
        if C in [&＃39;0&＃39;..&＃39;9&＃39;,&＃39;A&＃39;..&＃39;Z&＃39;,&＃39;a&＃39;..&＃39;z&＃39;,&＃39;&＃43;&＃39;,&＃39;/&＃39;,&＃39;&＃61;&＃39;] then
        begin
          Input.Position :&＃61; Input.Position - 1;
          Break;
        end;
      end else Break;
    end;
  end;

  function ReadInput: Integer;
  var
    WhiteFound, EndReached : Boolean;
    CntRead, Idx, IdxEnd: Integer;
  begin
    IdxEnd:&＃61; 0;
    repeat
      WhiteFound :&＃61; False;
      CntRead :&＃61; Input.Read(InBuf[IdxEnd], (SizeOf(InBuf)-IdxEnd));
      EndReached :&＃61; CntRead < (SizeOf(InBuf)-IdxEnd);
      Idx :&＃61; IdxEnd;
      IdxEnd :&＃61; CntRead &＃43; IdxEnd;
      while (Idx < IdxEnd) do
      begin
        if not (InBuf[Idx] in [&＃39;0&＃39;..&＃39;9&＃39;,&＃39;A&＃39;..&＃39;Z&＃39;,&＃39;a&＃39;..&＃39;z&＃39;,&＃39;&＃43;&＃39;,&＃39;/&＃39;,&＃39;&＃61;&＃39;]) then
        begin
          Dec(IdxEnd);
          if Idx < IdxEnd then
            Move(InBuf[Idx&＃43;1], InBuf[Idx], IdxEnd-Idx);
          WhiteFound :&＃61; True;
        end
        else
          Inc(Idx);
      end;
    until (not WhiteFound) or (EndReached);
    Result :&＃61; IdxEnd;
  end;

begin
  repeat
    SkipWhite;
    BytesRead :&＃61; ReadInput;
    InBufPtr :&＃61; InBuf;
    OutBufPtr :&＃61; &＃64;OutBuf;
    I :&＃61; 0;
    while I < BytesRead do
    begin
      Packet :&＃61; DecodePacket(InBufPtr, J);
      K :&＃61; 0;
      while J > 0 do
      begin
        OutBufPtr^ :&＃61; AnsiChar(Packet.a[K]);
        Inc(OutBufPtr);
        Dec(J);
        Inc(K);
      end;
      Inc(InBufPtr, 4);
      Inc(I, 4);
    end;
    Output.Write(OutBuf, OutBufPtr - PAnsiChar(&＃64;OutBuf));
  until BytesRead &＃61; 0;
end;

function EncodeString(const Input: string): string;
var
  InStr, OutStr: TStringStream;
begin
  InStr :&＃61; TStringStream.Create(Input);
  try
    OutStr :&＃61; TStringStream.Create(&＃39;&＃39;);
    try
      EncodeStream(InStr, OutStr);
      Result :&＃61; OutStr.DataString;
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
end;

function DecodeString(const Input: string): string;
var
  InStr, OutStr: TStringStream;
begin
  InStr :&＃61; TStringStream.Create(Input);
  try
    OutStr :&＃61; TStringStream.Create(&＃39;&＃39;);
    try
      DecodeStream(InStr, OutStr);
      Result :&＃61; OutStr.DataString;
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
end;

constructor TPointerStream.Create(P: Pointer; Size: Integer);
begin
  SetPointer(P, Size);
end;

function TPointerStream.Write(const Buffer; Count: Longint): Longint;
var
  Pos, EndPos, Size: Longint;
  Mem: Pointer;
begin
  Pos :&＃61; Self.Position;

  if (Pos >&＃61; 0) and (Count > 0) then
  begin
    EndPos :&＃61; Pos &＃43; Count;
    Size:&＃61; Self.Size;
    if EndPos > Size then
      raise EStreamError.CreateRes(&＃64;SMemoryStreamError);

    Mem :&＃61; Self.Memory;
    System.Move(Buffer, Pointer(Longint(Mem) &＃43; Pos)^, Count);
    Self.Position :&＃61; Pos;
    Result :&＃61; Count;
    Exit;
  end;
  Result :&＃61; 0;
end;

function DecodeBase64(const Input: AnsiString): TBytes;
var
  InStr: TPointerStream;
  OutStr: TBytesStream;
  Len: Integer;
begin
  InStr :&＃61; TPointerStream.Create(PAnsiChar(Input), Length(Input));
  try
    OutStr :&＃61; TBytesStream.Create;
    try
      DecodeStream(InStr, OutStr);
      Result :&＃61; OutStr.Bytes;
      Len :&＃61; OutStr.Size;
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
  SetLength(Result, Len);
end;

function EncodeBase64(const Input: Pointer; Size: Integer): AnsiString;
var
  InStr: TPointerStream;
  OutStr: TBytesStream;
begin
  InStr :&＃61; TPointerStream.Create(Input, Size);
  try
    OutStr :&＃61; TBytesStream.Create;
    try
      EncodeStream(InStr, OutStr);
      SetString(Result, PAnsiChar(OutStr.Memory), OutStr.Size);
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
end;

end.

转:https://www.cnblogs.com/jxgxy/archive/2010/01/04/1639084.html

推荐阅读

int
IO流——字符流 BufferedReader / BufferedWriter 进行文件读写

目录节点流、处理流读文件：BufferedReader的使用写文件：BufferedWriter的使用节点流处理流节点流和处理流的区别和联系字符流Buf ... [详细]

蜡笔小新 2024-11-18 14:47:25
case
43.Word Break（看字符串是否由词典中的单词组成）

Level： Medium题目描述：Givenanon-emptystringsandadictionarywordDictcontainingalistofnon-emptyw ... [详细]

蜡笔小新 2024-11-19 20:43:23
char
C# 中创建和执行存储过程的方法

本文详细介绍了如何使用 C# 创建和调用 SQL Server 存储过程，包括连接数据库、定义命令类型、设置参数等步骤。 ... [详细]

蜡笔小新 2024-11-19 19:55:59
char
JavaScript 实现图片文件转Base64编码的方法

本文详细介绍了如何使用JavaScript将用户通过文件输入控件选择的图片文件转换为Base64编码字符串，适用于Web前端开发中图片上传前的预处理。 ... [详细]

蜡笔小新 2024-11-19 12:43:15
char
HTML5 Canvas 图片导出与上传至远程服务器的方法

在现代Web开发中，HTML5 Canvas常用于图像处理和绘图任务。本文将详细介绍如何将Canvas中的图像导出并上传至服务器，适用于拼图、图片编辑等场景。 ... [详细]

蜡笔小新 2024-11-18 18:04:32
char
RTThread线程间通信

线程中通信在裸机编程中，经常会使用全局变量进行功能间的通信，如某些功能可能由于一些操作而改变全局变量的值，另一个功能对此全局变量进行读取& ... [详细]

蜡笔小新 2024-11-18 14:56:11
char
Java中字符串截取方法详解

本文详细介绍了Java中常用的字符串截取方法及其应用场景，帮助开发者更好地理解和使用这些方法。 ... [详细]

蜡笔小新 2024-11-17 18:10:47
int
服务器虚拟化存储设计,完美规划储存与资源，部署高性能虚拟化桌面

规划部署虚拟桌面环境前，必须先估算目前所使用实体桌面环境的工作负载与IOPS性能，并慎选储存设备。唯有谨慎估算贴近实际的IOPS性能，才能 ... [详细]

蜡笔小新 2024-11-22 19:12:09
replace
如何在没有提交按钮的情况下提交HTML表单？

探讨了在HTML表单中使用元素代替进行表单提交的方法。 ... [详细]

蜡笔小新 2024-11-22 17:48:42
default
一文详解Linux

Linuxnetfilter与VRF实验环境如下图所示：配置如下：#!binbashsudoipnetnsaddns1sudoiplinkaddns1veth1typevethpe ... [详细]

蜡笔小新 2024-11-22 16:56:09
export
利用Node.js实现PSD文件的高效切图

本文介绍了如何通过Node.js及其psd2json模块，快速实现PSD文件的自动化切图过程，以适应项目中频繁的界面更新需求。此方法不仅提高了工作效率，还简化了从设计稿到实际应用的转换流程。 ... [详细]

蜡笔小新 2024-11-22 13:21:24
case
H5技术实现经典游戏《贪吃蛇》

本文将分享一个使用HTML5技术实现的经典小游戏——《贪吃蛇》。通过H5技术，我们将探讨如何构建这款游戏的两种主要玩法：积分闯关和无尽模式。 ... [详细]

蜡笔小新 2024-11-21 20:16:59
int
Struts2 + json+ jquery 实现三级联动action和jsp代码竟然有小红叉，提示缺双引号，检查了转义符号也没缺啊，求解

publicclassBindActionextendsActionSupport{privateStringproString;privateStringcitString; ... [详细]

蜡笔小新 2024-11-21 16:25:41
random
机器学习（ML）三之多层感知机

深度学习主要关注多层模型，现在以多层感知机（multilayerperceptron，MLP）为例，介绍多层神经网络的概念。隐藏层多层感知机在单层神经网络的基础上引入了一到多个隐藏 ... [详细]

蜡笔小新 2024-11-19 19:02:28
jar
Java代码保护与混淆：ProGuard详解

在Java开发中，保护代码安全是一个重要的课题。由于Java字节码容易被反编译，因此使用代码混淆工具如ProGuard变得尤为重要。本文将详细介绍如何使用ProGuard进行代码混淆，以及其基本原理和常见问题。 ... [详细]

蜡笔小新 2024-11-18 16:46:17

甄之恋

这个家伙很懒，什么也没留下！

Tags | 热门标签

RankList | 热门文章