Delphi中SOAP组件原生的EncdDecd单元，作用于流Base64编码转换

最新推荐文章于 2023-03-18 11:51:46 发布
最新推荐文章于 2023-03-18 11:51:46 发布
阅读量2.3k 收藏
点赞数
分类专栏： Delphi类 文章标签： delphi Base64 流
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/jupt1/article/details/41050251
版权 
{*******************************************************}
{                                                       }
{                Delphi Runtime Library                 }
{                                                       }
{ Copyright(c) 1995-2013 Embarcadero Technologies, Inc. }
{                                                       }
{*******************************************************}


unit Soap.EncdDecd;


interface


uses System.Classes, System.SysUtils;


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


{$IFDEF NEXTGEN}
function  DecodeBase64(const Input: string): TBytes;
function  EncodeBase64(const Input: Pointer; Size: Integer): string;
{$ELSE !NEXTGEN}
function  DecodeBase64(const Input: AnsiString): TBytes;
function  EncodeBase64(const Input: Pointer; Size: Integer): AnsiString;
{$ENDIF NEXTGEN}


implementation


uses System.RTLConsts;


const
{$IFDEF NEXTGEN}
  EncodeTable: array[0..63] of Byte = (
    Ord('A'),Ord('B'),Ord('C'),Ord('D'),Ord('E'),Ord('F'),Ord('G'),Ord('H'),Ord('I'),
    Ord('J'),Ord('K'),Ord('L'),Ord('M'),Ord('N'),Ord('O'),Ord('P'),Ord('Q'),Ord('R'),
    Ord('S'),Ord('T'),Ord('U'),Ord('V'),Ord('W'),Ord('X'),Ord('Y'),Ord('Z'),
    Ord('a'),Ord('b'),Ord('c'),Ord('d'),Ord('e'),Ord('f'),Ord('g'),Ord('h'),Ord('i'),
    Ord('j'),Ord('k'),Ord('l'),Ord('m'),Ord('n'),Ord('o'),Ord('p'),Ord('q'),Ord('r'),
    Ord('s'),Ord('t'),Ord('u'),Ord('v'),Ord('w'),Ord('x'),Ord('y'),Ord('z'),
    Ord('0'),Ord('1'),Ord('2'),Ord('3'),Ord('4'),Ord('5'),Ord('6'),Ord('7'),Ord('8'),Ord('9'),Ord('+'),Ord('/'));
{$ELSE !NEXTGEN}
  EncodeTable: array[0..63] of AnsiChar =
    AnsiString('ABCDEFGHIJKLMNOPQRSTUVWXYZ') +
    AnsiString('abcdefghijklmnopqrstuvwxyz') +
    AnsiString('0123456789+/');
{$ENDIF NEXTGEN}


{$IFDEF NEXTGEN}
  DecodeTable: array[Ord(#0)..Ord(#127)] of Integer = (
{$ELSE !NEXTGEN}
  DecodeTable: array[#0..#127] of Integer = (
{$ENDIF NEXTGEN}
    Byte('='), 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 = ^TPacket;
  TPacket = packed record
    case Integer of
      0: (b0, b1, b2, b3: Byte);
      1: (i: Integer);
      2: (a: array[0..3] of Byte);
{$IFNDEF NEXTGEN}
      3: (c: array[0..3] of AnsiChar);
{$ENDIF !NEXTGEN}
  end;


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


{$IFDEF NEXTGEN}
procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PByte);
{$ELSE !NEXTGEN}
procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PAnsiChar);
{$ENDIF NEXTGEN}
begin
  OutBuf[0] := EnCodeTable[Packet.a[0] shr 2];
  OutBuf[1] := EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f];
  if NumChars < 2 then
{$IFDEF NEXTGEN}
    OutBuf[2] := Ord('=')
{$ELSE !NEXTGEN}
    OutBuf[2] := '='
{$ENDIF NEXTGEN}
  else OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];
  if NumChars < 3 then
{$IFDEF NEXTGEN}
    OutBuf[3] := Ord('=')
{$ELSE !NEXTGEN}
    OutBuf[3] := '='
{$ENDIF NEXTGEN}
  else OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f];
end;


{$IFDEF NEXTGEN}
function DecodePacket(InBuf: PByte; var nChars: Integer): TPacket;
begin
  Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or
    (DecodeTable[InBuf[1]] shr 4);
  NChars := 1;
  if InBuf[2] <> Ord('=') then
  begin
    Inc(NChars);
    Result.a[1] := Byte((DecodeTable[InBuf[1]] shl 4) or (DecodeTable[InBuf[2]] shr 2));
  end;
  if InBuf[3] <> Ord('=') then
  begin
    Inc(NChars);
    Result.a[2] := Byte((DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]]);
  end;
end;
{$ELSE !NEXTGEN}
function DecodePacket(InBuf: PAnsiChar; var nChars: Integer): TPacket;
begin
  Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or
    (DecodeTable[InBuf[1]] shr 4);
  NChars := 1;
  if InBuf[2] <> '=' then
  begin
    Inc(NChars);
    Result.a[1] := Byte((DecodeTable[InBuf[1]] shl 4) or (DecodeTable[InBuf[2]] shr 2));
  end;
  if InBuf[3] <> '=' then
  begin
    Inc(NChars);
    Result.a[2] := Byte((DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]]);
  end;
end;
{$ENDIF NEXTGEN}


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


procedure DecodeStream(Input, Output: TStream);
var
{$IFDEF NEXTGEN}
  InBuf: array[0..75] of Byte;
  OutBuf: array[0..60] of Byte;
  InBufPtr, OutBufPtr: PByte;
{$ELSE !NEXTGEN}
  InBuf: array[0..75] of AnsiChar;
  OutBuf: array[0..60] of Byte;
  InBufPtr, OutBufPtr: PAnsiChar;
{$ENDIF NEXTGEN}
  I, J, K, BytesRead: Integer;
  Packet: TPacket;


  procedure SkipWhite;
  var
    C: Byte;
    NumRead: Integer;
  begin
    while True do
    begin
      NumRead := Input.Read(C, 1);
      if NumRead = 1 then
      begin
        if C in [Ord('0')..Ord('9'),Ord('A')..Ord('Z'),Ord('a')..Ord('z'),Ord('+'),Ord('/'),Ord('=')] then
        begin
          Input.Position := Input.Position - 1;
          Break;
        end;
      end else Break;
    end;
  end;


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


begin
  repeat
    SkipWhite;
    BytesRead := ReadInput;
    InBufPtr := @InBuf[0];
    OutBufPtr := @OutBuf;
    I := 0;
    while I < BytesRead do
    begin
      Packet := DecodePacket(InBufPtr, J);
      K := 0;
      while J > 0 do
      begin
{$IFDEF NEXTGEN}
        OutBufPtr^ := Packet.a[K];
{$ELSE !NEXTGEN}
        OutBufPtr^ := AnsiChar(Packet.a[K]);
{$ENDIF NEXTGEN}
        Inc(OutBufPtr);
        Dec(J);
        Inc(K);
      end;
      Inc(InBufPtr, 4);
      Inc(I, 4);
    end;
{$IFDEF NEXTGEN}
    Output.Write(OutBuf, OutBufPtr - PByte(@OutBuf[0]));
{$ELSE !NEXTGEN}
    Output.Write(OutBuf, OutBufPtr - PAnsiChar(@OutBuf));
{$ENDIF NEXTGEN}
  until BytesRead = 0;
end;


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


function DecodeString(const Input: string): string;
var
  InStr, OutStr: TStringStream;
begin
  InStr := TStringStream.Create(Input);
  try
    OutStr := TStringStream.Create('');
    try
      DecodeStream(InStr, OutStr);
      Result := 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 := Self.Position;


  if (Pos >= 0) and (Count > 0) then
  begin
    EndPos := Pos + Count;
    Size:= Self.Size;
    if EndPos > Size then
      raise EStreamError.CreateRes(@SMemoryStreamError);


    Mem := Self.Memory;
    System.Move(Buffer, Pointer(Longint(Mem) + Pos)^, Count);
    Self.Position := Pos;
    Result := Count;
    Exit;
  end;
  Result := 0;
end;


{$IFDEF NEXTGEN}
function DecodeBase64(const Input: string): TBytes;
{$ELSE !NEXTGEN}
function DecodeBase64(const Input: AnsiString): TBytes;
{$ENDIF NEXTGEN}
var
  InStr: TPointerStream;
  OutStr: TBytesStream;
  Len: Integer;
{$IFDEF NEXTGEN}
  M: TMarshaller;
{$ENDIF NEXTGEN}
begin
{$IFDEF NEXTGEN}
  InStr := TPointerStream.Create(M.AsAnsi(PWideChar(Input)).ToPointer, Length(Input));
{$ELSE !NEXTGEN}
  InStr := TPointerStream.Create(PAnsiChar(Input), Length(Input));
{$ENDIF NEXTGEN}
  try
    OutStr := TBytesStream.Create;
    try
      DecodeStream(InStr, OutStr);
      Result := OutStr.Bytes;
      Len := OutStr.Size;
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
  SetLength(Result, Len);
end;


{$IFDEF NEXTGEN}
function EncodeBase64(const Input: Pointer; Size: Integer): string;
{$ELSE !NEXTGEN}
function EncodeBase64(const Input: Pointer; Size: Integer): AnsiString;
{$ENDIF NEXTGEN}
var
  InStr: TPointerStream;
  OutStr: TBytesStream;
begin
  InStr := TPointerStream.Create(Input, Size);
  try
    OutStr := TBytesStream.Create;
    try
      EncodeStream(InStr, OutStr);
{$IFDEF NEXTGEN}
      SetString(Result, MarshaledAString(OutStr.Memory), OutStr.Size);
{$ELSE !NEXTGEN}
      SetString(Result, PAnsiChar(OutStr.Memory), OutStr.Size);
{$ENDIF NEXTGEN}
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
end;




end.

胡伟峰
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
Delphi Base64编码，javascript解码汉字乱码解决方法演示程序（源代码）
04-13
Delphi进行Base64编码后，如果使用javascript解码，会出现如下问题： 1. 汉字乱码 2. 空格变成 + 号 本资源演示Delphi代码，实现javascript能正确进行Base64解码，不出现上述2个问题。 解决思路：进行Base64前先进行URL编码，在进行URL编码的时候，注意设置不需要SpaceAsPlus选项。 javascript代码： let decodedData = window.atob(JSONStr); let decodedData1 = decodeURIComponent(decodedData); 期望能帮到需要的人！
Delphi Base64 演示及躲坑
12-09
演示Delphi 原生的Base64编码，解码使用方法及和其他语言对接中的坑
delphi base64算法演示案例
02-20
1. 已将base64单独编写成独立的pas文件，use开箱即用； 2. 附案例，复制粘贴即可用；
Delphi版的Base64互相转换函数
02-21
Delphi版的Base64互相转换函数
Delphi图片与Base64互转及图片添加水印
11-23
Delphi 实现图片与Base64编码相互转化和给图片添加水印图片和水印文字Demo
delphi base64编码函数EncodeString的问题
MaTaijin的专栏
09-04 4089
delphi base64编码函数EncodeString的问题在每遇到字符长度大于75时，将在编码串中增加一个换行回车，所以在将编码串写入文件，然后在读出解码时就产生乱码， 所以在源码中将相关代码屏蔽就可以了： procedure EncodeStream(Input, O
Delphi BASE64单元EncdDecd的修改
weixin_30337251的博客
06-27 278
Delphi BASE64单元EncdDecd的修改 EncdDecd.pas两个函数声明： procedure EncodeStream(Input, Output: TStream);procedure DecodeStream(Input, Output: TStream); 对于Output参数，如果是TMemoryStream，效率真是太糟糕了，测试发现，编码一个5M多的文件，要十...
Delphi版的Base64转换函数（修改版）
闲人阿发伯的业余编程心得
06-14 1万+
     前几天，兴趣所致，写了2个Delphi版的Base64转换函数，见《Delphi版的Base64转换函数》一文。后来觉得这些函数使用不够灵活，所以重新写了几个放在这里，核心的转换代码用BASM写的（不知是否快一点，不过，我觉得用汇编写这种代码好像比Pascal还容易些，因为有些二进制操作，高级语言不方便，同时使用汇编也能使算法更合理，可比较《Delphi版的Base64转换函数》代码和汇
Delphi版的Base64转换函数
闲人阿发伯的业余编程心得
06-07 1万+
    Base64是网络上最常见的用于加密传输8Bit字节代码的编码方式之一， 网上搜索，.NET、C/C++的代码到处都是，可没找到Delphi的，本人写了2个函数，可供访问者参考使用。（注：后来，我觉得这2个函数灵活性太差，进行了修改，见《Delphi版的Base64转换函数（修改版） 》）unit Base64;interfaceuses SysUtils;function Str
java base64 delphi_如何在delphi中对通过BASE64Encoder的字符串进行解码？(200分)
weixin_34175189的博客
02-24 328
我在J2EE服务器上写了一个JAVA CLASS的WEB SERVICE应用，在该JAVA CLASS对一个大文本文件(二进制文件)通过BASE64Encoder处理成一个字符串，该JAVA CLASS返回一个处理后的字符串，现在我在DELPHI中通过SOAP得到了这个字符串，但是在DELPHI中通过IdDecoderMIME1.DecodeToStream解码时，总是提示：uneven size...
DELPHI 图片与Base64互转 添加水印 支持BMP,PNG,JPG,GIF
02-02
DELPHI 图片与Base64互转 添加水印 支持BMP,PNG,JPG,GIF
delphi EncdDecd.pas单元中Encoding方法出现#$D#$A的解决方法
xtfnpgy
06-26 5704
例如： s:= 'http://detail.tmall.com/item.htm?id=45545826531&abbucket=_AB-M129_B17&acm=03130.1003.1.161728&aldid=4HatiDee&abtest=_AB-LR129-PV129_1393&scm=1003.1.03130.13_45545826531_161728&pos=6#detail';
delphi Base64 编解码
jls的博客
10-15 2038
Delphi 自带了 Base64 编解码的单元，叫 EncdDecd，这名字很拗口而且不直观，估计这是一直很少人关注和知道的原因。 这个单元提供两套四个公开函数： 对流的编解码： procedure EncodeStream(Input, Output: TStream); inline; // deprecated 'Use TNetEncoding.Base64.Encode';  /...
delphi如何把json传递过来的base64值转成图片
red_eye的博客
03-18 904
delphi如何把json传递过来的base64值转成图片
delphi下的base64加解密
hellolongbin[一个人]的专栏
11-06 1405
找了半天，原来EncdDecd单元下就自带有base64的加解密函数 EncodeString和 DecodeString
使用Indy解决Could not load SSL Library错误
热门推荐
Soft
11-25 2万+
今天花了1天时间终于搞明白了在使用Indy时如何解决Could not load SSL Library。   测试平台：DelphiXE7 + Indy 10.6.0.5169 + Win7 64bit 步骤： 1. SSL下载版本：openssl-1.0.1j-i386-win32 可去http://yunpan.cn/cAWTYZ3VMHv36  提取码 3551进行下载     ...
Dll学习一_Dll 创建并动态引用窗体且释放窗体Demo
Soft
11-22 3095
1、新建Dll工程 2、Dll工程全部代码 library SubMain; { Important note about DLL memory management: ShareMem must be the first unit in your library's USES clause AND your project's (select Project-View Source
DevExpress12.2.6 安装顺序记录
Soft
11-20 2376
环境DelphiXE，实测DevExpress手工安装顺序： 1、ExpressCore Library 2、XP Theme Manager 3、ExpressGDI+ Library 4、ExpressLibrary 5、ExpressCommon Library 6、ExpressDataController 7、ExpressEditors Library 5 8、
CoInitialize错误引起的错误症状整理
Soft
12-02 2368
虽然知道这个问题应该怎么去解决，但是真要用时，竟然想不起来那个引用的Unit以及函数名，留此仅做记号使用 “尚未调用CoInitialize错误” 多见于Dll内使用数据操作，所以需要在Unit创建时初始化 initialization CoInitialize(nil); finalization CoUninitialize; 要想以上代码生效，必须先引用单元Ac
delphi base64编码
最新发布
06-07
在 Delphi 中进行 Base64 编码可以使用 TNetEncoding 类的 TBase64Encoding 类，具体操作如下： 1. 首先需要在 uses 声明中添加 System.NetEncoding; 2. 创建 TBase64Encoding 对象并调用 Encode 方法进行编码，示例代码如下： ```delphi uses System.NetEncoding; function Base64Encode(const AStr: string): string; var Encoding: TBase64Encoding; begin Encoding := TBase64Encoding.Create; try Result := Encoding.Encode(AStr); finally Encoding.Free; end; end; ``` 其中 AStr 是要进行 Base64 编码的字符串，函数返回值为编码后的字符串。 3. 如果需要进行 Base64 解码，可以调用 TBase64Encoding 类的 Decode 方法，示例代码如下： ```delphi uses System.NetEncoding; function Base64Decode(const AStr: string): string; var Encoding: TBase64Encoding; begin Encoding := TBase64Encoding.Create; try Result := Encoding.Decode(AStr); finally Encoding.Free; end; end; ``` 其中 AStr 是要进行 Base64 解码的字符串，函数返回值为解码后的字符串。

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值