unit Base64Unit;

unit Base64Unit;
//Download by http://www.codefans.net
interface uses
Classes, SysUtils; function Base64Encryption(const Input:String):String;
function Base64Decryption(const Input:String):String; implementation const
BASE64Table : array[0..63] of Char = ( #65, #66, #67, #68, #69,
#70, #71, #72, #73, #74, #75, #76, #77, #78, #79,
#80, #81, #82, #83, #84, #85, #86, #87, #88, #89,
#90, #97, #98, #99, #100, #101, #102, #103, #104, #105,
#106, #107, #108, #109, #110, #111, #112, #113, #114, #115,
#116, #117, #118, #119, #120, #121, #122, #48, #49, #50,
#51, #52, #53, #54, #55, #56, #57, #43, #47); const
BASE64DeTable : array[43..122] of Byte = ($3E, $7F, $7F, $7F, $3F, $34,
$35, $36, $37, $38, $39, $3A, $3B, $3C, $3D, $7F, $7F, $7F, $7F,
$7F, $7F, $7F, $00, $01, $02, $03, $04, $05, $06, $07, $08, $09,
$0A, $0B, $0C, $0D, $0E, $0F, $10, $11, $12, $13, $14, $15, $16,
$17, $18, $19, $7F, $7F, $7F, $7F, $7F, $7F, $1A, $1B, $1C, $1D,
$1E, $1F, $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $2A,
$2B, $2C, $2D, $2E, $2F, $30, $31, $32, $33); //BASE64算法流加密
procedure EncodeStream(InStream, OutStream : TStream);
var
I, O, Count : Integer;
InBuf : array[1..45] of Byte;
OutBuf : array[0..62] of Char;
Temp : Byte;
begin
FillChar(OutBuf, Sizeof(OutBuf), #0); repeat
Count := InStream.Read(InBuf, SizeOf(InBuf));
if Count = 0 then Break;
I := 1;
O := 0;
while I <= (Count-2) do begin
{ 编码第一个字节 }
Temp := (InBuf[I] shr 2);
OutBuf[O] := Char(BASE64Table[Temp and $3F]); { 编码第二个字节 }
Temp := (InBuf[I] shl 4) or (InBuf[I+1] shr 4);
OutBuf[O+1] := Char(BASE64Table[Temp and $3F]); { 编码第三个字节 }
Temp := (InBuf[I+1] shl 2) or (InBuf[I+2] shr 6);
OutBuf[O+2] := Char(BASE64Table[Temp and $3F]); { 编码第四个字节 }
Temp := (InBuf[I+2] and $3F);
OutBuf[O+3] := Char(BASE64Table[Temp]); Inc(I, 3);
Inc(O, 4);
end; if (I <= Count) then begin
Temp := (InBuf[I] shr 2);
OutBuf[O] := Char(BASE64Table[Temp and $3F]); { 一个奇数字节 }
if I = Count then begin
Temp := (InBuf[I] shl 4) and $30;
OutBuf[O+1] := Char(BASE64Table[Temp and $3F]);
OutBuf[O+2] := '=';
{ 两个基数字节 }
end else begin
Temp := ((InBuf[I] shl 4) and $30) or ((InBuf[I+1] shr 4) and $0F);
OutBuf[O+1] := Char(BASE64Table[Temp and $3F]);
Temp := (InBuf[I+1] shl 2) and $3C;
OutBuf[O+2] := Char(BASE64Table[Temp and $3F]);
end;
{ 增加= }
OutBuf[O+3] := '=';
Inc(O, 4);
end; { 把编码好的块写到流中 }
OutStream.Write(OutBuf, O);
until Count < SizeOf(InBuf);
end; //BASE64算法流解密
procedure DecodeStream(InStream, OutStream : TStream);
var
I, O, Count, c1, c2, c3 : Byte;
InBuf : array[0..87] of Byte;
OutBuf : array[0..65] of Byte;
begin
repeat
O := 0;
I := 0; Count := InStream.Read(InBuf, SizeOf(InBuf));
if (Count = 0) then
Break; { 解密的数据输入到流中 }
while I < Count do begin
if (InBuf[I] < 43) or (InBuf[I] > 122) or
(InBuf[I+1] < 43) or (InBuf[I+1] > 122) or
(InBuf[I+2] < 43) or (InBuf[I+2] > 122) or
(InBuf[I+3] < 43) or (InBuf[I+3] > 122) then
raise Exception.Create('Invalid Base64 Character'); c1 := BASE64DeTable[InBuf[I]];
c2 := BASE64DeTable[InBuf[I+1]];
c3 := BASE64DeTable[InBuf[I+2]];
OutBuf[O] := ((c1 shl 2) or (c2 shr 4));
Inc(O);
if Char(InBuf[I+2]) <> '=' then begin
OutBuf[O] := ((c2 shl 4) or (c3 shr 2));
Inc(O);
if Char(InBuf[I+3]) <> '=' then begin
OutBuf[O] := ((c3 shl 6) or BASE64DeTable[InBuf[I+3]]);
Inc(O);
end;
end;
Inc(I, 4);
end;
OutStream.Write(OutBuf, O);
until Count < SizeOf(InBuf);
end; //BASE64算法字符串加密
function Base64Encryption(const Input:String):String;
var
InStream : TMemoryStream;
OutStream : TMemoryStream;
begin
InStream := TMemoryStream.Create;
OutStream := TMemoryStream.Create; InStream.Write(Input[1], Length(Input));
InStream.Position := 0;
EncodeStream(InStream, OutStream);
OutStream.Position := 0;
SetLength(Result, OutStream.Size);
OutStream.Read(Result[1], OutStream.Size); InStream.Free;
OutStream.Free;
end; //BASE64算法字符串解密
function Base64Decryption(const Input:String):String;
var
InStream : TMemoryStream;
OutStream : TMemoryStream;
begin
InStream := TMemoryStream.Create;
OutStream := TMemoryStream.Create; InStream.Write(Input[1], Length(Input));
InStream.Position := 0;
DecodeStream(InStream, OutStream);
OutStream.Position := 0;
SetLength(Result, OutStream.Size);
OutStream.Read(Result[1], OutStream.Size); InStream.Free;
OutStream.Free;
end; end.

  

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.Text:=BASE64Encryption(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Edit4.Text:=BASE64Decryption(Edit3.Text);
end;

unit Base64Unit;的更多相关文章

  1. 老 base64 for xe8

    not recommend ,only for study procedure TForm1.Button3Click(Sender: TObject); var ssi, sso: TStringS ...

  2. ABP(现代ASP.NET样板开发框架)系列之12、ABP领域层——工作单元(Unit Of work)

    点这里进入ABP系列文章总目录 基于DDD的现代ASP.NET开发框架--ABP系列之12.ABP领域层——工作单元(Unit Of work) ABP是“ASP.NET Boilerplate Pr ...

  3. ABP源码分析十:Unit Of Work

    ABP以AOP的方式实现UnitOfWork功能.通过UnitOfWorkRegistrar将UnitOfWorkInterceptor在某个类被注册到IOCContainner的时候,一并添加到该类 ...

  4. Failed to stop iptables.service: Unit iptables.service not loaded.

    redhat 7 [root@lk0 ~]# service iptables stop Redirecting to /bin/systemctl stop iptables.service Fai ...

  5. VS2012 Unit Test 个人学习汇总(含目录)

    首先,给出MSDN相关地址:http://msdn.microsoft.com/en-us/library/Microsoft.VisualStudio.TestTools.UnitTesting.a ...

  6. VS2012 Unit Test —— 我对IdleTest库动的大手术以及对Xml相关操作进行测试的方式

    [1]我的IdleTest源码地址:http://idletest.codeplex.com/ [2]IdleTest改动说明:2013年10月份在保持原有功能的情况下对其动了较大的手术,首先将基本的 ...

  7. VS2012 Unit Test——Microsoft Fakes入门

    如题,本文主要作为在VS2012使用Fakes的入门示例,开发工具必须是VS2012或更高版本. 关于Fakes的MSDN地址:http://msdn.microsoft.com/en-us/libr ...

  8. MTU(Maximum transmission unit) 最大传输单元

    最大传输单元(Maximum transmission unit),以太网MTU为1500. 不同网络MTU如下: 如果最大报文数据大小(MSS)超过MTU,则会引起分片操作.   路径MTU: 网路 ...

  9. Simulink Memory vs Unit Delay

    Memoryブロック.Unit Delayブロック共に前回の入力値を出力しますが.動作するタイミングが異なります. ●Memoryブロック シミュレーションの各時刻(ステップ)で動作し.「1ステップ」 ...

随机推荐

  1. 《Lucene in Action》(第二版) 第一章节的学习总结 ---- 用最少的代码创建索引和搜索

    第一章节是介绍性质,但是通过这一章节的学习,我理解到如下概念: 1.Lucene由两部分组成:索引和搜索.索引是通过对原始数据的解析,形成索引的过程:而搜索则是针对用户输入的查找要求,从索引中找到匹配 ...

  2. linux 进程线程

    linux下进程的最大线程数.进程最大数.进程打开的文件数   ===========最大线程数============== linux 系统中单个进程的最大线程数有其最大的限制 PTHREAD_TH ...

  3. named主从环境部署

    named主 1. bind服务安装配置 yum -y install bind*.x86_64 配置文件: /etc/named.conf /etc/named.rfc1912.zones /etc ...

  4. 【Mac系统 + Mysql】之安装Mysql数据库

    安装Mysql步骤: 一.下载 参考文章<mac 安装MySQL> 到Mysql官网下载.dmg格式的文件 先放弃了,看下面的简易安装. 二.使用homebrew安装MySQL(推荐) 如 ...

  5. android--SDK Manager下载Connection to http://dl-ssl.google.com refused

    错误 Failed to fetch URL https://dl-ssl.google.com/android/repository/repository-6.xml, reason: Connec ...

  6. DevExpress控件显示前弹出到期时间解决办法

    方法是,删除Properties下的license.licx文件,重新生成即可.

  7. 让Xcode支持高版本系统设备真机测试

    最新支持11.2 (15C107) Xcode只可以支持iPhone手机对应iOS系统以下的真机测试.一般想要支持最新的iPhone手机系统,有两个方法. 第一.就需要更新Xcode,这一个方法有一个 ...

  8. 【python】-- 事件驱动介绍、阻塞IO, 非阻塞IO, 同步IO,异步IO介绍

    事件驱动介绍 一.前言 通常,我们写服务器处理模型的程序时,有以下几种模型: (1)每收到一个请求,创建一个新的进程,来处理该请求: (2)每收到一个请求,创建一个新的线程,来处理该请求: (3)每收 ...

  9. 又一次发现Oracle太美之awr相关脚本简介

    又一次发现Oracle太美之awr相关脚本简介 大家知道在$ORACLE_HOME/rdbms/admin下,有例如以下的相关脚本(我的环境为11.2.0.4.2): [oracle@rh64 ~]$ ...

  10. IOS - 执行时 (多态)

    一 多态概述          多态指同一操作作用于不同的对象.能够有不同的解释.产生不同的执行结果.它是面向对象程序设计(OOP)的一个重要特征,动态类型能使程序直到执行时才确定对象的所属类.其详细 ...