ACTIVEX实现大文件FTP上传下载---上

ACTIVEX实现大文件FTP上传

 

      在Windows 操作系统下，有一个重要的机制，就是OLE ，就是可以让某个应用程序（OLE Controller）访问其它应用程序（OLE Server）所提供的功能，这样做的好处是，如果已经有了完成某项功能的程序，你就不必再为某项功能编写特定的应用程序，可以直接通过OLE 调用。

      现在的ActiveX 控件等价与以前的OLE控件或OCX，一个典型的控件包括设计时和运行时的用户界面，唯一的IDispatch接口定义了控件的属性和方法，唯一的 IConnectionPoint接口定义控件可引发的事件。一个控件可以在容器中运行，所以从运行的角度看它类似与一个DLL。
      尽管 ActiveX 和 OLE 都基于组建对象模型(Component Object Model，COM)，它们为程序员提供的却是截然不同的服务。COM提供的是低级的对象捆绑机制，该机制支持对象之间的交互通讯。OLE使用COM来提供低级的应用服务，例如采用连接和嵌入机制，支持用户创建复合文档。与之不同，ActiveX提供更精细的结构，用以支持在网络站点上嵌入控件，以及对事件的交互反应。优化ActiveX，目的是为了提高时间和空间效率，而优化OLE，是为了便于终端用户的使用和集成台式系统的应用程序。ActiveX还为Internet技术带来了一些技术上的变革，例如，ActiveX大大减小了代码量(代码量减少了百分之五十到七十)，支持更多的提交和异步连接。
　　ActiveX的基础是OLE和COM，但是通过MS的各种开发工具可以屏蔽掉COM模型中许多另人费解的技术细节。ActiveX组件技术包括以下一些方面：(1)自动化服务器 (2)自动化控制器 (3)控件 (4)COM对象 (5)文档 (6)容器 。
　　以.ocx为后缀名的ActiveX控件主要应用在WEB上和Window Forms程序开发上。应用程序使用ActiveX/COM组件来扩展自身的业务逻辑、事务处理和应用服务的范围。

      通俗地讲ACTIVEX可用DELPHI/VB/VC等其中之一开发制作，但调用时可不必拘泥于各自调用。比如你用DELPHI写了一个ACTIVEX，可被DELPHI/VB/VC等开发调用，反之亦然。

      一、 制作用Web 调用的ActiveX

首先设置一个虚拟目录，定名为Delphi

1）进入Delphi，Close all
2）New -> Other -> ActiveX -> ActiveX Form ->Name: MyActiveX
OK
3）出现一个普通的Form界面，放入
TIdFTP

TListView
.......

控件，设计目标是，制作大文件ftp上传下载客户端。
4）Save all 到虚拟目录的 ActiveX/Ac2/ 子目录下。
5）代码如下：

unit MyFtpActiveFormImpl1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, MyFtpActiveFormProj1_TLB, StdVcl, Menus,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,   IdFTPList,
  ImgList, StdCtrls,  ExtCtrls, Buttons, ComCtrls, FileCtrl;

type
  TMyFtpActiveFormX = class(TActiveForm, IMyFtpActiveFormX)
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    GroupBox2: TGroupBox;
    ListViewRemoteFile: TListView;
    GroupBox4: TGroupBox;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    EditHostAddress: TEdit;
    EditPort: TEdit;
    EditUsername: TEdit;
    EditPassword: TEdit;
    LinkServer: TBitBtn;
    GroupBox3: TGroupBox;
    MemoMessage: TMemo;
    GroupBox6: TGroupBox;
    Panel2: TPanel;
    DriveComboBox1: TDriveComboBox;
    ListViewLocalFile: TListView;
    ListViewSendFile: TListView;
    ImageList1: TImageList;
    FTPCLIENT: TIdFTP;
    PopupMenuLocal: TPopupMenu;
    UploadFile: TMenuItem;
    N3: TMenuItem;
    LocalCreateDirectory: TMenuItem;
    LocalDeleteFile: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    BigIcon: TMenuItem;
    SmallIcon: TMenuItem;
    List: TMenuItem;
    Detail: TMenuItem;
    PopupMenuRemote: TPopupMenu;
    DownloadFile: TMenuItem;
    N8: TMenuItem;
    RemoteRenameFile: TMenuItem;
    RemoteDeleteFile: TMenuItem;
    N4: TMenuItem;
    RemoteCreateDirectory: TMenuItem;
    procedure DriveComboBox1Change(Sender: TObject);
    procedure ListViewLocalFileDblClick(Sender: TObject);
    procedure LinkServerClick(Sender: TObject);
    procedure ListViewRemoteFileDblClick(Sender: TObject);
    procedure BigIconClick(Sender: TObject);
    procedure SmallIconClick(Sender: TObject);
    procedure ListClick(Sender: TObject);
    procedure DetailClick(Sender: TObject);
    procedure ListViewLocalFileContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure UploadFileClick(Sender: TObject);
    procedure ListViewRemoteFileContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure DownloadFileClick(Sender: TObject);
    procedure RemoteCreateDirectoryClick(Sender: TObject);
    procedure RemoteDeleteFileClick(Sender: TObject);
    procedure LocalCreateDirectoryClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure LocalDeleteFileClick(Sender: TObject);
    procedure RemoteRenameFileClick(Sender: TObject);
  private
    FEvents: IMyFtpActiveFormXEvents;
   procedure DisplayLocalFileList();
    procedure DisplayRemoteFileList();

    { Private declarations }
     procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function Get_Active: WordBool; safecall;
    function Get_AlignDisabled: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AutoSize: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: OLE_COLOR; safecall;
    function Get_DoubleBuffered: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: IFontDisp; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_ScreenSnap: WordBool; safecall;
    function Get_SnapBuffer: Integer; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_VisibleDockClientCount: Integer; safecall;
    procedure _Set_Font(var Value: IFontDisp); safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AutoSize(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: OLE_COLOR); safecall;
    procedure Set_DoubleBuffered(Value: WordBool); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_ScreenSnap(Value: WordBool); safecall;
    procedure Set_SnapBuffer(Value: Integer); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
  public
    { Public declarations }
    IsTransferring : Boolean;   //是否正在传送文件
    LocalPath: string;          //当前本地路径
    RemotePath: string;         //当前服务器路径
   procedure Initialize; override;
  end;

implementation

uses ComObj, ComServ;

{$R *.DFM}

{ TMyFtpActiveFormX }

procedure TMyFtpActiveFormX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_MyFtpActiveFormXPage); }
end;

procedure TMyFtpActiveFormX.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IMyFtpActiveFormXEvents;
  inherited EventSinkChanged(EventSink);
end;

procedure TMyFtpActiveFormX.Initialize;
begin
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function TMyFtpActiveFormX.Get_Active: WordBool;
begin
  Result := Active;
end;

function TMyFtpActiveFormX.Get_AlignDisabled: WordBool;
begin
  Result := AlignDisabled;
end;

function TMyFtpActiveFormX.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;

function TMyFtpActiveFormX.Get_AutoSize: WordBool;
begin
  Result := AutoSize;
end;

function TMyFtpActiveFormX.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;

function TMyFtpActiveFormX.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;

function TMyFtpActiveFormX.Get_Color: OLE_COLOR;
begin
  Result := OLE_COLOR(Color);
end;

function TMyFtpActiveFormX.Get_DoubleBuffered: WordBool;
begin
  Result := DoubleBuffered;
end;

function TMyFtpActiveFormX.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;

function TMyFtpActiveFormX.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;

function TMyFtpActiveFormX.Get_Font: IFontDisp;
begin
  GetOleFont(Font, Result);
end;

function TMyFtpActiveFormX.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;

function TMyFtpActiveFormX.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;

function TMyFtpActiveFormX.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;

function TMyFtpActiveFormX.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;

function TMyFtpActiveFormX.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;

function TMyFtpActiveFormX.Get_ScreenSnap: WordBool;
begin
  Result := ScreenSnap;
end;

function TMyFtpActiveFormX.Get_SnapBuffer: Integer;
begin
  Result := SnapBuffer;
end;

function TMyFtpActiveFormX.Get_Visible: WordBool;
begin
  Result := Visible;
end;

function TMyFtpActiveFormX.Get_VisibleDockClientCount: Integer;
begin
  Result := VisibleDockClientCount;
end;

procedure TMyFtpActiveFormX._Set_Font(var Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure TMyFtpActiveFormX.ActivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnActivate;
end;

procedure TMyFtpActiveFormX.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure TMyFtpActiveFormX.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure TMyFtpActiveFormX.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TMyFtpActiveFormX.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TMyFtpActiveFormX.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TMyFtpActiveFormX.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure TMyFtpActiveFormX.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

procedure TMyFtpActiveFormX.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;

procedure TMyFtpActiveFormX.Set_AutoSize(Value: WordBool);
begin
  AutoSize := Value;
end;

procedure TMyFtpActiveFormX.Set_AxBorderStyle(
  Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TMyFtpActiveFormX.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;

procedure TMyFtpActiveFormX.Set_Color(Value: OLE_COLOR);
begin
  Color := TColor(Value);
end;

procedure TMyFtpActiveFormX.Set_DoubleBuffered(Value: WordBool);
begin
  DoubleBuffered := Value;
end;

procedure TMyFtpActiveFormX.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;

procedure TMyFtpActiveFormX.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;

procedure TMyFtpActiveFormX.Set_Font(const Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure TMyFtpActiveFormX.Set_HelpFile(const Value: WideString);
begin
  HelpFile := String(Value);
end;

procedure TMyFtpActiveFormX.Set_KeyPreview(Value: WordBool);
begin
  KeyPreview := Value;
end;

procedure TMyFtpActiveFormX.Set_PixelsPerInch(Value: Integer);
begin
  PixelsPerInch := Value;
end;

procedure TMyFtpActiveFormX.Set_PrintScale(Value: TxPrintScale);
begin
  PrintScale := TPrintScale(Value);
end;

procedure TMyFtpActiveFormX.Set_Scaled(Value: WordBool);
begin
  Scaled := Value;
end;

procedure TMyFtpActiveFormX.Set_ScreenSnap(Value: WordBool);
begin
  ScreenSnap := Value;
end;

procedure TMyFtpActiveFormX.Set_SnapBuffer(Value: Integer);
begin
  SnapBuffer := Value;
end;

procedure TMyFtpActiveFormX.Set_Visible(Value: WordBool);
begin
  Visible := Value;
end;

//显示本地文件列表
procedure TMyFtpActiveFormX.DisplayLocalFileList();
var
  sr: TSearchRec; 
  Item : TListItem;
begin
  SetCurrentDir(LocalPath);  //设置当前路径
  ListViewLocalFile.Clear;  //清空本地文件列表
  if Length(LocalPath)>3 then //不是根目录
  begin
    //填加上级目录项目
    Item:=ListViewLocalFile.Items.Add;
    Item.ImageIndex:=0;
    Item.Caption:='..';
    Item.SubItems.Add('上级目录');
    Item.SubItems.Add('');
    Item.SubItems.Add('');
  end;
  //填加文件夹
  if FindFirst('*', faDirectory, sr) = 0 then
  begin
    repeat
      if ((sr.Attr and faDirectory) = sr.Attr) and (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        Item:=ListViewLocalFile.Items.Add;
        Item.ImageIndex:=0;    //图标序号
        Item.Caption:=sr.Name;       //文件夹名
        Item.SubItems.Add('文件夹');
        Item.SubItems.Add('');
        Item.SubItems.Add(DateTimeToStr(FileDateToDateTime(sr.Time)));      //时间
      end;
    until FindNext(sr) <> 0;  //下一个
    FindClose(sr);   //结束查找
  end;
  //填加文件
  if FindFirst('*', faArchive, sr) = 0 then
  begin
    repeat
      Item:=ListViewLocalFile.Items.Add;
      Item.ImageIndex:=1;      //图标序号
      Item.Caption:=sr.Name;  //文件名
      Item.SubItems.Add('');
      Item.SubItems.Add(IntToStr(sr.Size));  //文件大小
      Item.SubItems.Add(DateTimeToStr(FileDateToDateTime(sr.Time)));  //时间
    until FindNext(sr) <> 0;    //下一个
    FindClose(sr);  //结束查找
  end;
end;

//显示远程文件列表
procedure TMyFtpActiveFormX.DisplayRemoteFileList();
Var
  LS: TStringList;
  FileCount : Integer;
  newItem : TListItem;
begin
 LS := TStringList.Create;
 try
    FTPClient.ChangeDir(RemotePath);  //设置FTP服务器当前目录
    ListViewRemoteFile.Items.Clear;  //清空远程文件列表

    FTPClient.List(LS);    //得到文件和目录列表
    //处理LS的每个项目
    for FileCount:=0 to LS.Count - 1 do
    begin
      //是目录吗？
      if FTPClient.DirectoryListing.Items[FileCount].ItemType = ditDirectory then
      begin
        //添加目录项目
        newItem := ListViewRemoteFile.Items.Insert(0);
        newItem.ImageIndex := 0;   //图标序号
        newItem.subItems.Add('文件夹');
      end
      else
      begin
        //添加文件项目
        newItem := ListViewRemoteFile.Items.Add;
        newItem.ImageIndex := 1;     //图标序号
        newItem.subItems.Add('');
      end ;
      newItem.Caption := FTPClient.DirectoryListing.Items[FileCount].FileName;   //文件名
      newItem.subItems.Add(IntToStr(FTPClient.DirectoryListing.Items[FileCount].Size));  //文件大小
      newItem.subItems.Add(DateTimeToStr(FTPClient.DirectoryListing.Items[FileCount].ModifiedDate)); //时间
    end;
    if Length(RemotePath)>1 then  //不是根目录
    begin
      //填加上级目录项目
      newItem:=ListViewRemoteFile.Items.Insert(0);
      newItem.ImageIndex:=0;  //图标序号
      newItem.Caption:='..';
      newItem.SubItems.Add('上级目录');
      newItem.SubItems.Add('');
      newItem.SubItems.Add('');
    end;
  finally
    LS.Free;   //释放TStringList
  end;
end;

//本地驱动器选择
procedure TMyFtpActiveFormX.DriveComboBox1Change(Sender: TObject);
begin
  LocalPath:= DriveComboBox1.Drive+':/';   //本地路径
  DisplayLocalFileList();   //刷新本地文件列表
end;

//本地文件列表双击事件
procedure TMyFtpActiveFormX.ListViewLocalFileDblClick(Sender: TObject);
var
  TmpFileName : String;
begin
  if ListViewLocalFile.Selected = nil then  //  没有选择列表项目
    Exit;
  TmpFileName :=ListViewLocalFile.Selected.Caption;  // 得到文件名
  if ListViewLocalFile.Selected.SubItems[0] = '上级目录' then  //是上级目录吗？
  begin
    LocalPath:=LocalPath+'.txt';
    LocalPath:=ExtractFileDir(LocalPath);  //得到上级目录完整路径
    DisplayLocalFileList();                //刷新本地文件列表
  end
  else if ListViewLocalFile.Selected.SubItems[0] = '文件夹' then     //是文件夹吗？
       begin
         if Length(LocalPath)=3 then                //是根目录吗？
           LocalPath := LocalPath + TmpFileName
         else
           LocalPath := LocalPath + '/' + TmpFileName;
         DisplayLocalFileList();       //刷新本地文件列表
       end
       else   //是文件，上传文件
       begin
         if not FTPClient.Connected Then  //和服务器建立连接否？
           Exit;
         if MessageDlg('是否上传该文件？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
           UploadFileClick(Sender);     //上传文件
       end;
end;

//连接到服务器
procedure TMyFtpActiveFormX.LinkServerClick(Sender: TObject);
begin
  if FTPClient.Connected then  //已经建立了连接吗？
  begin
    if MessageDlg('断开当前连接吗？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      try
        if IsTransferring then      //正在传送文件吗？
          FTPClient.Abort;   // 断开连接
        FTPClient.Quit;  //退出连接
      Except
        ShowMessage('正在传送文件，请稍候！');
      end;
    end
    else
      exit;  //退出本过程
  end;
  try
     //连接服务器属性设置
    FTPClient.Host:=EditHostAddress.Text;
    FTPClient.Port:=StrToInt(EditPort.Text);
    FTPClient.UserName:=EditUserName.Text;
    FTPClient.Password:=EditPassWord.Text;
    FTPClient.Connect;   //连接
    MemoMessage.Lines.AddStrings(FTPClient.LoginMsg.Text);
    //服务器路径初始化
    RemotePath:='/';
   //刷新服务器文件列表
    DisplayRemoteFileList();
  except
    MessageDlg('不能和服务器建立连接！',mtError, [mbYes],0);
  end;
end;

//服务器文件列表双击事件
procedure TMyFtpActiveFormX.ListViewRemoteFileDblClick(Sender: TObject);
var
  FileName : String;
begin
  if not FTPClient.Connected Then  //没有连接到服务器，退出
    Exit;
  if ListViewRemoteFile.Selected = nil then  //没有选中文件，退出
    Exit;
  FileName := ListViewRemoteFile.Selected.Caption;    //文件名
  if ListViewRemoteFile.Selected.SubItems[0] = '上级目录' then  //是上级目录吗？
  begin
    FTPClient.ChangeDirUp;  //到上级目录
    RemotePath:= FtpClient.RetrieveCurrentDir;   //FTP服务器的当前目录名称
    DisplayRemoteFileList();  //刷新服务器文件列表
  end
  else if ListViewRemoteFile.Selected.SubItems[0]='文件夹' then
       begin
         RemotePath := RemotePath+'/'+FileName;      //下级目录名称
        //刷新服务器文件列表
         DisplayRemoteFileList();
       end
       else
       if MessageDlg('是否下载该文件？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
         DownloadFileClick(Sender);    //下载文件
end;

procedure TMyFtpActiveFormX.BigIconClick(Sender: TObject);
begin
  ListViewLocalFile.ViewStyle:=vsIcon;
end;

procedure TMyFtpActiveFormX.SmallIconClick(Sender: TObject);
begin
  ListViewLocalFile.ViewStyle:=vsSmallIcon;
end;

procedure TMyFtpActiveFormX.ListClick(Sender: TObject);
begin
  ListViewLocalFile.ViewStyle:=vsList;
end;

procedure TMyFtpActiveFormX.DetailClick(Sender: TObject);
begin
  ListViewLocalFile.ViewStyle:=vsReport;
end;

procedure TMyFtpActiveFormX.ListViewLocalFileContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
  if ListViewLocalFile.Selected = nil then    //没有选中项目
  begin
    //设置弹出菜单是否可用
    LocalDeleteFile.Enabled:=False;
    LocalCreateDirectory.Enabled:=true;
    BigIcon.Enabled:=true;
    SmallIcon.Enabled:=true;
    List.Enabled:=True;
    Detail.Enabled:=True;
    UpLoadFile.Enabled:=False;
  end
  else begin
    //设置弹出菜单是否可用
    LocalCreateDirectory.Enabled:=False;
    BigIcon.Enabled:=False;
    SmallIcon.Enabled:=False;
    List.Enabled:=False;
    Detail.Enabled:=False;
    if ListViewLocalFile.Selected.SubItems[0] <> '' then   //是否选中文件？
    begin
      UpLoadFile.Enabled:=False;
      LocalDeleteFile.Enabled:=False;
    end
    else
    begin
      UpLoadFile.Enabled:=True;
      LocalDeleteFile.Enabled:=True;
    end;
  end;
end;

//上传文件
procedure TMyFtpActiveFormX.UploadFileClick(Sender: TObject);
var
  FileName : String;
  Item : TListItem;
  SendFileItem : TListItem;
begin
  if not FTPClient.Connected Then      //没有连接到服务器，退出
    Exit;
  if ListViewLocalFile.Selected = nil then   //没有选中文件，退出
    Exit;
  Item := ListViewLocalFile.Selected;      //得到选中的文件
  ListViewSendFile.Clear;        //清空要传送的文件列表
  //处理所有选中文件
  while Item <> nil do
  begin
    //列表项赋值
    SendFileItem := ListViewSendFile.Items.Add;   //增加到列表
    SendFileItem.Caption := Item.Caption;   //文件名
    SendFileItem.SubItems.Add(Item.SubItems[1]);  //文件大小
    SendFileItem.SubItems.Add(LocaLPath);   //本地路径
    SendFileItem.SubItems.Add('==>');       //图示
    SendFileItem.SubItems.Add(RemotePath);  //远程路径
    SendFileItem.SubItems.Add('');        //状态
    Item:=ListViewLocalFile.GetNextItem(Item,sdAll, [isSelected]);   //下一个选中的项目
  end;
  ListViewSendFile.Refresh;     //刷新传送文件列表

  //传送文件
  ListViewLocalFile.Enabled:=false;   //禁止操作相关控件
  DriveComboBox1.Enabled:=false;
  ListViewRemoteFile.Enabled:=False;
  IsTransferring:=True;          //设置正在传送
  try
    //处理所有要传送的文件
    while ListViewSendFile.Items.Count > 0 do
    begin
      FileName:=ListViewSendFile.Items[0].Caption;       //文件名
      ListViewSendFile.Items[0].SubItems[4]:='正在上传...';
      FTPClient.Put(LocalPath+'/'+FileName, FileName);  //上传
      DisplayRemoteFileList();
      ListViewSendFile.items[0].Delete;   //传送完毕，删除待传文件列表
      ListViewSendFile.Refresh;;
    end;
    //设置相关控件是否可用
    ListViewLocalFile.Enabled:=True;
    DriveComboBox1.Enabled:=True;
    ListViewRemoteFile.Enabled:=True;
    IsTransferring:=False;   //没有传送状态
  except
    ListViewSendFile.Items[0].SubItems[4]:='上传错误';
    MessageDlg('上传文件发生错误！',mtError, [mbYes],0);
    //设置相关控件是否可用
    ListViewLocalFile.Enabled:=True;
    DriveComboBox1.Enabled:=True;
    ListViewRemoteFile.Enabled:=True;
    IsTransferring:=False;   //没有传送状态
  end;
end;

procedure TMyFtpActiveFormX.ListViewRemoteFileContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
  if ListViewRemoteFile.Selected = nil then   //没有选中项目
  begin
    //设置弹出菜单是否可用
    RemoteCreateDirectory.Enabled:=True;
    DownLoadFile.Enabled:=False;
    RemoteRenameFile.Enabled:=False;
    RemoteDeleteFile.Enabled:=False;
  end
  else
  begin
    //设置弹出菜单是否可用
    RemoteCreateDirectory.Enabled:=False;
    RemoteRenameFile.Enabled:=true;
    RemoteDeleteFile.Enabled:=True;
    if ListViewRemoteFile.Selected.SubItems[0] <> '' then      //是否选中文件？
    begin
      DownLoadFile.Enabled:=False;
      RemoteRenameFile.Enabled:=False;
    end
    else
    begin
      downloadFile.Enabled:=True;
      if ListViewRemoteFile.SelCount=1 then
        RemoteRenameFile.Enabled:=True
      else
        RemoteRenameFile.Enabled:=False;
    end;
  end;
end;

procedure TMyFtpActiveFormX.DownloadFileClick(Sender: TObject);
var
  FileName : String;
  Item ,  SendFileItem : TListItem;
begin
  if not FTPClient.Connected Then  //没有连接到服务器，退出
    Exit;
  if ListViewRemoteFile.Selected = nil then  //没有选中文件，退出
    Exit;
  Item := ListViewRemoteFile.Selected;  //得到选中的文件
  ListViewSendFile.Clear;  //清空要传送的文件列表
  //处理所有选中文件
  while Item <> nil do
  begin
    SendFileItem := ListViewSendFile.Items.Add;  //增加到列表
    //列表项赋值
    SendFileItem.Caption := Item.Caption;  //文件名
    SendFileItem.SubItems.Add(Item.SubItems[1]);  //文件大小
    SendFileItem.SubItems.Add(LocaLPath); //本地路径
    SendFileItem.SubItems.Add('<==');     //图示
    SendFileItem.SubItems.Add(RemotePath);  //远程路径
    SendFileItem.SubItems.Add('');        //状态
    Item:=ListViewRemoteFile.GetNextItem(Item,sdAll, [isSelected]);      //下一个选中的项目
  end;
  ListViewSendFile.Refresh;    //刷新传送文件列表

  //传送文件
  ListViewRemoteFile.Enabled:=false;  //禁止操作相关控件
  IsTransferring:=True;       //设置正在传送
  try
    //处理所有要传送的文件
    while ListViewSendFile.Items.Count > 0 do
    begin
      FileName:=ListViewSendFile.Items[0].Caption;     //文件名
      ListViewSendFile.Items[0].SubItems[4]:='正在下载...';
      ListViewSendFile.Refresh;       //刷新传送文件列表
      if FileExists(FileName) then   //判断文件是否存在
      begin
        if MessageDlg('文件已存在，继续下载吗？', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
          FTPClient.Get(FileName, LocalPath+'/'+FileName,false, true)  //续传
        else
          FTPClient.Get(FileName, LocalPath+'/'+FileName, true,False);  //覆盖
      end
      else
        FTPClient.Get(FileName, LocalPath+'/'+FileName, false);      //下载
      ListViewSendFile.items[0].Delete;   //传送完毕，删除待传文件列表
      ListViewSendFile.Refresh;    //刷新待传文件列表
      DisplayLocalFileList();      //刷新本地文件列表
    end;
    ListViewRemoteFile.Enabled:=True;
    IsTransferring:=False;    //没有传送状态
  except
    ListViewSendFile.Items[0].SubItems[4]:='下载错误';
    ListViewSendFile.Refresh;    //刷新待传文件列表
    MessageDlg('下载文件发生错误！',mtError, [mbYes],0);
    ListViewRemoteFile.Enabled:=True;
    IsTransferring:=False;      //没有传送状态
  end;
end;

procedure TMyFtpActiveFormX.RemoteCreateDirectoryClick(Sender: TObject);
var
  NewDirectory : String;
begin
  if not FTPClient.Connected then    //没有和服务器建立连接，退出
    exit;
  NewDirectory:= '新建文件夹';
  if InputQuery('新建服务器文件夹', '文件夹名字：', NewDirectory)=TRUE then    //提示输入新文件夹名
    if NewDirectory <> '' then
      try
        FTPClient.MakeDir(NewDirectory);    //创建新文件夹
        DisplayRemoteFileList();           //刷新服务器文件列表
      except
        MessageDlg('新建服务器文件夹发生错误！',mtError, [mbYes],0);   //出错提示信息
      end
    else
      MessageDlg('文件夹名称不能为空！',mtError, [mbYes],0);   //出错提示信息
end;

procedure TMyFtpActiveFormX.RemoteDeleteFileClick(Sender: TObject);
Var
  Item : TListItem;
begin
  if not FTPClient.Connected then  //没有建立连接，退出
    exit;
  if ListViewRemoteFile.Selected = nil then    //没有选中文件，退出
    exit;
  if MessageDlg('确认删除这些文件？', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
  begin
    Item := ListViewRemoteFile.Selected;  //选择的文件
    //    处理所有选中的文件
    while Item <> nil do
    begin
      if  Item.SubItems[0] = '文件夹' then  //是文件夹，删除文件夹
        FTPClient.RemoveDir(Item.Caption);
      if  Item.SubItems[0] = '' then       //是文件，删除文件
        FtpClient.Delete(Item.Caption);
      Item:=ListViewRemoteFile.GetNextItem(Item,sdAll, [isSelected]);  //得到下一个选中的文件
    end;
    DisplayRemoteFileList();   //刷新服务器文件列表
  end;
end;

procedure TMyFtpActiveFormX.LocalCreateDirectoryClick(Sender: TObject);
var
  NewDirectory : String;      //临时文件夹名
begin
  NewDirectory:= '新建文件夹';
  if InputQuery('新建本地文件夹', '文件夹名字：', NewDirectory)=TRUE then     //提示输入新文件夹名
    if NewDirectory <> '' then
      try
        CreateDir(NewDirectory);         //在当前路径创建新文件夹
        DisplayLocalFileList();          //刷新列表
      except
        MessageDlg('新建本地文件夹发生错误！',mtError, [mbYes],0);   //出错提示信息
      end
    else
      MessageDlg('文件夹名称不能为空！',mtError, [mbYes],0);   //出错提示信息
end;

procedure TMyFtpActiveFormX.FormShow(Sender: TObject);
begin
  //初始化变量
  IsTransferring :=False;   //未传送文件状态
end;

procedure TMyFtpActiveFormX.LocalDeleteFileClick(Sender: TObject);
var
  Item : TListItem;
begin
  if ListViewLocalFile.Selected = nil then  // 没有选择文件，退出
    Exit;
  if MessageDlg('确认删除这些文件？', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
  begin
    Item := ListViewLocalFile.Selected;  //选择的文件
    //    处理所有选中的文件
    while Item <> nil do
    begin
      DeleteFile(LocalPath+'/'+Item.Caption);   //删除该文件
      Item:=ListViewLocalFile.GetNextItem(Item,sdAll, [isSelected]);  //得到下一个选中的文件
    end;
    DisplayLocalFileList();   //刷新本地文件列表
  end;
end;

procedure TMyFtpActiveFormX.RemoteRenameFileClick(Sender: TObject);
var
  NewFileName : String;
begin
  if not FTPClient.Connected then    //没有和服务器建立连接，退出
    exit;
  NewFileName:= ListViewRemoteFile.Selected.Caption;
  if InputQuery('重命名', '新文件名：', NewFileName)=TRUE then    //提示输入新文件名
    if NewFileName <> '' then
      try
        FTPClient.Rename(ListViewRemoteFile.Selected.Caption,NewFileName);    //重命名
        DisplayRemoteFileList();           //刷新服务器文件列表
      except
        MessageDlg('重命名文件发生错误！',mtError, [mbYes],0);   //出错提示信息
      end
    else
      MessageDlg('文件名称不能为空！',mtError, [mbYes],0);   //出错提示信息
end;

 

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TMyFtpActiveFormX,
    Class_MyFtpActiveFormX,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.

6）这就完成了，保存。

7）Porject ->Build All 编译

8）Porject -〉Web Deployment Options 设置分发参数
第一项：OCX保存的目录 （虚拟目录/ActiveX/ac2/）
第二项：OCX保存在哪个相对路径中
（http://127.0.0.1/delphi/ActiveX/ac2/）
第三项：Delphi产生的HTML 保存路径（虚拟目录/ActiveX/ac2/）
Ok
9）产生嵌入ActiveXForm的HTML文件
Porject -〉Web Deploy

现在保存这个工程然后退出
10)注册OCX

从dos命令窗口键入regsvr32 C:/apache-tomcat-5.5.28/webapps/AppletTest/MyFtpActiveFormProj1.ocx

观察效果

打开IE浏览器， 把网址写为：http://127.0.0.1/delphi/activex/ac2/
就可以看到下面的文件列表：

[To Parent Directory]
2000年5月27日 9:10 750 MyFtpActiveFormImpl1.~dfm
2000年5月27日 9:11 9160 MyFtpActiveFormImpl1.~pas
2000年5月27日 9:31 16936 MyFtpActiveFormImpl1.dcu
2000年5月27日 9:16 51 MyFtpActiveFormImpl1.ddp
2000年5月27日 9:14 778 MyFtpActiveFormImpl1.dfm
2000年5月27日 9:15 9307 MyFtpActiveFormImpl1.pas
2000年5月27日 9:11 334 MyFtpActiveFormProj1.~dpr
2000年5月27日 9:11 6424 MyFtpActiveFormProj1.~tlb
2000年5月27日 9:27 386 MyFtpActiveFormProj1.cfg
2000年5月27日 9:27 1436 MyFtpActiveFormProj1.dof
2000年5月27日 9:11 334 MyFtpActiveFormProj1.dpr
2000年5月27日 9:29 382 MyFtpActiveFormProj1.htm
2000年5月27日 9:31 477696 MyFtpActiveFormProj1.ocx
2000年5月27日 9:27 1836 MyFtpActiveFormProj1.res
2000年5月27日 9:11 6424 MyFtpActiveFormProj1.tlb
2000年5月27日 9:11 15377 MyFtpActiveFormProj1_TLB.~pas
2000年5月27日 9:31 11952 MyFtpActiveFormProj1_TLB.dcu
2000年5月27日 9:11 15377 MyFtpActiveFormProj1_TLB.pas

其中：MyFtpActiveFormProj1.htm 就是刚才内嵌的HTML文件，点击这个超级
链接，就可以看到包含ActiveX的网页了。
打开这个网页的源代码，可以看到这个HTML文件中真正重要的是下面
的一段，把这一段镶嵌到任何一个网页中，都可以调用这个ActiveX 。而
其它部分可以用诸如Frontpage 等网页设计软件来完成。
<html>
<head><title>Use ActiveX Ftp</title></head>
<body>
<OBJECT
 classid="clsid:6EE6F565-1258-4127-95CA-153DEC60EAC2"
 codebase="http://10.68.7.138:8080/AppletTest/MyFtpActiveFormProj1.ocx"
 width=980
 height=650
 align=center
 hspace=0
 vspace=0
 >
</OBJECT>
</body>
</html>

注意:classid是上述ActivexForm的classid

以上开发环境：winxp+delphi7.0+tomcat5.5.28,并测试通过

 

本文未能实现大于2G文件FTP上传下载,请看下集

http://blog.csdn.net/mzyp/archive/2010/03/09/5360762.aspx

 

 

 

参考资料

http://203.208.39.132/search?q=cache:SRteIgHe0kAJ:book.77169.org/data/web5302/20050228/20050228__3692503.html+delphi%E6%BA%90%E7%A0%81+ftp+activeX%E6%8E%A7%E4%BB%B6&cd=23&hl=zh-CN&ct=clnk&gl=cn&st_usg=ALhdy28pLWg4WO13sPRy5MUhoDCTa0RrOQ