这是稻香老农写的无组件上传控件，我一直在用，很好
－－－－－－－－－－－－－－－－
<script language=vbscript runat=server>
private srmRequestData 'adodb.stream对象，保存从form中提交来的所有数据
private padTypeBinary 'adodb.stream对象的叁数：返回二进制数据
private padTypeText 'adodb.stream对象的叁数：返回文本数据
private padModeRead 'adodb.stream对象的叁数：对象可读
private padModeWrite 'adodb.stream对象的叁数：对象可写
private ppadModeReadWrite 'adodb.stream对象的叁数：对象可读写
class LjUpload '定义一个类，名称为LjUpload。
private bytCrLf '单字节的回车换行符，共2字节
private bytSub '单字节的“-”符号，共8字节
private binData '二进制数据变量，保存一个提交数据的复本，便於操作
private dicForm '保存form文本域的信息
private dicFile '保存form文件域的信息
private strName 'form表单的输入域名称
private strValue 'form表单的输入域值
private objFile '文件信息对象，保存文件相关的信息，具体叁看class LjFile的定义
private posB '二进制数据读写指针，开始指针
private posE '二进制数据读写指针，结束指针
public Charset '语言属性设置
private sub Class_Initialize '类初始化过程
bytCrLf = getSBfromDB(vbcrlf)
bytSub = getSBfromDB("--------")
Charset = "gb2312" '默认语言属性设置为简体中文：gb2312
padTypeBinary = 1 '返回二进制数据
padTypeText = 2 '返回文本数据
padModeRead = 1 '对象数据可读
padModeWrite = 2 '对象数据可写
ppadModeReadWrite = 3 '对象数据可读写
end sub
public sub GetData '类的打开过程，上传文件及分析数据的过程
set srmRequestData = server.CreateObject("adodb.stream") '建立一个adodb.stream对象
srmRequestData.Type = padTypeBinary '指定返回数据类型
srmRequestData.Mode = ppadModeReadWrite '指定打开模式
srmRequestData.Open '打开对象
srmRequestData.Write request.BinaryRead(request.TotalBytes) '获取所有form提交的数据
srmRequestData.Position = 0 '读写指针重新定位至对象头部，写数据，指针已指向对象尾
binData = srmRequestData.Read '在变量中保存提交数据的复本，便於操作
set dicForm = server.CreateObject("scripting.dictionary") '用来保存文本信息
set dicFile = server.CreateObject("scripting.dictionary") '用来保存文件信息
posB = instrb(binData,bytSub) '开始分析所获取的二进制数据
posB = instrb(posB,binData,bytCrLf) + 2 '+2是加入回车换行符本身的长度
posB = instrb(posB,binData,getSBfromDB("name=""")) + 6
do
until posB = 6 '控制条件的设置有多种方式，这里的仅供叁考
posE = instrb(posB,binData,getSBfromDB(""""))
strName = getTextfromBin(srmRequestData,posB,posE-posB)
posB = posE + 1 '指针移动到“"”的後面
posE = instrb(posB,binData,bytCrLf)
if instrb(midb(binData,posB,posE-posB),getSBfromDB("filename=""")) > 0 then
'这是一个file域
posB = instrb(posB,binData,getSBfromDB("filename=""")) + 10
posE = instrb(posB,binData,getSBfromDB(""""))
set objFile = new LjFile '建立一个文件信息对象
if posE>posB then
objFile.FileName = getFileNamefromPath(getTextfromBin(srmRequestData,posB,posE-posB)) '写入文件名称
posB = instrb(posB,binData,getSBfromDb("Content-Type:")) + 14
posE = instrb(posB,binData,bytCrLf)
objFile.ContentType = getTextfromBin(srmRequestData,posB,posE-posB) '写入文件类型
posB = posE + 4 '这个地方换了两行，具体叁看输出的原始二进制数据
posE = instrb(posB,binData,bytSub)
objFile.Filebegin
= posB
objFile.FileLen = posE-posB-2 '写入文件长度信息，-2是减去一个回车符
end if
dicFile.Add strName, objFile
set objFile = nothing '释放文件信息对象
else
'这是一个文本域
posB = posE + 4 '这个地方换了两行，具体叁看输出的原始二进制数据
posE = instrb(posB,binData,bytSub) - 2
strValue = getTextfromBin(srmRequestData,posB,posE-posB)
dicForm.Add strName, strValue
end if
posB = posE + 2
posB = instrb(posB,binData,bytCrLf) + 2
posB = instrb(posB,binData,getSBfromDB("name=""")) + 6
loop '当循环结束时分析二进制数据完成
end sub
private function getTextfromBin(srmSource,posbegin
,posLen) '二进制数据转换为字符串，包括汉字
dim srmObj, strData
set srmObj = server.CreateObject("adodb.stream")
srmObj.Type = 1
srmObj.Mode = 3
srmObj.Open
srmSource.position = posbegin
-1 '位置计数首数不一样，这个对像是对0开始的
srmSource.CopyTo srmObj,posLen
srmObj.Position = 0
srmObj.Type = 2
srmObj.Charset = Charset '语言属性设置
strData = srmObj.ReadText
srmObj.Close
set srmObj = nothing
getTextfromBin = strData
end function
private function getSBfromDB(bytString) '双字节字符串转换成单字节字符串
dim bin, i
bin = ""
for i=1 to len(bytString)
bin = bin &
chrb(asc(mid(bytString,i,1)))
next
getSBfromDB = bin
end function
private function getDBfromSB(bitString) '单字节字符串转换成双字节字符串
dim str, i
str = ""
for i=1 to lenb(bitString)
str = str &
chr(ascb(midb(bitString,i,1)))
next
getDBfromSB = str
end function
private function getFileNamefromPath(strPath) '从一个完整路径中析出文件名称
getFileNamefromPath = mid(strPath,instrrev(strPath,"/")+1)
end function
public sub about() '关於类过程
dim html
html = "<table border=1 cellpadding=2 cellspacing=1>" &
"<tr>" &
_
"<td style='font-family:verdana;' bgcolor=yellow> <marquee width=160 " &
_
"onmouseover='this.stop();' onmouseout='this.start();'>" &
_
"<a href=mailto:java300@163com target=_blank>LiJun Upload Class V1.0</a>" &
_
"</marquee> </td>" &
"</tr>" &
"</table>"
Response.Write html
end sub
public function Form(strFormName) '求表单内容的函数
if dicForm.Exists(strFormName) then
Form = dicForm(strFormName)
else
Form = ""
end if
end function
public function File(strFormName) '求文件内容的函数
if dicFile.Exists(strFormName) then
set File = dicFile(strFormName)
else
set File = new LjFile
end if
end function
private sub Class_Terminate '类终止过程
dicForm.RemoveAll
set dicForm = nothing
dicFile.RemoveAll
set dicFile = nothing
srmRequestData.Close
set srmRequestData = nothing
end sub
end class
class LjFile '文件类
public FileName '文件名
public ContentType '文件类型
public Filebegin
'文件数据开始位置
public FileLen '文件长度，字节数
private sub Class_Initalize
FileName = ""
ContentType = ""
Filebegin
= 0
FileLen = 0
end sub
public sub SaveToFile(FilePath) '文件保存到磁盘上，FilePath为完整路径，包括文件名
dim srmObj
set srmObj = server.CreateObject("adodb.stream")
srmObj.Type = padTypeBinary
srmObj.Mode = ppadModeReadWrite
srmObj.Open
srmRequestData.Position = Filebegin
-1
srmRequestData.CopyTo srmObj, FileLen
srmObj.Position = 0
srmObj.SaveToFile FilePath, 2 '如果该文件已经存在，无条件覆盖，以後根据需要再行完善
srmObj.Close
set srmObj = nothing
end sub
public function GetBinaryData()
srmRequestData.Position = Filebegin
-1
GetBinaryData = srmRequestData.Read(FileLen)
end function
end class
</script>
－－－－－－－－－－－－－
