Indy9的TIdFTPServer封装类

   在Delphi 7开发下有强大的Indy控件，版本为9，要实现一个FTP服务器，参考自带的例子，发现还要写很多函数，而且不支持中文显示文件列表等等。于是，自己改进封装了下，形成一个TFTPServer类，源码如下：

 

{*******************************************************}
{                                                       }
{       系统名称 FTP服务器类                            }
{       版权所有 (C) http://blog.csdn.net/akof1314      }
{       单元名称 FTPServer.pas                          }
{       单元功能 在Delphi 7下TIdFTPServer实现FTP服务器  }
{                                                       }
{*******************************************************}
unit FTPServer;

interface

uses
  Classes,  Windows,  Sysutils,  IdFTPList,  IdFTPServer,  Idtcpserver,  IdSocketHandle,  Idglobal,  IdHashCRC, IdStack;
{-------------------------------------------------------------------------------
  功能:  自定义消息，方便与窗体进行消息传递
-------------------------------------------------------------------------------}
  type
    TFtpNotifyEvent = procedure (ADatetime: TDateTime;AUserIP, AEventMessage: string) of object;
{-------------------------------------------------------------------------------
  功能:  FTP服务器类
-------------------------------------------------------------------------------}
  type
  TFTPServer = class
  private
    FUserName,FUserPassword,FBorrowDirectory: string;
    FBorrowPort: Integer;
    IdFTPServer: TIdFTPServer;
    FOnFtpNotifyEvent: TFtpNotifyEvent;
    procedure IdFTPServer1UserLogin( ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
    procedure IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
    procedure IdFTPServer1RenameFile( ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string ) ;
    procedure IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream ) ;
    procedure IdFTPServer1StoreFile( ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
    procedure IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1GetFileSize( ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64 ) ;
    procedure IdFTPServer1DeleteFile( ASender: TIdFTPServerThread; const APathname: string ) ;
    procedure IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
    procedure IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
    procedure IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
  protected
    function TransLatePath( const APathname, homeDir: string ) : string;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure Run;
    procedure Stop;
    function GetBindingIP():string;
    property UserName: string read FUserName write FUserName;
    property UserPassword: string read FUserPassword write FUserPassword;
    property BorrowDirectory: string read FBorrowDirectory write FBorrowDirectory;
    property BorrowPort: Integer read FBorrowPort write FBorrowPort;
    property OnFtpNotifyEvent: TFtpNotifyEvent read FOnFtpNotifyEvent write FOnFtpNotifyEvent;
  end;

implementation

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.Create
  功能:      创建函数
  参数:      无
  返回值:    无
-------------------------------------------------------------------------------}
constructor TFTPServer.Create;
begin
  IdFTPServer := tIdFTPServer.create( nil ) ;
  IdFTPServer.DefaultPort := 21;               //默认端口号
  IdFTPServer.AllowAnonymousLogin := False;   //是否允许匿名登录
  IdFTPServer.EmulateSystem := ftpsUNIX;
  IdFTPServer.HelpReply.text := '帮助还未实现！';
  IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
  IdFTPServer.OnGetFileSize := IdFTPServer1GetFileSize;
  IdFTPServer.OnListDirectory := IdFTPServer1ListDirectory;
  IdFTPServer.OnUserLogin := IdFTPServer1UserLogin;
  IdFTPServer.OnRenameFile := IdFTPServer1RenameFile;
  IdFTPServer.OnDeleteFile := IdFTPServer1DeleteFile;
  IdFTPServer.OnRetrieveFile := IdFTPServer1RetrieveFile;
  IdFTPServer.OnStoreFile := IdFTPServer1StoreFile;
  IdFTPServer.OnMakeDirectory := IdFTPServer1MakeDirectory;
  IdFTPServer.OnRemoveDirectory := IdFTPServer1RemoveDirectory;
  IdFTPServer.Greeting.Text.Text := '欢迎进入FTP服务器';
  IdFTPServer.Greeting.NumericCode := 220;
  IdFTPServer.OnDisconnect := IdFTPServer1DisConnect;
  with IdFTPServer.CommandHandlers.add do
  begin
    Command := 'XCRC';   //可以迅速验证所下载的文档是否和源文档一样
    OnCommand := IdFTPServer1CommandXCRC;
  end;
end;
{-------------------------------------------------------------------------------
  过程名:    CalculateCRC
  功能:      计算CRC
  参数:      const path: string
  返回值:    string
-------------------------------------------------------------------------------}
function CalculateCRC( const path: string ) : string;
var
  f: tfilestream;
  value: dword;
  IdHashCRC32: TIdHashCRC32;
begin
  IdHashCRC32 := nil;
  f := nil;
  try
    IdHashCRC32 := TIdHashCRC32.create;
    f := TFileStream.create( path, fmOpenRead or fmShareDenyWrite ) ;
    value := IdHashCRC32.HashValue( f ) ;
    result := inttohex( value, 8 ) ;
  finally
    f.free;
    IdHashCRC32.free;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1CommandXCRC
  功能:      XCRC命令
  参数:      ASender: TIdCommand
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
// note, this is made up, and not defined in any rfc.
var
  s: string;
begin
  with TIdFTPServerThread( ASender.Thread ) do
  begin
    if Authenticated then
    begin
      try
        s := ProcessPath( CurrentDir, ASender.UnparsedParams ) ;
        s := TransLatePath( s, TIdFTPServerThread( ASender.Thread ) .HomeDir ) ;
        ASender.Reply.SetReply( 213, CalculateCRC( s ) ) ;
      except
        ASender.Reply.SetReply( 500, 'file error' ) ;
      end;
    end;
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.Destroy
  功能:      析构函数
  参数:      无
  返回值:    无
-------------------------------------------------------------------------------}
destructor TFTPServer.Destroy;
begin
  IdFTPServer.free;
  inherited destroy;
end;

function StartsWith( const str, substr: string ) : boolean;
begin
  result := copy( str, 1, length( substr ) ) = substr;
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.Run
  功能:      开启服务
  参数:      无
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.Run;
begin
  IdFTPServer.DefaultPort := BorrowPort;
  IdFTPServer.Active := True;
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.Stop
  功能:      关闭服务
  参数:      无
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.Stop;
begin
  IdFTPServer.Active := False;
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.GetBindingIP
  功能:      获取绑定的IP地址
  参数:
  返回值:    string
-------------------------------------------------------------------------------}
function TFTPServer.GetBindingIP():string ;
begin
  Result := GStack.LocalAddress;
end;
{-------------------------------------------------------------------------------
  过程名:    BackSlashToSlash
  功能:      反斜杠到斜杠
  参数:      const str: string
  返回值:    string
-------------------------------------------------------------------------------}
function BackSlashToSlash( const str: string ) : string;
var
  a: dword;
begin
  result := str;
  for a := 1 to length( result ) do
    if result[a] = '/' then
      result[a] := '/';
end;

{-------------------------------------------------------------------------------
  过程名:    SlashToBackSlash
  功能:      斜杠到反斜杠
  参数:      const str: string
  返回值:    string
-------------------------------------------------------------------------------}
function SlashToBackSlash( const str: string ) : string;
var
  a: dword;
begin
  result := str;
  for a := 1 to length( result ) do
    if result[a] = '/' then
      result[a] := '/';
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.TransLatePath
  功能:      路径名称翻译
  参数:      const APathname, homeDir: string
  返回值:    string
-------------------------------------------------------------------------------}
function TFTPServer.TransLatePath( const APathname, homeDir: string ) : string;
var
  tmppath: string;
begin
  result := SlashToBackSlash(Utf8ToAnsi(homeDir) ) ;
  tmppath := SlashToBackSlash( Utf8ToAnsi(APathname) ) ;
  if homedir = '/' then
  begin
    result := tmppath;
    exit;
  end;

  if length( APathname ) = 0 then
    exit;
  if result[length( result ) ] = '/' then
    result := copy( result, 1, length( result ) - 1 ) ;
  if tmppath[1] <> '/' then
    result := result + '/';
  result := result + tmppath;
end;

{-------------------------------------------------------------------------------
  过程名:    GetNewDirectory
  功能:      得到新目录
  参数:      old, action: string
  返回值:    string
-------------------------------------------------------------------------------}
function GetNewDirectory( old, action: string ) : string;
var
  a: integer;
begin
  if action = '../' then
  begin
    if old = '/' then
    begin
      result := old;
      exit;
    end;
    a := length( old ) - 1;
    while ( old[a] <> '/' ) and ( old[a] <> '/' ) do
      dec( a ) ;
    result := copy( old, 1, a ) ;
    exit;
  end;
  if ( action[1] = '/' ) or ( action[1] = '/' ) then
    result := action
  else
    result := old + action;
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1UserLogin
  功能:      允许服务器执行一个客户端连接的用户帐户身份验证
  参数:      ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1UserLogin( ASender: TIdFTPServerThread;
  const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
begin
  AAuthenticated := ( AUsername = UserName ) and ( APassword = UserPassword ) ;
  if not AAuthenticated then
    exit;
  ASender.HomeDir := AnsiToUtf8(BorrowDirectory);
  asender.currentdir := '/';
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'用户登录服务器');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1ListDirectory
  功能:      允许服务器生成格式化的目录列表
  参数:      ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;

  procedure AddlistItem( aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime ) ;
  var
    listitem: TIdFTPListItem;
  begin
    listitem := aDirectoryListing.Add;
    listitem.ItemType := ItemType; //表示一个文件系统的属性集
    listitem.FileName := AnsiToUtf8(Filename);  //名称分配给目录中的列表项,这里防止了中文乱码
    listitem.OwnerName := 'anonymous';//代表了用户拥有的文件或目录项的名称
    listitem.GroupName := 'all';    //指定组名拥有的文件名称或目录条目
    listitem.OwnerPermissions := 'rwx'; //拥有者权限，R读W写X执行
    listitem.GroupPermissions := 'rwx'; //组拥有者权限
    listitem.UserPermissions := 'rwx';  //用户权限，基于用户和组权限
    listitem.Size := size;
    listitem.ModifiedDate := date;
  end;

var
  f: tsearchrec;
  a: integer;
begin
  ADirectoryListing.DirectoryName := apath;
  a := FindFirst( TransLatePath( apath, ASender.HomeDir ) + '*.*', faAnyFile, f ) ;
  while ( a = 0 ) do
  begin
    if ( f.Attr and faDirectory > 0 ) then
      AddlistItem( ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime( f.Time ) )
    else
      AddlistItem( ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime( f.Time ) ) ;
    a := FindNext( f ) ;
  end;

  FindClose( f ) ;
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1RenameFile
  功能:      允许服务器重命名服务器文件系统中的文件
  参数:      ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1RenameFile( ASender: TIdFTPServerThread;
  const ARenameFromFile, ARenameToFile: string ) ;
begin
  try
    if not MoveFile( pchar( TransLatePath( ARenameFromFile, ASender.HomeDir ) ) , pchar( TransLatePath( ARenameToFile, ASender.HomeDir ) ) ) then
      RaiseLastOSError;
  except
    on e:Exception do
    begin
      if Assigned(FOnFtpNotifyEvent) then
        OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'重命名文件[' + Utf8ToAnsi(ARenameFromFile) + ']失败，原因是' + e.Message);
      Exit;
    end;
  end;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'重命名文件[' + Utf8ToAnsi(ARenameFromFile) + ']为[' + Utf8ToAnsi(ARenameToFile) + ']');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1RetrieveFile
  功能:      允许从服务器下载文件系统中的文件
  参数:      ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread;
  const AFilename: string; var VStream: TStream ) ;
begin
  VStream := TFileStream.Create( translatepath( AFilename, ASender.HomeDir ) , fmopenread or fmShareDenyWrite ) ;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'下载文件[' + Utf8ToAnsi(AFilename) + ']');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1StoreFile
  功能:      允许在服务器上传文件系统中的文件
  参数:      ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1StoreFile( ASender: TIdFTPServerThread;
  const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
begin
  if FileExists( translatepath( AFilename, ASender.HomeDir ) ) and AAppend then
  begin
    VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmOpenWrite or fmShareExclusive ) ;
    VStream.Seek( 0, soFromEnd ) ;
  end
  else
    VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmCreate or fmShareExclusive ) ;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'上传文件[' + Utf8ToAnsi(AFilename) + ']');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1RemoveDirectory
  功能:      允许服务器在服务器删除文件系统的目录
  参数:      ASender: TIdFTPServerThread; var VDirectory: string
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread;
  var VDirectory: string ) ;
begin
  try
    RmDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
  except
    on e:Exception do
    begin
      if Assigned(FOnFtpNotifyEvent) then
        OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除目录[' + Utf8ToAnsi(VDirectory) + ']失败，原因是' + e.Message);
      Exit;
    end;
  end;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除目录[' + Utf8ToAnsi(VDirectory) + ']');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1MakeDirectory
  功能:      允许服务器从服务器中创建一个新的子目录
  参数:      ASender: TIdFTPServerThread; var VDirectory: string
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread;
  var VDirectory: string ) ;
begin
  try
    MkDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
  except
    on e:Exception do
    begin
      if Assigned(FOnFtpNotifyEvent) then
        OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'创建目录[' + Utf8ToAnsi(VDirectory) + ']失败，原因是' + e.Message);
      Exit;
    end;
  end;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'创建目录[' + Utf8ToAnsi(VDirectory) + ']');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1GetFileSize
  功能:      允许服务器检索在服务器文件系统的文件的大小
  参数:      ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1GetFileSize( ASender: TIdFTPServerThread;
  const AFilename: string; var VFileSize: Int64 ) ;
begin
  VFileSize := FileSizeByName( TransLatePath( AFilename, ASender.HomeDir ) ) ;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'获取文件大小');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1DeleteFile
  功能:      允许从服务器中删除的文件系统中的文件
  参数:      ASender: TIdFTPServerThread; const APathname: string
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1DeleteFile( ASender: TIdFTPServerThread;
  const APathname: string ) ;
begin
  try
    DeleteFile( pchar( TransLatePath( ASender.CurrentDir + '/' + APathname, ASender.HomeDir ) ) ) ;
  except
    on e:Exception do
    begin
      if Assigned(FOnFtpNotifyEvent) then
        OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除文件[' + Utf8ToAnsi(APathname) + ']失败，原因是' + e.Message);
      Exit;
    end;
  end;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除文件[' + Utf8ToAnsi(APathname) + ']');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1ChangeDirectory
  功能:      允许服务器选择一个文件系统路径
  参数:      ASender: TIdFTPServerThread; var VDirectory: string
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread;
  var VDirectory: string ) ;
begin
  VDirectory := GetNewDirectory( ASender.CurrentDir, VDirectory ) ;
  if Assigned(FOnFtpNotifyEvent) then
    OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'进入目录[' + Utf8ToAnsi(VDirectory) + ']');
end;

{-------------------------------------------------------------------------------
  过程名:    TFTPServer.IdFTPServer1DisConnect
  功能:      失去网络连接
  参数:      AThread: TIdPeerThread
  返回值:    无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
begin
  //  nothing much here
end;
end.

 

使用工程示例：

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, FTPServer; 
 
type 
  TForm1 = class(TForm) 
    btn1: TButton; 
    btn2: TButton; 
    edt_BorrowDirectory: TEdit; 
    lbl1: TLabel; 
    mmo1: TMemo; 
    lbl2: TLabel; 
    edt_BorrowPort: TEdit; 
    lbl3: TLabel; 
    edt_UserName: TEdit; 
    lbl4: TLabel; 
    edt_UserPassword: TEdit; 
    procedure btn1Click(Sender: TObject); 
    procedure btn2Click(Sender: TObject); 
    procedure TFTPServer1FtpNotifyEvent(ADatetime: TDateTime;AUserIP, AEventMessage: string); 
  private 
    FFtpServer: TFTPServer; 
  public 
    { Public declarations } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
 
 
{$R *.dfm} 
 
procedure TForm1.btn1Click(Sender: TObject); 
begin 
  if not Assigned(FFtpServer) then 
  begin 
    FFtpServer := TFTPServer.Create; 
    FFtpServer.UserName := Trim(edt_UserName.Text); 
    FFtpServer.UserPassword := Trim(edt_UserPassword.Text); 
    FFtpServer.BorrowDirectory := Trim(edt_BorrowDirectory.Text); 
    FFtpServer.BorrowPort := StrToInt(Trim(edt_BorrowPort.Text)); 
    FFtpServer.OnFtpNotifyEvent := TFTPServer1FtpNotifyEvent; 
    FFtpServer.Run; 
    mmo1.Lines.Add(DateTimeToStr(Now) + #32 +'FTP服务器已开启，本机IP地址：' + FFtpServer.GetBindingIP); 
  end; 
end; 
 
procedure TForm1.btn2Click(Sender: TObject); 
begin 
  if Assigned(FFtpServer) then 
  begin 
    FFtpServer.Stop; 
    FreeAndNil(FFtpServer); 
    mmo1.Lines.Add(DateTimeToStr(Now) + #32 +'FTP服务器已关闭'); 
  end; 
end; 
 
procedure TForm1.TFTPServer1FtpNotifyEvent(ADatetime: TDateTime;AUserIP, AEventMessage: string); 
begin 
  mmo1.Lines.Add(DateTimeToStr(ADatetime) + #32 + AUserIP + #32 + AEventMessage); 
  SendMessage(mmo1.Handle,WM_VSCROLL,SB_PAGEDOWN,0); 
end; 
end. 

结果如下图所示：

示例工程源码下载：http://download.csdn.net/source/3236325

 

http://blog.csdn.net/akof1314/article/details/6371984#comments