高分程序
求无组件文件上传的例子，能发到我的信箱更好！
panqijun_jacke@sohu
不是化境编程界- 化境ASP无组件上传程序，希望可以直接使用的
问题点数：100、回复次数：9Top
1 楼popcode（枫.net）回复于 2002-05-24 01:57:13 得分 3
那个不能用吗？Top
2 楼saucer（思归）回复于 2002-05-24 02:57:25 得分 10
多表单域无组件文件上传的例子 tripofdream（收藏)
http://www.csdn.net/Develop/article/13%5C13134.shtm
look here:
http://cn.google.yahoo.com/bin/query_cn?p=%ce%de%d7%e9%bc%fe+%ce%c4%bc%fe+%c9%cf%b4%ab&u=B&hc=0&hs=0Top
3 楼ChinaOk（农村表哥）回复于 2002-05-24 08:00:27 得分 15
http://www.chinaok.net/down/upload.rar
根据化境编程界- 化境ASP无组改写。去掉了那个dirationy的要求。可以在普通空间使用。Top
4 楼shadowkiss（逸飞）回复于 2002-05-24 08:18:58 得分 15
http://www.chinaok.net/down/upload.rar is ok..Top
5 楼xxjmz_78（阿甘）回复于 2002-05-25 10:37:50 得分 25
支持中文的无组件文件上传
2001:8:16
《支持中文的无组件文件上传》-- upload.inc
作者：woozhj
文件名：upload.inc
说明：支持中文的无组件文件上传ASP函数，由于ASP不支持二进制写入文件，所以存成文件时必须使用组件，本函数只提供截取上传文件的数据，可以写入到数据库。
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Function GetUpload(FormData)
Dim DataStart,DivStr,DivLen,DataSize,FormFieldData
'分隔标志串(+CRLF)
DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)
'分隔标志串长度
DivLen = LenB(DivStr)
PosOpenBoundary = InStrB(FormData,DivStr)
PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
Set Fields = CreateObject("Scripting.Dictionary")
While PosOpenBoundary > 0 And PosCloseBoundary > 0
'name起始位置(name="xxxxx")，加6是因为[name="]长度为6
FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) + 6
FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) - FieldNameStart '(")的ASC值=34
FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))
'filename起始位置(filename="xxxxx")
FieldFileNameStart = InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10
If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart > PosopenBoundary Then
FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) - FieldFileNameStart '(")的ASC值=34
FormFileName = bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize))
Else
FormFileName = ""
End If
'Content-Type起始位置(Content-Type: xxxxx)
FieldFileCTStart = InStrB(PosOpenBoundary,FormData,str2bin("Content-Type:")) + 14
If FieldFileCTStart < PosCloseBoundary And FieldFileCTStart > PosOpenBoundary Then
FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf & VbCrLf)) - FieldFileCTStart
FormFileCT = bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize))
Else
FormFileCT = ""
End If
'数据起始位置：2个CRLF开始
DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4
If FormFileName <> "" Then
'数据长度，减1是因为数据文件的存取字节数问题(可能是AppendChunk方法的问题)：
'由于字节数为奇数的图象存到数据库时会去掉最后一个字符导致图象不能正确显示,
'字节数为偶数的数据文件就不会出现这个问题，因此必须保持字节数为偶数。
DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1
FormFieldData = MidB(FormData,DataStart,DataSize)
Else
'数据长度，减2是因为分隔标志串前有一个CRLF
DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2
FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))
End If
'建立一个Dictionary集存储Form中各个Field的相关数据
Set Field = CreateUploadField()
Field.Name = FormFieldName
Field.FilePath = FormFileName
Field.FileName = GetFileName(FormFileName)
Field.ContentType = FormFileCT
Field.Length = LenB(FormFieldData)
Field.Value = FormFieldData
Fields.Add FormFieldName, Field
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
Wend
Set GetUpload = Fields
End Function
'把二进制字符串转换成普通字符串函数
Function bin2str(binstr)
Dim varlen,clow,ccc,skipflag
'中文字符Skip标志
skipflag=0
ccc = ""
If Not IsNull(binstr) Then
varlen=LenB(binstr)
For i=1 To varlen
If skipflag=0 Then
clow = MidB(binstr,i,1)
'判断是否中文的字符
If AscB(clow) > 127 Then
'AscW会把二进制的中文双字节字符高位和低位反转，所以要先把中文的高低位反转
ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow))
skipflag=1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag=0
End If
Next
End If
bin2str = ccc
End Function
'把普通字符串转成二进制字符串函数
Function str2bin(varstr)
str2bin=""
For i=1 To Len(varstr)
varchar=mid(varstr,i,1)
varasc = Asc(varchar)
' asc对中文字符求出来的值可能为负数，
' 加上65536就可求出它的无符号数值
' -1在机器内是用补码表示的0xffff,
' 其无符号值为65535,65535=-1+65536
' 其他负数依次类推。
If varasc<0 Then
varasc = varasc + 65535
End If
'对中文的处理：把双字节低位和高位分开
If varasc>255 Then
varlow = Left(Hex(Asc(varchar)),2)
varhigh = right(Hex(Asc(varchar)),2)
str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)
Else
str2bin = str2bin & chrB(AscB(varchar))
End If
Next
End Function
'取得文件名(去掉Path)
Function GetFileName(FullPath)
If FullPath <> "" Then
FullPath = StrReverse(FullPath)
FullPath = Left(FullPath, InStr(1, FullPath, "\") - 1)
GetFileName = StrReverse(FullPath)
Else
GetFileName = ""
End If
End Function
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
this.Name = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>
Top
6 楼xxjmz_78（阿甘）回复于 2002-05-25 10:39:06 得分 20
支持中文的无组件文件上传-- 示例
2001:8:16
来源：chinaasp
作者： woozhj
文件：uploadtest.asp
<html>
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<body bgcolor="#FFFFFF">
<form method="post" name="form1" enctype="multipart/form-data" action="showdata.asp">
<p>text1:
<input type="text" name="text1">
</p>
<p>text2:
<input type="text" name="text2">
</p>
<p>txtarea:
<textarea name="textfield" cols="20" rows="10"></textarea>
</p>
<p>file:
<input type="file" name="newfile">
</p>
<p>
<input type="submit" name="Submit" value="Submit">
<input type="reset" name="Reset" value="Reset">
</p>
</form>
</body>
</html>
文件：showdata.asp
<!--#INCLUDE FILE="upload.inc"-->
<%
'Fields("xxx").Name 取得Form中xxx(Form Object)的名字
'Fields("xxx").FilePath 如果是file Object 取得文件的完整路径
'Fields("xxx").FileName 如果是file Object 取得文件名
'Fields("xxx").ContentType 如果是file Object 取得文件的类型
'Fields("xxx").Length 取得Form中xxx(Form Object)的数据长度
'Fields("xxx").Value 取得Form中xxx(Form Object)的数据内容
Dim FormData,FormSize
FormSize=Request.TotalBytes
FormData=Request.BinaryRead(FormSize)
Set Fields = GetUpload(FormData)
response.write "text1:" & Fields("text1").Value & "
" & VbCrLf
response.write "text2:" & Fields("text2").Value & "
" & VbCrLf
response.write "textarea:" & Fields("textfield").Value & "
" & VbCrLf
response.write Fields("newfile").FileName
response.write Fields("newfile").ContentType
Response.ContentType = Fields("newfile").ContentType
If Fields("newfile").FileName<>"" Then
Response.ContentType = Fields("newfile").ContentType
response.binarywrite Fields("newfile").Value
End If
'Response.BinaryWrite FormData
%>
Top
7 楼yun15291li（秋飞意）回复于 2002-05-25 10:44:49 得分 10
偶也有一个程序只是也是有那个化境改版过来的。
不过功能可强大多了。
不知道要不？Top
8 楼funboy88（司令）回复于 2002-05-25 10:49:11 得分 2
到网上找找哟Top
9 楼jacke_pan（妙有）回复于 2002-05-28 19:52:06 得分 0
先谢谢你们，这些我都有，化境编程界的只能在win2000server下运行，
不过分还是照给你们，不过你们还是帮我留意 一下,ok…~Top
