欢迎使用

恭喜恭喜，你现在已经可以使用功能强大的“BlueDoctor.FileUp”组件了！

    当出现提示问是否允许安装插件时，请选择允许。如果你的浏览器不允许下载，并且熟悉组件操作，请在这里下载 ,然后在服务器上用"regsvr32 path\BlueDoctor.dll"来注册,这里path是指文件在机器中的路径，通常是在系统目录中(例如：win9x c:\windows\system , win2000/xp c:\winnt\system32 )；如果你不熟悉，可以下载(1.15MB)完整的安装包，然后在本地机器上打开这个网页就是了，组件会自动安装。

您是第 位来客

    虽然ASP有强大的运行动态网页的功能，Scripting.FileObject组件具有强大的服务器端文件处理功能，但是却不能操作二进制文件，因此无法直接上传文件到服务器，需要从第三方取得文件上传组件或着自己编写一个文件上传组件。本人长期从事ASP程序开发，近来公司要求编写能够上传文件的ASP程序，我去网上找了一遍，要么功能很强大，但是要Money购买；要么功能太简单，运行不稳定；要么没有详细的使用方法，使用很不方便。一气之下，干脆自己找资料来写一个算了！

1、属性：

• ContentType     ’只读属性；文件的网络传输类型，用于指示浏览器如何处理服务器发送来的数据，通常用于将文件存放到数据库后需要在从数据库中读取并让浏览器显示的情况。
• ErrDescription  ’只读属性；操作出错信息；如果上传成功则为空值。
• FileName        ’只读属性；上传文件的原始名称，不包含目录。
• Folder          ’只读属性；上传文件的本地目录，包含文件名。
• GetFileSize     ’只读属性；获取文件的大小，单位：字节。
• GetFileType     ’只读属性；获取文件的类型，如“*.html”
• SetFileName     ’设置文件存放到服务器的名称；如果不指定，则使用文件的原始名称。
• SetFileSize     ’允许上传的文件大小；如果不指定，则不限制大小。单位：字节。
• SetFileType     ’设置允许上传的文件类型，格式如“*.jpg,*.gif,*.htm”；如果不指定，则允许任何文件上传。
• SetFolder       ’设置文件存放的远程目录（虚拟目录）；如果不指定，则存放到当前ASP文件的目录下。

2、方法：

• GetFileData As Byte()              ’获取文件字节流，用于写入数据库。
• ReadFileInfo() As Boolean          ’读取文件信息。如果要写入数据库，在调用GetFileData之前一定要先用该函数作测试
• SaveFile([ ObjFile ]) As Boolean   ’将上传文件保存到服务器上，文件名为 ObjFile（可选）

    新建一个ActiveX DLLs类型的工程，并将缺省的工程名由“Project1”改为“BlueDoctor”（当然你也有权不这样改，呵呵），将缺省的类名由“Class1”改为“FileUp”，至于为什么要这样改，以后你便知道了。

    要想实现读取上传文件字节数据的功能，势必要涉及到Request对象，可是在VB中该怎么做呢？简单，只需要在工程中加入适当的类型库的参考即可。点击Project菜单选择References，在随之出现的对话框中选中Microsoft Active Server Pages Object项(以及Microsoft Transaction Server Type Library项--有人这么说，可我的机器上就是找不到)，单击OK，便可以在VB环境中象写ASP代码一样操纵Request、Response等对象了，你会感到非常亲切的。

以下便是具体的程序代码：(用VB6写的源文件，与在开发环境中看到的代码有点不一样，这样大家也就知道VB和VB的“类生成器”干了什么)

VERSION 1.0 CLASS

BEGIN

  MultiUse = -1  'True

  Persistable = 0  'NotPersistable

  DataBindingBehavior = 0  'vbNone

  DataSourceBehavior  = 0  'vbNone

  MTSTransactionMode  = 0  'NotAnMTSObject

END

Attribute VB_Name = "FileUp"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = True

Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"

Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

'保持属性值的局部变量

Private mvarFileName As String '局部复制

Private mvarFolder As String '局部复制

Private mvarContentType As String '局部复制

Private mvarGetFileSize As Long '局部复制

Private mvarSetFileSize As Long '局部复制

Private mvarSetFileType As String '局部复制

Private mvarGetFileType As String '局部复制

Private mvarSetFileName As String '局部复制

Private mvarErrDescription As String '局部复制

Private mvarSetFolder As String '局部复制

Private FormData() As Byte

''''''''''''''''''''''''''''''''''''''''''''''

Private MyScriptingContext As ScriptingContext

'Private MyApplication As Application

Private MyRequest As Request

'Private MyResponse As Response

Private MyServer As Server

'Private MySession As Session

Public Property Let SetFolder(ByVal vData As String)

Attribute SetFolder.VB_Description = "设置文件存放到服务器上的目录。"

'向属性指派值时使用，位于赋值语句的左边。

'Syntax: X.SetFolder = 5

    mvarSetFolder = vData

End Property

Public Property Get SetFolder() As String

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.SetFolder

    SetFolder = mvarSetFolder

End Property

Public Property Get ErrDescription() As String

Attribute ErrDescription.VB_Description = "错误信息"

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.ErrDescription

    ErrDescription = mvarErrDescription

End Property

Public Function SaveFile(Optional ByVal ObjFile As String = "") As Boolean

Attribute SaveFile.VB_Description = "要存放到服务器的目标文件名。"

On Error GoTo ErrorCode

Dim Pathname As String

If ObjFile = "" Then

    Pathname = mvarSetFileName

    '如果该函数没有指定参数，则使用属性设定的文件名

Else

    Pathname = ObjFile

End If

If ReadFileInfo() Then

    If Pathname = "" Then

        '如果属性没有指定文件名，则使用原始文件名，不包括路径。

        Pathname = mvarFileName

    End If

    '如果指定了文件存放的虚拟目录

    If mvarSetFolder <> "" Then Pathname = mvarSetFolder + "/" + Pathname

    '取得存放到服务器的文件的实际路径

    Pathname = MyServer.MapPath(Pathname)

    '创建一个二进制文件并将FormData写入其中

    Open Pathname For Binary As 1

    Put #1, , FormData

    Close #1

    SaveFile = True

Else

    SaveFile = False

End If

Exit Function

ErrorCode:

SaveFile = False

mvarErrDescription = Err.Description

End Function

Public Function GetFileData() As Byte()

'获取文件字节流，用于写入数据库。

    GetFileData = FormData

End Function

Public Function ReadFileInfo() As Boolean

'如果要写入数据库，在调用GetFileData之前一定要先用该函数作测试

On Error GoTo ErrorCode

Dim thisFlag As Boolean

Dim objRequest As Request

Dim CLStr, DivStr, HeadCode

Dim DataStart As Long, DataSize As Long

Dim NewStr As String

thisFlag = True '当前操作标志

DataSize = MyRequest.TotalBytes

ReDim FormData(DataSize - 1) As Byte

FormData = MyRequest.BinaryRead(DataSize - 1)

'FormData = MyRequest.BinaryRead(100)

CLStr = ChrB(13) & ChrB(10)

DataStart = InStrB(FormData, CLStr & CLStr) + 4

HeadCode = LeftB(FormData, DataStart)

'取得字节流的头部信息

NewStr = BtoC(HeadCode)

mvarFolder = getFolder(NewStr)

'取得原始文件目录

mvarFileName = getFileName(mvarFolder)

'取得原始文件名称

mvarContentType = getContentType(NewStr)

'取得文件网络传输类型，用于写入数据库后的回写很重要

DivStr = LeftB(FormData, InStrB(FormData, CLStr) - 1)

DataSize = InStrB(DataStart + 1, FormData, DivStr) - DataStart - 2

mvarGetFileSize = DataSize

'取得文件大小

If mvarSetFileSize <> 0 And mvarGetFileSize > mvarSetFileSize Then

    mvarErrDescription = "上传的文件超过指定大小！"

    thisFlag = False

End If

'mvarSetFileSize = 0 如果没有指定文件大小

If mvarSetFileType <> "" Then '指定了文件的上传类型

    '例如：*.html,*.asp

    If InStr(LCase(mvarSetFileType), LCase(Me.GetFileType)) = 0 Then

        mvarErrDescription = mvarErrDescription + "当前的文件类型没有在指定的类型中！"

        thisFlag = False

    End If

End If

If thisFlag Then

   FormData = MidB(FormData, DataStart, DataSize)

    '取得文件字节流

Else

    ReDim FormData(0) As Byte

    '当前操作出错，释放内存空间

End If

ReadFileInfo = thisFlag

Exit Function

ErrorCode:

ReadFileInfo = False

mvarErrDescription = Err.Description

End Function

Public Property Let SetFileName(ByVal vData As String)

Attribute SetFileName.VB_Description = "设置目标文件名"

'向属性指派值时使用，位于赋值语句的左边。

'Syntax: X.SetFileName = 5

    mvarSetFileName = vData

End Property

Public Property Get SetFileName() As String

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.SetFileName

    SetFileName = mvarSetFileName

End Property

Public Property Get GetFileType() As String

Attribute GetFileType.VB_Description = "获取文件的类型，如：""*.html"""

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.GetFileType

'mvarFileName 已经或取得原始文件名

Dim i As Integer, temp As String, temp2 As String

If mvarFileName = "" Then

    mvarErrDescription = "还没有取得有效的文件名；"

    GetFileType = ""

Else

    For i = Len(mvarFileName) To 1 Step -1

        temp = Mid(mvarFileName, i, 1)

        If temp = "." Then

            Exit For

        Else

            temp2 = temp + temp2

        End If

    Next

    temp2 = "*." + temp2

    GetFileType = temp2

End If

End Property

Public Property Let SetFileType(ByVal vData As String)

Attribute SetFileType.VB_Description = "允许上传的类型，格式""html,jpg,gif,...""，为空值表示不限制。"

'向属性指派值时使用，位于赋值语句的左边。

'Syntax: X.SetFileType = 5

    mvarSetFileType = vData

End Property

Public Property Get SetFileType() As String

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.SetFileType

    SetFileType = mvarSetFileType

End Property

Public Property Let SetFileSize(ByVal vData As Long)

Attribute SetFileSize.VB_Description = "允许上传的文件的大小（字节）"

'向属性指派值时使用，位于赋值语句的左边。

'Syntax: X.SetFileSize = 5

    mvarSetFileSize = vData

End Property

Public Property Get SetFileSize() As Long

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.SetFileSize

    SetFileSize = mvarSetFileSize

End Property

Public Property Get GetFileSize() As Long

Attribute GetFileSize.VB_Description = "上传文件的原始大小"

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.GetFileSize

    GetFileSize = mvarGetFileSize

End Property

Public Property Get ContentType() As String

Attribute ContentType.VB_Description = "传输类型"

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.ContentType

    ContentType = mvarContentType

End Property

Public Property Get Folder() As String

Attribute Folder.VB_Description = "上传文件的原始目录"

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.Folder

    Folder = mvarFolder

End Property

Public Property Get FileName() As String

Attribute FileName.VB_Description = "上传的文件名称"

'检索属性值时使用，位于赋值语句的右边。

'Syntax: Debug.Print X.FileName

    FileName = mvarFileName

End Property

Private Function BtoC(bStr) As String

'將二進制串轉換成文本串。

Dim c As String, i As Integer, temp As Long, temp2 As Integer

c = ""

For i = 1 To LenB(bStr) - 1

    temp = AscB(MidB(bStr, i, 1))

    If temp > 127 Then ''''''''''如果是汉字

        i = i + 1

        temp2 = AscB(MidB(bStr, i, 1))

        temp = temp * 256 + temp2 ''''''构造双字节

    End If

    c = c + Chr(temp)

Next

BtoC = c

End Function

Private Function getFolder(sf As String) As String

''從文本中提取文件的原目錄

Dim temps As String, gets As String

Dim n1 As Integer, i As Integer

gets = ""

n1 = InStr(1, sf, "filename=") + 10 ''避免文件上传表单域的名称为filename

For i = n1 To Len(sf)

    temps = Mid(sf, i, 1)

    If temps = Chr(34) Then Exit For

    gets = gets + temps

Next

getFolder = Trim(gets)

End Function

Private Function getFileName(sf As String) As String

''sf 完整的目錄名稱

Dim temps As String, gets As String, i As Integer

gets = ""

For i = Len(sf) To 1 Step -1

    temps = Mid(sf, i, 1)

    If temps = "\" Then Exit For

    gets = temps + gets

Next

getFileName = Trim(gets)

End Function

Private Function getContentType(Str As String) As String

''Str 为文本字符串

Dim temps As String, gets As String

Dim n As Integer, i As Integer

gets = ""

n1 = InStr(1, Str, "Content-Type:") + 14

For i = n1 To Len(Str)

    temps = Mid(Str, i, 1)

    If temps = Chr(32) Then Exit For

    gets = gets + temps

Next

getContentType = Trim(gets)

End Function

Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)

'现在,无论什么时候用户访问一个带有本组件的ASP文件,IIS就会把

'ScriptingContext传送给我们的对象请我们使用.

Set MyScriptingContext = PassedScriptingContext

'Set MyApplication = MyScriptingContext.Application

Set MyRequest = MyScriptingContext.Request

'Set MyResponse = MyScriptingContext.Response

Set MyServer = MyScriptingContext.Server

'Set MySession = MyScriptingContext.Session

End Sub

Public Sub OnEndPage()

Set MyScriptingContext = Nothing

'Set MyApplication = Nothing

Set MyRequest = Nothing

'Set MyResponse = Nothing

Set MyServer = Nothing

'Set MySession = Nothing

End Sub

大功告成！剩下的便是怎样使用这段程序了。
点击File菜单，选择Make BlueDoctor.dll，系统便会将这段程序编译成DLL文件并自动在
本机进行注册。除非你直接在服务器上开发，否则应将此文件拷贝到NT服务器的System
32目录下并运行“regsvr32 BlueDoctor.dll”命令进行注册。注册成功之后，在负责接受
上传文件的那个ASP文件中这样使用该组件：

1、先写一个上传页面

<html>
<head>
<title>文件上载</title>
<!-- file is "MyUploadFiles.htm" -->
<link rel="stylesheet" type="text/css" href="../Travel_Road/index.css">
</head>
<body>
<center>文件上载
<form name="mainForm" enctype="multipart/form-data" action="test2.asp" method="POST">
<input type="file" name="mefile" size="28"><br>
<input type="submit" name="ok" value="上传">
</form>
</center>
</body>
</html>

2、再写一个测试页面

<% '''''''''''''''''''''''''file is "test2.asp"'''''''''''''''
dim testme

set testme=server.createObject("BlueDoctor.FileUp")
testme.SetFileName="../900.jpg"
testme.SetFileType="*.jpg,*.jpeg"
testme.setFolder="../count"

if testme.savefile() then
response.Write "传输类型"&testme.ContentType&"<br>"
response.Write "原始文件名"&testme.FileName&"<br>"
response.Write "原始目录"&testme.Folder&"<br>"
response.Write "文件大小"&testme.GetFileSize&"<br>"
response.Write "文件类型"&testme.GetFileType&"<br>"
response.Write "保存到服务器的文件名"&testme.SetFileName&"<br>"
response.Write "远程文件的存放目录"&testme.SetFolder&"<br>"
response.Write "允许上传的文件类型"&testme.SetFileType&"<br>"

else
response.Write testme.ErrDescription
end if
set testme=nothing

%>
　

马上测试，是不是大功告成？

下一篇：将文件保存到数据库