{*******************************************************}
{       系统常用公共方法                                }
{       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.