{*******************************************************}
{ 系统常用公共方法 }
{ Soar ExtCtrls }
{ }
{ 版权所有 (C) 2012 Soar zhangaoxiang }
{ }
{*******************************************************}
unit SysComm;

interface

uses
 Forms,dxBar,Windows,SysUtils,ZLib,Classes;
type
 TEncryptKey = record
 UserKey : Word;
 EncryKey1 : Word;
 EncryKey2 : Word;
 end;
//常量定义
const
 DefaultMessageCaption = '提示';
 DefaultErrorCaption = '错误';
 DefaultWaringCaption = '警告';
 DefaultEncryptKey:TEncryptKey = (UserKey: 211; EncryKey1: 52845; EncryKey2: 22719);
 EncodeTable: array[0..63] of Char ='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
 DecodeTable: array[#0..#127] of Integer =
 (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
 TStreamOperate = (sotZip, sotEncryption, sotBase64);
 TStreamOperateSet = set of TStreamOperate;
 TZipLevel = (zipNone, zipFastest, zipDefault, zipMax);
 

 TStreamOperateRec = record
 StreamOperateSet:TStreamOperateSet;
 ZipLevel:TZipLevel;
 EncryptKey:TEncryptKey;
 end;
 
 PPacket = ^TPacket;
 TPacket = 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 Char);
 end;
 
 TSysCommon = class
 public
 //初始化系统菜单
 class procedure InitAppMenu(AppForm:TForm);
 //消息对话框
 class procedure ShowMessage(Message:string;Caption:string=DefaultMessageCaption);
 class procedure ShowError(Message:string;Caption:string=DefaultErrorCaption);
 class procedure ShowWaring(Message:string;Caption:string=DefaultWaringCaption);
 class function ShowYesNo(Message:string; DefaultNo:Boolean=False; Caption:string=DefaultMessageCaption):Integer;
 class function ShowYesNoCancel(Message:string; DefaultButton:Integer=1; Caption:string=DefaultMessageCaption):Integer;
 class function ShowOkCancel(Message:string; DefaultCancel:Boolean=False; Caption:string=DefaultMessageCaption):Integer;
 //金额转换
 class function GetMoneyCHN(Money:Double):string;
 //字符处理 -- 编码解码|压缩解压缩|加密解密
 class procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PChar);
 class function DecodePacket(InBuf: PChar; var nChars: Integer): TPacket;
 //Base64编解码
 class procedure EncodeBase64(Input, Output: TStream);
 class procedure DecodeBase64(Input, Output: TStream);
 class function StringToBase64(const Input: string): string;
 class function Base64ToString(const Input: string): string;
 //压缩
 class procedure ZipStream(Input, Output:TStream; AZipLevel:TZipLevel=zipDefault);
 class procedure UnZipStream(Input, Output:TStream);
 //简单加解密
 class procedure EncryptStream(Input, Output:TStream; AEncryptKey:TEncryptKey);
 class procedure DecryptStream(Input, Output:TStream; AEncryptKey:TEncryptKey);
 //数据流操作 带操作符
 class procedure StreamEncode(Input, Output:TStream; AStreamOperateRec:TStreamOperateRec);
 class procedure StreamDecode(Input, Output:TStream; AStreamOperateRec:TStreamOperateRec);
 //将原文压缩、Base64编码后返回
 class function EncodeZipBase64(s:string):string;
 //将Base64解码、解压缩后返回
 class function DecodeZipBase64(s:string):string;
 end;
implementation
{-------------------------------------------------------------------------------
 过程名: TSysCommon.InitAppMenu
 说明: 代码创建系统主菜单(菜单及工具栏)
 作者: 张傲翔
 日期: 2012年03月08日
 参数: AppForm:TForm 主窗体
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.InitAppMenu(AppForm:TForm);
var
 AppBarManager:TdxBarManager;
 ABar:TdxBar;
 ABarSubItem:TdxBarSubItem;
 ABarItemLink:TdxBarItemLink;
 ABarButton:TdxBarButton;
begin
 try
 //创建 BarManager
 AppBarManager:=TdxBarManager.Create(AppForm);
 AppBarManager.Style:= bmsOffice11; //设置样式 bmsFlat|bmsOffice11|bmsStandard|bmsUseLookAndFeel|bmsXP|bmsEnhanced
 AppBarManager.BeginUpdate; //开启 dxBarManager 更新
 //添加工具栏
 ABar := AppBarManager.Bars.Add; //通过dxBarManager添加一个 bar (可以是工具栏或菜单栏:通过属性设置)

 ABar.AllowClose:=False; //相关属性设置
 ABar.AllowCustomizing:=False; //
 ABar.AllowQuickCustomizing:=False; //
 ABar.AllowReset := False; //
 ABar.DockingStyle:=dsTop; //重要:停靠方式 ,不设置,将会浮动在窗口之外,这里一般在顶部停靠
 ABar.OneOnRow:=True; //排列在一排上,不换行

 ABar.IsMainMenu:=True; //是否是主菜单 false 为工具栏

 ABar.Caption := '文件'; //设置工具栏名称
 ABar.Visible:=True; //设置工具栏可见
 //添加工具栏下菜单
 ABarSubItem := AppBarManager.AddSubItem;
 ABarSubItem.Caption:='帮助';
 ABarSubItem.Visible := ivAlways;
 ABarItemLink:=ABar.ItemLinks.Insert(0);
 ABarItemLink.Item := ABarSubItem;

 ABarButton := AppBarManager.AddButton;
 ABarButton.Caption:='关于';
 ABarButton.Visible := ivAlways;
 ABarItemLink:= ABarSubItem.ItemLinks.Insert(0);
 ABarItemLink.Item := ABarButton;

 ABarButton := AppBarManager.AddButton;
 ABarButton.Caption:='关闭';
 ABarButton.Visible := ivAlways;
 ABarItemLink:= ABarSubItem.ItemLinks.Insert(ABarSubItem.ItemLinks.VisibleItemCount);
 ABarItemLink.Item := ABarButton;

 ABarButton := AppBarManager.AddButton;
 ABarButton.Caption:='关闭1';
 ABarButton.Visible := ivAlways;
 ABarItemLink:= ABarSubItem.ItemLinks.Insert(ABarSubItem.ItemLinks.VisibleItemCount);
 ABarItemLink.Item := ABarButton;

 ABarButton := AppBarManager.AddButton;
 ABarButton.Caption:='关闭2';
 ABarButton.Visible := ivAlways;
 ABarItemLink:= ABarSubItem.ItemLinks.Insert(ABarSubItem.ItemLinks.VisibleItemCount);
 ABarItemLink.Item := ABarButton;
 
 AppBarManager.EndUpdate;
 except
 self.ShowMessage('创建Menu过程出现异常');
 end;
end;
{-------------------------------------------------------------------------------
 过程名: TSysCommon.ShowAlert
 说明: 消息提示框
 作者: 张傲翔
 日期: 2012年03月08日
 参数: 
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.ShowMessage(Message:string;Caption:string);
begin
 Application.MessageBox(PChar(Message),PChar(Caption),MB_OK + MB_ICONINFORMATION);
end;

{-------------------------------------------------------------------------------
 过程名: TSysCommon.ShowError
 说明: 错误提示框
 作者: 张傲翔
 日期: 2012年03月08日
 参数: Message:string;Caption:string
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.ShowError(Message:string;Caption:string);
begin
 Application.MessageBox(PChar(Message),PChar(Caption),MB_OK + MB_ICONERROR);
end;

{-------------------------------------------------------------------------------
 过程名: TSysCommon.ShowWaring
 说明: 警告提示框
 作者: 张傲翔
 日期: 2012年03月08日
 参数: Message:string;Caption:string
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.ShowWaring(Message:string;Caption:string);
begin
 Application.MessageBox(PChar(Message),PChar(Caption),MB_OK + MB_ICONWARNING);
end;

{-------------------------------------------------------------------------------
 过程名: TSysCommon.ShowOkCancel
 说明: OkCancel 确认对话框
 作者: 张傲翔
 日期: 2012年03月09日
 参数: Message: string; DefaultCancel: Boolean; Caption: string
 返回值: Integer
-------------------------------------------------------------------------------}
class function TSysCommon.ShowOkCancel(Message: string;
 DefaultCancel: Boolean; Caption: string): Integer;
begin
 if DefaultCancel then begin
 Result :=Application.MessageBox(PChar(Message), PChar(Caption), MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2);
 end else begin
 Result :=Application.MessageBox(PChar(Message), PChar(Caption), MB_OKCANCEL + MB_ICONQUESTION);
 end;
end;

{-------------------------------------------------------------------------------
 过程名: TSysCommon.ShowYesNo
 说明: YesNo 确认对话框
 作者: 张傲翔
 日期: 2012年03月09日
 参数: Message: string; DefaultNo: Boolean; Caption: string
 返回值: Integer
-------------------------------------------------------------------------------}
class function TSysCommon.ShowYesNo(Message: string; DefaultNo: Boolean;
 Caption: string): Integer;
begin
 if DefaultNo then begin
 Result :=Application.MessageBox(PChar(Message), PChar(Caption), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2);
 end else begin
 Result :=Application.MessageBox(PChar(Message), PChar(Caption), MB_YESNO + MB_ICONQUESTION);
 end;
end;

{-------------------------------------------------------------------------------
 过程名: TSysCommon.ShowYesNoCancel
 说明: YesNoCancel 确认对话框
 作者: 张傲翔
 日期: 2012年03月09日
 参数: Message: string; DefaultButton: Integer; Caption: string
 返回值: Integer
-------------------------------------------------------------------------------}
class function TSysCommon.ShowYesNoCancel(Message: string;
 DefaultButton: Integer; Caption: string): Integer;
begin
 if DefaultButton = 2 then begin
 Result :=Application.MessageBox(PChar(Message), PChar(Caption), MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2);
 end else
 if DefaultButton = 3 then begin
 Result :=Application.MessageBox(PChar(Message), PChar(Caption), MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON3);
 end else begin
 Result :=Application.MessageBox(PChar(Message), PChar(Caption), MB_YESNOCANCEL + MB_ICONQUESTION);
 end;
end;

{-------------------------------------------------------------------------------
 过程名: TSysCommon.GetMoneyCHN
 说明: 获取金额的中文写法
 作者: 张傲翔
 日期: 2012年03月09日
 参数: Money: Double
 返回值: string
-------------------------------------------------------------------------------}
class function TSysCommon.GetMoneyCHN(Money: Double): string;
const
 s1: string ='零壹贰叁肆伍陆柒捌玖';
 s2: string ='分角元拾佰仟万拾佰仟亿拾佰仟万';
var
 s, dx: string;
 i, Len: Integer;
 function StrTran(const S, S1, S2: string): string;
 begin
 Result := StringReplace(S, S1, S2, [rfReplaceAll]);
 end;
begin
 if Money > 9999999999999 then
 raise Exception.Create('数值太大,超出范围');
 if Money < 0 then begin
 dx := '负';
 Money := -Money;
 end;

 s :=Format('%.0f', [Money * 100]);
 Len := Length(s);

 for i := 1 to Len do
 dx := dx + Copy(s1, (Ord(s[i]) - Ord('0')) * 2 + 1, 2) + Copy(s2, (Len - i) * 2 + 1, 2);

 dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟', '零'), '零佰', '零'), '零拾', '零'), '零角', '零'), '零分', '整');
 dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零', '零'), '零零', '零'), '零亿', '亿'), '零万', '万'), '零元', '元');
 if dx = '整' then
 Result :='零元整'
 else
 Result := StrTran(StrTran(dx, '亿万', '亿'), '零整', '整');
end;
class procedure TSysCommon.EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PChar);
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
 OutBuf[2] := '='
 else OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];
 if NumChars < 3 then
 OutBuf[3] := '='
 else OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f];
end;

class function TSysCommon.DecodePacket(InBuf: PChar; 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;
{-------------------------------------------------------------------------------
 过程名: EncodeBase64
 说明: 对数据流进行Base64编码
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output: TStream
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.EncodeBase64(Input, Output: TStream);
type
 PInteger = ^Integer;
var
 InBuf: array[0..509] of Byte;
 OutBuf: array[0..1023] of Char;
 BufPtr: PChar;
 I, J, BytesRead: Integer;
 Packet: TPacket;
begin
 repeat
 BytesRead := Input.Read(InBuf, SizeOf(InBuf));
 I := 0;
 BufPtr := OutBuf;
 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);
 end;
 Output.Write(Outbuf, BufPtr - PChar(@OutBuf));
 until BytesRead = 0;
end;

{-------------------------------------------------------------------------------
 过程名: DecodeBase64
 说明: 对数据流进行Base64解码
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output: TStream
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.DecodeBase64(Input, Output: TStream);
var
 InBuf: array[0..75] of Char;
 OutBuf: array[0..60] of Byte;
 InBufPtr, OutBufPtr: PChar;
 I, J, K, BytesRead: Integer;
 Packet: TPacket;

 procedure SkipWhite;
 var
 C: Char;
 NumRead: Integer;
 begin
 while True do
 begin
 NumRead := Input.Read(C, 1);
 if NumRead = 1 then
 begin
 if C in ['0'..'9','A'..'Z','a'..'z','+','/','='] 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 (InBuf[Idx] in ['0'..'9','A'..'Z','a'..'z','+','/','=']) 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 := Input.Read(InBuf, SizeOf(InBuf));
 }
 BytesRead := ReadInput;
 InBufPtr := InBuf;
 OutBufPtr := @OutBuf;
 I := 0;
 while I < BytesRead do
 begin
 Packet := self.DecodePacket(InBufPtr, J);
 K := 0;
 while J > 0 do
 begin
 OutBufPtr^ := Char(Packet.a[K]);
 Inc(OutBufPtr);
 Dec(J);
 Inc(K);
 end;
 Inc(InBufPtr, 4);
 Inc(I, 4);
 end;
 Output.Write(OutBuf, OutBufPtr - PChar(@OutBuf));
 until BytesRead = 0;
end;

{-------------------------------------------------------------------------------
 过程名: StringToBase64
 说明: 将字符串进行Base64编码
 作者: 张傲翔
 日期: 2012年03月10日
 参数: const Input: string
 返回值: 编码后的字符串
-------------------------------------------------------------------------------}
class function TSysCommon.StringToBase64(const Input: string): string;
var
 InStr, OutStr: TStringStream;
begin
 InStr := TStringStream.Create(Input);
 try
 OutStr := TStringStream.Create('');
 try
 EncodeBase64(InStr, OutStr);
 Result := OutStr.DataString;
 finally
 OutStr.Free;
 end;
 finally
 InStr.Free;
 end;
end;

{-------------------------------------------------------------------------------
 过程名: Base64ToString
 说明: 将字符串进行Base64解码
 作者: 张傲翔
 日期: 2012年03月10日
 参数: const Input: string
 返回值: 解码后的字符
-------------------------------------------------------------------------------}
class function TSysCommon.Base64ToString(const Input: string): string;
var
 InStr, OutStr: TStringStream;
begin
 InStr := TStringStream.Create(Input);
 try
 OutStr := TStringStream.Create('');
 try
 DecodeBase64(InStr, OutStr);
 Result := OutStr.DataString;
 finally
 OutStr.Free;
 end;
 finally
 InStr.Free;
 end;
end;

{-------------------------------------------------------------------------------
 过程名: ZipStream
 说明: 对数据流进行Zip压缩
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output:TStream; AZipLevel:TZipLevel
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.ZipStream(Input, Output:TStream; AZipLevel:TZipLevel);
 function GetCompressionLevel:TCompressionLevel;
 begin
 case AZipLevel of
 zipFastest : Result :=clFastest;
 zipDefault : Result :=clDefault;
 zipMax : Result :=clMax;
 else Result :=clNone;
 end;
 end;
begin
 with TCompressionStream.Create(GetCompressionLevel, Output) do begin
 try
 CopyFrom(Input, 0);
 finally
 Free ;
 end;
 end;
end;

{-------------------------------------------------------------------------------
 过程名: UnZipStream
 说明: 对数据流进行Zip解压缩
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output:TStream
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.UnZipStream(Input, Output:TStream);
const
 ZipBufSize = 1024;
var
 Buffer: array[0..ZipBufSize - 1] of Char;
 i: Integer;
begin
 with TDecompressionStream.Create(Input) do begin
 try
 repeat
 i :=Read(Buffer, ZipBufSize);
 Output.Write(Buffer, i);
 until i = 0;
 finally
 Free;
 end;
 end;
end;

{-------------------------------------------------------------------------------
 过程名: EncryptStream
 说明: 对数据流进行加密
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output:TStream; AEncryptKey:TEncryptKey
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.EncryptStream(Input, Output:TStream; AEncryptKey:TEncryptKey);
var
 X : Integer;
 C : Byte;
 Key :Word;
begin
 Key :=AEncryptKey.UserKey ;
 Input.Position := 0;
 for X :=0 to Input.Size - 1 do begin
 Input.Read(C, 1);
 C := (C xor (Key shr 8));
 Key := (C + Key) * AEncryptKey.EncryKey1 + AEncryptKey.EncryKey2;
 Output.Write(C, 1);
 end;
end;

{-------------------------------------------------------------------------------
 过程名: DecryptStream
 说明: 对数据流进行解密
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output:TStream; AEncryptKey:TEncryptKey
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.DecryptStream(Input, Output:TStream; AEncryptKey:TEncryptKey);
var
 X : Integer;
 C, O : Byte;
 Key :Word;
begin
 Key :=AEncryptKey.UserKey;
 Input.Position := 0;
 for X := 0 to Input.Size - 1 do begin
 Input.Read(C, 1);
 O := C;
 C := (C xor (Key shr 8));
 Key := (O + Key) * AEncryptKey.EncryKey1 + AEncryptKey.EncryKey2 ;
 Output.Write(C,1);
 end;
end;

{-------------------------------------------------------------------------------
 过程名: StreamEncode
 说明: 对数据流进行编码
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output:TStream; AStreamOperateRec:TStreamOperateRec
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.StreamEncode(Input, Output:TStream; AStreamOperateRec:TStreamOperateRec);
var
 TmpStream1, TmpStream2:TMemoryStream;
begin
 if AStreamOperateRec.StreamOperateSet = [] then begin
 Input.Position :=0;
 Output.CopyFrom(Input, 0);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip] then begin
 Input.Position :=0;
 ZipStream(Input, Output, AStreamOperateRec.ZipLevel);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotEncryption] then begin
 Input.Position :=0;
 EncryptStream(Input, Output, AStreamOperateRec.EncryptKey);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotBase64] then begin
 Input.Position :=0;
 EncodeBase64(Input, Output);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip, sotBase64] then begin
 TmpStream1 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 ZipStream(Input, TmpStream1, AStreamOperateRec.ZipLevel);
 TmpStream1.Position :=0;
 EncodeBase64(TmpStream1, Output);
 finally
 TmpStream1.Free ;
 end;
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip, sotEncryption] then begin
 TmpStream1 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 ZipStream(Input, TmpStream1, AStreamOperateRec.ZipLevel);
 TmpStream1.Position :=0;
 EncryptStream(TmpStream1, Output, AStreamOperateRec.EncryptKey);
 finally
 TmpStream1.Free ;
 end;
 end else
 if AStreamOperateRec.StreamOperateSet = [sotEncryption, sotBase64] then begin
 TmpStream1 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 EncryptStream(Input, TmpStream1, AStreamOperateRec.EncryptKey);
 TmpStream1.Position :=0;
 EncodeBase64(TmpStream1, Output);
 finally
 TmpStream1.Free ;
 end;
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip, sotEncryption, sotBase64] then begin
 TmpStream1 :=TMemoryStream.Create ;
 TmpStream2 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 ZipStream(Input, TmpStream1, AStreamOperateRec.ZipLevel);
 TmpStream1.Position :=0;
 EncryptStream(TmpStream1, TmpStream2, AStreamOperateRec.EncryptKey);
 TmpStream2.Position :=0;
 EncodeBase64(TmpStream2, Output);
 finally
 TmpStream1.Free ;
 TmpStream2.Free ;
 end;
 end;
 Output.Position :=0;
end;

{-------------------------------------------------------------------------------
 过程名: StreamDecode
 说明: 对数据流进行解码
 作者: 张傲翔
 日期: 2012年03月10日
 参数: Input, Output:TStream; AStreamOperateRec:TStreamOperateRec
 返回值: 无
-------------------------------------------------------------------------------}
class procedure TSysCommon.StreamDecode(Input, Output:TStream; AStreamOperateRec:TStreamOperateRec);
var
 TmpStream1, TmpStream2:TMemoryStream;
begin
 if AStreamOperateRec.StreamOperateSet = [] then begin
 Input.Position :=0;
 Output.CopyFrom(Input, 0);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip] then begin
 Input.Position :=0;
 UnZipStream(Input, Output);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotEncryption] then begin
 Input.Position :=0;
 DecryptStream(Input, Output, AStreamOperateRec.EncryptKey);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotBase64] then begin
 Input.Position :=0;
 DecodeBase64(Input, Output);
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip, sotBase64] then begin
 TmpStream1 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 DecodeBase64(Input, TmpStream1);
 TmpStream1.Position :=0;
 UnZipStream(TmpStream1, Output);
 finally
 TmpStream1.Free ;
 end;
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip, sotEncryption] then begin
 TmpStream1 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 DecryptStream(Input, TmpStream1, AStreamOperateRec.EncryptKey);
 TmpStream1.Position :=0;
 UnZipStream(TmpStream1, Output);
 finally
 TmpStream1.Free ;
 end;
 end else
 if AStreamOperateRec.StreamOperateSet = [sotEncryption, sotBase64] then begin
 TmpStream1 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 DecodeBase64(Input, TmpStream1);
 TmpStream1.Position :=0;
 DecryptStream(TmpStream1, Output, AStreamOperateRec.EncryptKey);
 finally
 TmpStream1.Free ;
 end;
 end else
 if AStreamOperateRec.StreamOperateSet = [sotZip, sotEncryption, sotBase64] then begin
 TmpStream1 :=TMemoryStream.Create ;
 TmpStream2 :=TMemoryStream.Create ;
 try
 Input.Position :=0;
 DecodeBase64(Input, TmpStream1);
 TmpStream1.Position :=0;
 DecryptStream(TmpStream1, TmpStream2, AStreamOperateRec.EncryptKey);
 TmpStream2.Position :=0;
 UnZipStream(TmpStream2, Output);
 finally
 TmpStream1.Free ;
 TmpStream2.Free ;
 end;
 end;
 Output.Position :=0;
end;

{-------------------------------------------------------------------------------
 过程名: EncodeZipBase64
 说明: 将原文压缩、Base64编码后返回
 作者: 张傲翔
 日期: 2012年03月10日
 参数: s:string
 返回值: string
-------------------------------------------------------------------------------}
class function TSysCommon.EncodeZipBase64(s:string):string;
var
 InStream, OutStream:TStringStream;
 function Compression(InStream, OutStream:TStream): Boolean;
 var
 Comp:TCompressionStream;
 begin
 Comp :=TCompressionStream.Create(clDefault, OutStream);
 try
 Comp.CopyFrom(InStream, 0);
 Result :=True;
 finally
 Comp.Free ;
 end;
 end;

 function EncodeData(InStream, OutStream: TStream): Boolean;
 var
 TmpStream:TMemoryStream;
 begin
 Result :=False;
 TmpStream :=TMemoryStream.Create ;
 try
 if Compression(InStream, TmpStream) then begin
 TmpStream.Position :=0;
 self.EncodeBase64(TmpStream, OutStream);
 Result :=True;
 end;
 finally
 TmpStream.Free ;
 end;
 end;

begin
 InStream :=TStringStream.Create(s);
 OutStream :=TStringStream.Create('');
 try
 EncodeData(InStream, OutStream);
 Result :=OutStream.DataString ;
 finally
 InStream.Free ;
 OutStream.Free ;
 end;
end;
{-------------------------------------------------------------------------------
 过程名: DecodeZipBase64
 说明: 将Base64解码、解压缩后返回
 作者: 张傲翔
 日期: 2012年03月10日
 参数: s:string
 返回值: string
-------------------------------------------------------------------------------}
class function TSysCommon.DecodeZipBase64(s:string):string;
var
 InStream, OutStream:TStringStream;

 function Decompression(InStream, OutStream: TStream): Boolean;
 const
 MaxBufSize = 4096;
 var
 Buffer: array[0..MaxBufSize]of Char;
 i: Integer;
 begin
 with TDecompressionStream.Create(InStream) do
 try
 repeat
 i := Read(Buffer, MaxBufSize);
 OutStream.Write(Buffer, i);
 until i = 0;
 Result :=True;
 finally
 Free;
 end;
 end;

 function DecodeData(InStream, OutStream: TStream): Boolean;
 var
 TmpStream:TMemoryStream;
 begin
 TmpStream :=TMemoryStream.Create ;
 try
 self.DecodeBase64(InStream, TmpStream);
 TmpStream.Position :=0;
 Result :=Decompression(TmpStream, OutStream);
 finally
 TmpStream.Free ;
 end;
 end;
begin
 InStream :=TStringStream.Create(s);
 OutStream :=TStringStream.Create('');
 try
 try
 DecodeData(InStream, OutStream);
 Result :=OutStream.DataString ;
 except
 //raise ESoapCtrlException.Create(STR_DECODE_ERROR, DECODE_ERROR);
 end;
 finally
 InStream.Free ;
 OutStream.Free ;
 end;
end;
end.