编程技术、软件应用与系统模拟

(Programming, Applicaiton and Simulation)


		本站目录
		首页 ASP/Access/IIS DELPHI/PASCAL PASCAL高级编程 C语言编程实例 WORD Excel MATLAB MINITAB讲座 Windows DOS SAS 生物系统模拟土壤水分剖析器其他


		镜像站点
		主站北美镜象站欧洲镜象站(1) 欧洲镜象站(2)

座右铭:
只做有益人类的事
不做有害人类的事

为ASP制作一个全功能上传COM组件

河南济源董占山

ASP是Microsoft动态网站的基石，它扩展了IIS(Internet Information Server)Web服务器的功能。我们可以在ASP页面中嵌入用VB Script或Java Script脚本语言编写的程序，从而实现动态网页。在ASP页面上使用脚本语言时，我们可以方便地调用COM组件来实现复杂的功能，例如文件的上传和下载等常用功能。当WEB服务器使用Win 98 + PWS 4.0的软件配置时，PWS并没有提供一个向服务器上传文件的组件。虽然，在网上可以找到不少的ASP上传组件，多是商业软件的试用或演示版，功能有限。你可能以为开发一这样组件需要掌握大量的编程知识和技术，并需要合适的开发工具，其实不然，如果你手上有Delphi，VB或VC等开发工具的话，您已拥有COM组件的开发工具了。Delphi 5.0提供了对开发COM组件的全面支持，下面我就以Delphi为例介绍如何从无到有地编写一个全功能上传COM组件。

1. 上传文件的实现原理

通过HTTP协议将本地文件上传到服务器需要符合RFC1867协议。图1显示了一个典型的上传数据流。该数据流中包含了两个字段，一个是文件字段，一个是提交按钮的字段。这就是服务器从用户端获得的所有信息，只有成功将其中的信息解析出来并保存到磁盘上，一个上传过程才告顺利完成。下面将详细解析这个数据流。

图 1 一个典型的上传数据流

1.1字段的起始标志

数据流开始处的字符串，“-----------------------------7d0509764”，是字段分隔符，这个分隔字符串不是一成不变的，不同的数据流有不同的分隔符，这个分隔符以#$0D#$0A结束。紧接其后是另一个可起字段起始标志作用的字符串，“Content-Disposition: form-data; ”。这个字符串在所有的上传数据流中都是一样的，本文所附的程序使用该字符串来定位下一个字段。

1.2 字段名称和字段取值

在我们的示例数据流中，第一个字段是文件变量，所以我们先介绍文件变量的解析，然后再介绍除文件变量以外的一般变量的解析。

对于文件变量型字段，有4个需要解析的内容，即字段名、文件名、文件类型和文件内容。字段名称以“name=”为前导，并包含在一对双引号(")中，本例为“filename”；文件名的取值以“filename=”为前导，也包含在一对双引号中，其中包含文件的全路径和名称，本例为“C:\WINDOWS\Desktop\Direct.stm”。紧接其后是一对回车换行符（#$0D#$0A），字符串“Content-Type: ”和两对回车换行符之间的内容为文件类型字符串，本例是“application/octet-stream”。两对回车换行符之后到以一对回车换行开始的字段分隔符之间的内容为文件内容。

对于一般变量型的字段，只有两个需要解析的内容，即字段名及其取值。字段名称在“name=”之后，包含在一对双引号(")中，本例为“B1”；两对回车换行符到以一对回车换行开始的字段分隔符之间的内容为字段的取值，本例为“Submit”。

经过以上两个步骤，上述例子的上传内容已经解析完毕。对于复杂的网页表单，只需要重复查找字段开始标志字符串“Content-Disposition: form-data; ”即可，只要可以查到下一个，就表明还有字段存在，直到找不到新的字段开始标志为止。

2. 上传组件的实现

本节将循序渐进地告诉你如何用Delphi 5.0建立一个完善的上传COM组件。

2.1 创建一个新的 ActiveX库工程

单击“ File”菜单中的“New”菜单项，打开“ New Items”对话窗口，单击“ActiveX”标签切换到ActiveX对话页（图2），双击“ActiveX Library”图标创建一个新的DLL类库工程。

图 2 ActiveX对话页

2.2 创建一个自动类（automation class）

打开“New Items”对话窗口，切换到“ ActiveX”对话页，双击“Automation Object”图标，打开“自动对象向导（Automation Object Wizard）” (图3)，在“CoClass Name”编辑框中输入“ Uploadfile”，单击“OK”按钮Delphi将建立自动类的骨架，接着弹出一个“类库（Type Library）”对话窗口，见图4。单击“File”菜单中的“Save”菜单项，将自动类单元保存为uMain.pas，将类库工程保存为“upload.dpr”。

图 3 自动对象向导

图 4 类库编辑器

2.3 Importing ASP type library

在该上传组件中，需要使用一个ASP的内建对象request。为了使用ASP的5个内建对象：request, response, server, application和session，需要输入ASP 类库。单击“ Project”菜单的“Import Type Library”菜单项，在类库列表中选择“Microsoft Active Server Pages Object Library (Version 2.0) ”项，Delphi将自动创建一个TLB文件：ASPTypeLibrary_TLB.PAS，其中包含了5个ASP内建对象的声明。

2.4 添加方法

本组件包含10个方法，其中包含两个特殊的过程，即OnStartPage和OnEndPage事件处理程序。为自动类添加一个方法较简单，单击“Edit”菜单中的“Add to Interface”菜单项，弹出“Add To Interface”对话窗口（图5）。在“Declaration”编辑框中输入成员函数或过程的声明，如“function getValue(Index : Integer) : OleVariant;”，单击“OK”按钮创建方法。Delphi自动引导你到自动类单元的方法实现部分，等待你输入代码完成该方法。

图 5 添加COM组件方法对话窗口

按照此上述方法，你需要添加表1所示的成员方法。

表1 上传单元的成员方法

方法名称	形式参数	返回值
Procedure OnStartPage	AscriptingContext : IscriptingContext type	无
Procedure OnEndPage		无
Function getName	Index : integer	字符串，字段名称
Function getValue	Index : integer	字符串，字段取值（依索引查找）
Function getValue	Name : string	字符串，字段取值（依字段名称查找）
Function getFilename	Index : integer	字符串，文件名
Function getFileSize	Index: integer	整型，文件大小
Function getFileType	Index: integer	字符串，文件类型
Function SaveFile	Index : integer	布尔型，true或false
Function SaveFileAs	Filename: string; Index : integer	布尔型，true或false

2.5 OnStartPage和OnEndPage事件处理程序的编写

当一个 ASP页面使用Server.CreateObject方法创建一个对象（或COM组件中的一个自动类）的实例时，WEB服务器首先要调用OnStartPage过程，将ASP环境中的信息传递给新创建的对象实例。当释放一个对象实例时，WEB服务器将调用OnEndPage过程，我们可以利用该过程释放创建对象实例时分配的内存等工作。在本文提供的上传组件中这两个方法都被用到了。

这两个过程都需要在自动类中实现，OnStartPage的原型是“procedure OnStartPage(AscriptingContext : Iunknown); ”，其中AscriptingContext是IscriptingContext类型的唯一参数；OnEndPage的原型是“procedure OnEndPage”。

2.6 添加属性

该上传组件包含5个只读属性。向自动类添加一个属性的方法稍微复杂一些。单击“View”菜单中的“Type Library”菜单项，弹出图4所示的类库编辑器窗口。选中“IUploadfile”项目，单击该窗口工具栏上的“New Property”复合按钮的下拉箭头按钮，从弹出的列表中选择“只读（read only）” 项，创建一个只读属性，在属性名称编辑框中输入属性名，例如“filename”，在窗口右边的面板上的“Type”下拉列表框中选择“Variant”。单击该窗口工具栏上的“Refresh Implementation”按钮，Delphi将属性的定义部分加到自动类的声明部分。然后切换到自动类单元，找到下面的属性定义部分：

function TUploadfile.Get_filename: OleVariant;
begin
end;

在begin与end之间写入需要的代码即可。依照上述方法，你需要添加表2所示的属性成员。

表2 上传单元的属性

属性名称	类型及返回值
ItemCount	整型，表单字段个数
FileCount	整型，文件个数
FileName	字符串，第一个文件的名称
FileSize	字符串，第一个文件的大小
FileType	字符串，第一个文件的类型

2.7 源程序代码

本文提供的上传组件包含3个源程序文件：工程源文件、类库源文件和自动类单元文件，其中，你只需要也只能更改自动类单元文件的内容，其余两个文件由Delphi修改，所以下面只列出了自动类源文件的内容。在这个单元中除了自动类以外，还有两个辅助类：TItem和TFileInfo。TItem用来保存除文件字段外的表单字段的内容，TFileInfo用来保存文件字段的内容。

unit uMain;
interface

uses
  SysUtils, Classes, ComObj, ActiveX, Upload_TLB, StdVcl, ASPTypeLibrary_TLB;

type
  TItem = class
  private
    FName : string;
    FValue : string;
    procedure SetName(AName : string);
    procedure SetValue(AValue : string);
  public
    property Name : string read FName write SetName;
    property Value : string read FValue write SetValue;
  end;

  TFileInfo = class
  private
    FFileName : string;
    FFileType : string;
    FFileDataStart : LongInt;
    FFileDataEnd : LongInt;
    procedure SetFileName(AFileName : string);
    procedure SetFileType(AFileType : string);
    procedure SetFileDataStart(ALInt : LongInt);
    procedure SetFileDataEnd(ALInt : LongInt);
  protected
    property FileName : string read FFileName write SetFileName;
    property FileType : string read FFileType write SetFileType;
    property FileDataStart : LongInt read FFileDataStart write SetFileDataStart;
    property FileDataEnd : LongInt read FFileDataEnd write SetFileDataEnd;
  end;

  TUploadFile = class(TAutoObject, IUploadFile)
  private
    FContentLength : Longint;
    FContentData : Variant;
    FDelimiter : string;
    FScriptingContext : IScriptingContext;
    FItems : TList;
    FFileInfo : TList;
    procedure ParseData;
  protected
    procedure OnStartPage(const AScriptingContext: IUnknown); safecall;
    procedure OnEndPage; safecall;
    function SaveFileAs(FileName: OleVariant; Index: Integer): OleVariant;safecall;
    function SaveFile(Index: Integer): OleVariant; safecall;
// 返回表单的字段个数
function Get_ItemCount: Integer; safecall;
    // 获取表单的字段值
    function getName(Index: Integer): OleVariant; safecall; // 以位置作索引
    function getVaule(Index: Integer): OleVariant; safecall; // 以位置作索引
    function getValue(AName: OleVariant): OleVariant; safecall; // 以名字作索引
    // 返回表单中的文件数
    function Get_FileCount: Integer; safecall;
    // 返回文件名，文件类型和文件的大小
    function Get_Filename: OleVariant; safecall;
    function Get_FileType: OleVariant; safecall;
    function Get_FileSize: Integer; safecall;
    function getFilename(Index: Integer): OleVariant; safecall;
    function getFileType(Index: Integer): OleVariant; safecall;
    function getFileSize(index: Integer): Integer; safecall;
  end;

implementation

uses ComServ;

//=============== TItem ======================
procedure TItem.SetName;
begin
  FName := AName;
end;

procedure TItem.SetValue;
begin
  FValue := AValue;
end;

//============== TFileInfo ====================
procedure TFileInfo.SetFileName(AFileName : string);
begin
  FFileName := AFileName;
end;

procedure TFileInfo.SetFileType(AFileType : string);
begin
  FFileType := AFileType;
end;

procedure TFileInfo.SetFileDataStart(ALInt : LongInt);
begin
  FFileDataStart := ALInt;
end;

procedure TFileInfo.SetFileDataEnd(ALInt : LongInt);
begin
  FFileDataEnd := ALInt;
end;

//================ TUploadFile ======================

// ---------------- private method ------------------
procedure TUploadFile.ParseData;
var
  ContentData : AnsiString;
  longIndex, longPos : LongInt;
  FormItem : TItem;
  FormFileInfo : TFileInfo;
  bytedata : byte;
const
  nameStr:string = 'name="';
  filenameStr:string = 'filename="';
  quote:string = '"';
  contentTypeStr:string = 'Content-Type:';
  nextStr : string = 'Content-Disposition: form-data; ';
begin
  ContentData := '';
  for longIndex := 0 to FContentLength - 1 do
  begin
    bytedata := Byte(FContentData[longIndex]);
    ContentData := ContentData + chr(ByteData);
  end;

  // 获取字段分隔符字符串
  longPos := Pos(#13#10,ContentData);
  FDelimiter := copy(ContentData,1,longPos-1);
  // 提取表单中的字段
  longIndex := 0;
  repeat
    // 取字段名称
    FormItem := TItem.Create;
    longPos := Pos(nameStr,ContentData);
    Delete(ContentData,1, longPos + length(nameStr)-1);
    longIndex := longIndex + longPos + length(nameStr)-1;
    longPos := Pos(quote,ContentData);
    FormItem.Name := Copy(ContentData,1,longPos-1);
    Delete(ContentData,1, longPos + length(quote) - 1);
    longIndex := longIndex + longPos + length(quote) - 1;
    longPos := Pos(filenameStr,ContentData);
    if longPos = 3 then
    // 取字段的值
    begin
      FormFileInfo := TFileInfo.Create;
      // 取文件名称
      Delete(ContentData,1, longPos + length(filenameStr)-1);
      longIndex := longIndex + longPos + length(filenameStr) - 1;
      longPos := Pos(quote,ContentData);
      FormItem.Value := Copy(ContentData,1,longPos-1);
      FormFileInfo.FileName := ExtractFilename(FormItem.Value);
      Delete(ContentData,1, longPos + length(quote) - 1);
      longIndex := longIndex + longPos + length(quote) - 1;
      // 取文件类型
      longPos := Pos(contentTypeStr,ContentData);
      Delete(ContentData,1,longPos + length(contentTypeStr) - 1);
      longIndex := longIndex + longPos + length(contentTypeStr) - 1;
      longPos := Pos(#13#10#13#10, ContentData);
      FormFileInfo.FileType := Copy(ContentData,1,longPos-1);
      Delete(ContentData,1, longPos - 1 + 4{the length of #13#10#13#10});
      longIndex := longIndex + longPos -1 + 4;
      // 取文件内容所处的位置
      if FormFileInfo.Filename = '' then
      begin
        FormFileInfo.FileDataStart := -1;
        FormFileInfo.FileDataEnd := -2;
        break;
      end;
      FormFileInfo.FileDataStart := longIndex;
      FormFileInfo.FileDataEnd := FormFileInfo.FileDataStart;
      longPos := Pos(FDelimiter,ContentData);
      FormFileInfo.FileDataEnd := FormFileInfo.FileDataEnd + longPos - 4;
      Delete(ContentData,1,longPos + length(FDelimiter)-1);
      longIndex := longIndex + longPos+length(FDelimiter)-1;
      FFileInfo.Add(FormFileInfo);
    end
    else
    begin
      Delete(ContentData,1, 4{the length of #13#10#13#10});
      longIndex := longIndex + 4;
      longPos := Pos(FDelimiter,ContentData);
      FormItem.Value := Copy(ContentData,1,longPos-1-2{the length of #13#10});
      Delete(ContentData,1,longPos+length(FDelimiter)-1);
      longIndex := longIndex + longPos+length(FDelimiter)-1;
    end;
    FItems.Add(FormItem);
  until (Pos(nextStr,ContentData)<= 0);
end;

// --------------- protected method ------------------
procedure TUploadFile.OnStartPage(const AScriptingContext: IUnknown);
var
  AOleVariant : OleVariant;
  ARequest : IRequest;
begin
  FScriptingContext := AScriptingContext as IScriptingContext;
  ARequest := FScriptingContext.Request;
  FContentLength := ARequest.TotalBytes;
  // 为存贮表单数据的变量分配内存
  FContentData := VarArrayCreate([0,FContentLength],varByte);
  AOleVariant := FContentLength;
  // 取表单的反馈数据
  FContentData := ARequest.BinaryRead(AOleVariant);
  // 解析上传的数据
  FITems := TList.Create;
  FFileInfo := TList.Create;
  ParseData;
end;

procedure TUploadFile.OnEndPage;
begin
  FFileInfo.Free;
  FItems.Free;
end;

function TUploadFile.SaveFileAs(FileName: OleVariant; Index: Integer): OleVariant;
var
  AFile : file of byte;
  FormFileInfo : TFileInfo;
  CurrentFilePath : string;
  longIndex : LongInt;
  byteData : byte;
begin
  if Index > FFileInfo.Count then
    result := false
  else
  begin
    result := true;
    FormFileInfo := TFileInfo(FFileInfo.Items[Index-1]);
    if Filename = '' then
    begin
      CurrentFilePath := FScriptingContext.Request.ServerVariables['PATH_TRANSLATED'];
      CurrentFilePath := ExtractFilePath(CurrentFilePath);
      FileName := CurrentFilePath + ExtractFileName(FormFileInfo.FileName);
    end;
    try
      assignFile(AFile,FileName);
      rewrite(AFile);
      for longIndex := FormFileInfo.FileDataStart to FormFileInfo.FileDataEnd do
      begin
        byteData := byte(FContentData[longIndex]);
        write(AFile,byteData);
      end;
    Except
      result := false;
    end;
  end
end;

function TUploadFile.SaveFile(Index: Integer): OleVariant;
begin
  result := SaveFileAs('',Index);
end;

function TUploadFile.getValue(AName: OleVariant): OleVariant;
var
  i : integer;
begin
  for i := 0 to FItems.Count - 1 do
  begin
    if CompareText(AName,TItem(FItems.Items[i]).Name)=0 then
      result := TItem(FItems.Items[i]).Value;
  end;
end;

function TUploadFile.Get_ItemCount: Integer;
begin
  result := FItems.Count;
end;

function TUploadFile.getVaule(Index: Integer): OleVariant;
begin
  result := TItem(FItems.Items[Index-1]).Value;
end;

function TUploadFile.getName(Index: Integer): OleVariant;
begin
  result := TItem(FItems.Items[Index-1]).Name;
end;

function TUploadFile.Get_FileCount: Integer;
begin
  result := FFileInfo.Count;
end;

function TUploadFile.Get_FileSize: Integer;
begin
  if FFileInfo.Count >= 1 then
    with TFileInfo(FFileInfo.Items[0]) do
      result := FFileDataEnd - FFileDataStart + 1
  else
    result := 0;
end;

function TUploadFile.Get_Filename: OleVariant;
begin
  if FFileInfo.Count >= 1 then
    result := TFileInfo(FFileInfo.Items[0]).FileName
  else
    result := '';
end;

function TUploadFile.Get_FileType: OleVariant;
begin
  if FFileInfo.Count >= 1 then
    result := TFileInfo(FFileInfo.Items[0]).FileType
  else
    result := '';
end;

function TUploadFile.getFilename(Index: Integer): OleVariant;
begin
  if FFileInfo.Count >= Index then
    result := TFileInfo(FFileInfo.Items[Index-1]).Filename
  else
    result :='';
end;

function TUploadFile.getFileType(Index: Integer): OleVariant;
begin
  if FFileInfo.Count >= Index then
    result := TFileInfo(FFileInfo.Items[Index-1]).FileType
  else
    result := '';
end;

function TUploadFile.getFileSize(Index: Integer): Integer;
begin
  if FFileInfo.Count >= Index then
    with TFileInfo(FFileInfo.Items[Index-1]) do
      result := FileDataEnd - FileDataStart + 1
  else
    result := 0;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TUploadFile, Class_UploadFile,
    ciMultiInstance, tmApartment);
end.

3. 组件的编译、注册和使用

若你正确地完成了上述步骤，现在就可编译生成COM组件了。编译完成后，单击“Run”菜单中的“Register ActiveX Server”菜单项，将新生成的COM组件在Windows系统下注册。注册成功后，你就可以在ASP页面中使用该上传组件了。在ASP页面中使用脚本语言VBScript用Server.CreateObject来创建一个uploadfile对象实例的命令如下：

Set objTool = Server.CreateObject("upload.uploadfile")

对象实例一旦建立，您就可以调用其方法和属性，命令为：

变量＝ objTool.<方法>(参数表) 或者变量＝ objTool.<属性>

下面提供了一个使用该组件的ASP页面实例（upl.asp）。在浏览器上打开此页面时，可在表单中输入3个文件（该组件没有限制上传文件的数量），输入完成后，单击“Submit”按钮，表单中的信息就被送到服务器进行处理，该ASP页面通过upload组件解析上传数据流后，将上传文件保存到你服务器的根目录下，当然你可以改变语句 “

whichfile=server.mappath("\" & strDest)”

中的“\”，来确定目标目录。

upl.asp

<html>

<head>
<meta http-equiv="Content-Type" content="text/html">
<title>Upload a local file to the server</title>
</head>

<body>

<p align="center"><u><big><strong>Upload a local file</strong></big></u></p>
<%
Dim objTool 'Dimension object variable
Server.ScriptTimeout = 10000

Set objTool = Server.CreateObject("upload.uploadfile")
if (objTool.FileCount > 0) then
  for i = 1 to objTool.FileCount
    strDest = strDest + objTool.GetFilename(i)
    whichfile=server.mappath("\" & strDest)
    objTool.SaveFileAs(whichfile,i) then
  next
end if
set objTool = nothing
%>

<form method="POST" action="upl.asp" enctype="multipart/form-data" name="uploadfile">
  <div align="center"><center><table border="0" cellpadding="0" cellspacing="4" width="100%">
    <tr>
      <td width="25%" align="right" height="23" valign="top">File1</td>
      <td width="75%" height="23"><input type="file" name="filename1" size="47"></td>
    </tr>
    <tr>
      <td width="25%" align="right" height="23" valign="top">File2</td>
      <td width="75%" height="23"><input type="file" name="filename2" size="47"></td>
    </tr>
    <tr>
      <td width="25%" align="right" height="23" valign="top">File3</td>
      <td width="75%" height="23"><input type="file" name="filename3" size="47"></td>
    </tr>
    <tr>
      <td align="right" valign="top" width="25%"></td>
      <td width="75%" height="20"><input type="submit" value="Submit" name="B1"><input
      type="reset" value="Reset" name="B2"></td>
    </tr>
  </table>
  </center></div>
</form>
</body>
</html>
<%
Server.ScriptTimeout = 90
%>

4. 小结

Delphi 5.0是一个强大的编程环境，通过上述步骤我们创建了一个COM组件，供ASP服务器使用。学以致用，你可依照本文提供的方法创建其他实用的COM组件，例如Webmail组件等。也可以使用Delphi创建在网上使用的ActiveX可视控件，给你的网页增光添彩。

另外，我已经将该组件应用到我编写的一个个人网络服务软件Gallery中。你可到我的网站（http://www-personal.ksu.edu/~zhanshan/）上获得该组件的所有源代码和编译后的组件。同时可以看看该组件在我的网站的Gallery中的工作情况。