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
参考资料