Programming and Application(编程与应用)

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.

<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
%>