使用组建的朋友给个推荐吧！

[laoshuan123]

我用的上传组件上传速度慢得要死，而且文件一大了，服务器的内存就被疯狂占用。有没有速度又快，占用资源又少的上传组件呢？我好像看到过人家的网站有上传速度非常快的组件。真是羡慕呀！哪里能够下载到呢？

[lihaidong]

有很多组件都是自己开发的

[tanyaliji]

要花钱的呀，

[eafin]

lyfupload
到网上搜搜！

[laoshuan123]

lyfupload
这个速度就很慢。我用的就是这个。又比他快的么？

[loadagain]

我自己开发了一个，挺好了，便宜你了，只收3万块，要的跨来跨来联系啊

[laoshuan123]

谢谢你，你看我要是值3万，我跟你走。

[Jaron]

Option Explicit

'------------------- 声明ASP对象---------------------
Private MyScriptingContext As ScriptingContext
Private MyRequest As Request
'---------------------------------------------------

'------------------定义全局变量----------------------
Private binArray() As Byte '---全部数据的数组
Private binDjf() As Byte '---定界符数组

Private intDjfLen As Integer '---定界符数组的长度
Private lngArrayLen As Long '---全部数据数组的长度
'---------------------------------------------------

Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)

'------------------定义局部变量----------------------
Dim varByteCount
Dim I
'---------------------------------------------------

'------------------建立ASP对象-----------------------
Set MyScriptingContext = PassedScriptingContext
Set MyRequest = MyScriptingContext.Request
'---------------------------------------------------

'------------------读取客户端传来的全部数据-----------
varByteCount = MyRequest.TotalBytes
lngArrayLen = varByteCount - 1
ReDim binArray(varByteCount - 1)
binArray = MyRequest.BinaryRead(varByteCount)
'---------------------------------------------------

'--------------------获取定界符---------------------
intDjfLen = 0
Do Until binArray(intDjfLen + 1) = 13
intDjfLen = intDjfLen + 1
Loop
ReDim binDjf(intDjfLen)
For I = 0 To intDjfLen
binDjf(I) = binArray(I)
Next
'---------------------------------------------------
End Sub
Private Function FindTheDjf(lngStart As Long) As Long

'******************************参数说明
'* *
'* lngStart: 寻找的起始位置 *
'* 返回值： 成功—— 找到时的地址，失败—— -1 *
'* *
'*******************************************************************

'------------------定义局部变量----------------------
Dim I As Integer
Dim s As Long
Dim DjfOk As Integer
'---------------------------------------------------

'-----------------获取定界符的起始位置--------------------
s = lngStart
Do While 1
DjfOk = 1
For I = 0 To intDjfLen
If binDjf(I) <> binArray(s + I) Then
DjfOk = 0
Exit For
End If
Next
If DjfOk = 1 Then
FindTheDjf = s
Exit Do
Else
s = s + 1
If s >= lngArrayLen - intDjfLen Then
FindTheDjf = -1
Exit Do
End If
End If
Loop
'--------------------------------------------------------------
End Function


Private Function FindTheName(nm As String) As Long
'******************************参数说明*****************************
'* *
'* nm: 要寻找的 Form 元素名 *
'* 返回值： 成功—— 找到时的地址，失败—— -1 *
'* *
'*******************************************************************

'------------------定义局部变量----------------------
Dim s As Long
Dim e As Long
Dim I As Long

Dim binTmp() As Byte
Dim strName As String
'---------------------------------------------------

'------------------寻找要取得值的Form 元素名------------------------
s = 0
Do While 1
s = FindTheDjf(s)
If s <> -1 Then
s = s + intDjfLen + 41
e = s
Do While binArray(e + 1) <> 34
e = e + 1
Loop
ReDim binTmp(e - s)
For I = s To e
binTmp(I - s) = binArray(I)
Next
strName = StrConv(binTmp, 64)
If StrComp(nm, strName) = 0 Then
FindTheName = e + 1
Exit Do
End If
Else
FindTheName = -1
Exit Do
End If
Loop
'--------------------------------------------------------------
End Function

[Jaron]

Public Function GetTheValue(nm As String) As String
'******************************参数说明*****************************
'* *
'* nm: 要取得值的 Form 元素名 *
'* *
'*******************************************************************

'------------------定义局部变量----------------------
Dim s As Long
Dim e As Long
Dim I As Long

Dim strTmp As String
Dim binTmp() As Byte
'-----------------------------------------------------------

'-----------------寻找数据的起始位置和结束位置-----------------
s = FindTheName(nm)
If s = -1 Then
GetTheValue = ""
Exit Function
End If
s = s + 5
e = FindTheDjf(s) - 3
'-----------------------------------------------------------

'----------------处理输入的数据为空的情况------------------
If e - s < 0 Then
GetTheValue = ""
Exit Function
End If
'-----------------------------------------------------------

'-----------------得到数据值------------------------
ReDim binTmp(e - s)
For I = s To e
binTmp(I - s) = binArray(I)
Next
strTmp = StrConv(binTmp, 64)
GetTheValue = strTmp
'-----------------------------------------------------------
End Function

Public Function SaveTheFile(strTag As String, strPath As String) As String

'******************************参数说明*****************************
'* *
'* strTag: HTML FORM中要上载的文件类型INPUT标签名 *
'* strPath: 目标路径名, 末尾不带"\"。如:"c:\images\upload" *
'* 返回值： 成功——文件名，失败—— "" *
'* *
'*******************************************************************

'------------------定义局部变量----------------------
Dim s As Long '起始位置
Dim e As Long '结束位置
Dim I As Long

Dim fileNo As Integer

Dim strFileName As String
Dim strTmp As String
Dim binTmp() As Byte
Dim newfile As String
'-----------------------------------------------------------

'---------得到文件名的起始位置---------------------------
s = FindTheName(strTag)
If s = -1 Then
SaveTheFile = ""
Exit Function
End If
s = s + 13
'-----------------------------------------------------------

'----------得到文件名的结束位置---------------------------
I = s
Do While 1
If binArray(I) = 34 Then
Exit Do
End If
I = I + 1
Loop
e = I - 1
'--------------------------------------------------------

'---------------处理客户端没有上载文件的情况---------------
If e - s < 0 Then
SaveTheFile = ""
Exit Function
End If
'-----------------------------------------------------------

'-------------------得到不带源路径的文件名-------------------
For I = e To s Step -1
If Chr(binArray(I - 1)) = "\" Then
s = I
Exit For
End If
Next
ReDim binTmp(e - s)
For I = s To e
binTmp(I - s) = binArray(I)
Next
strTmp = StrConv(binTmp, 64)
newfile = Year(Now()) & Month(Now()) & Day(Now()) & "_" & Replace(Time(), ":", "") & "." & Right(strTmp, 3)
strTmp = newfile
strFileName = strTmp
'-------------------------------------------------------------

'-----------------建立目标文件名-------------------------
strTmp = strPath & "\" & strTmp
'-------------------------------------------------------------

'-----------------寻找文件数据的起始位置------------------
I = e
Do While 1
If binArray(I - 4) = 13 And binArray(I - 3) = 10 And binArray(I - 2) = 13 And binArray(I - 1) = 10 Then
s = I
Exit Do
End If
I = I + 1
Loop
'-------------------------------------------------------------

'-----------------寻找文件数据的结束位置------------------
e = FindTheDjf(s) - 3
'-------------------------------------------------------------

'----------------------把文件数据存盘---------------------
fileNo = FreeFile() '为了防止存在同名文件，就先打开一个同名文件，
Open strTmp For Binary Access Write As #fileNo '然后再删除它
Put #fileNo, , "temp"
Close #fileNo
Kill strTmp

fileNo = FreeFile()
Open strTmp For Binary Access Write As #fileNo

If e - s >= 0 Then '如果 e-s<0 , 则是一个空文件
ReDim binTmp(e - s)
For I = s To e
binTmp(I - s) = binArray(I)
Next
Put #fileNo, , binTmp
End If

Close #fileNo
'-------------------------------------------------------------

SaveTheFile = strFileName '成功，返回文件名
End Function

[Jaron]

添加类模块，贴入以上代码，类模块名称设为 upload

定义工程属性，名称可以是你自已的名字。

编译，生成DLL，注册一下，OK了