无组件上传问题

[爱英思躺]

无组件上传已经有很多不错的解决方案。
但如何获取MIME类型为multipart/form-data的FORM内的<input type="text" >内的值呢？请高手指教。

[爱英思躺]

没人更我，我自己UP一下

[爱英思躺]

没人知道吗？

[Struggling]

http://pgm.w918.com/upload3.5.rar

[csclove]

enctype="multipart/form-data"

[hillhero789]

Function BinaryToString(str)
strto = ""
for i=1 to lenb(str)
if AscB(MidB(str, i, 1)) > 127 then
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
i = i + 1
else
strto = strto & Chr(AscB(MidB(str, i, 1)))
end if
next
BinaryToString=strto
End Function

function gainformdata(n)
dim formsize,formdata,divider,datastart,dataend
redim mydata(n-1)
formsize = Request.TotalBytes
formdata = Request.BinaryRead(formsize)
for i=1 to n
bncrlf = chrB(13) & chrB(10)
divider = leftB(formdata,clng(instrB(formdata,bncrlf))-1)
datastart = instrB(formdata,bncrlf & bncrlf)+4
dataend = instrB(datastart+1,formdata,divider) - datastart-2
mydata(i-1) = midB(formdata,datastart,dataend)
formdata=rightB(formdata,clng(formsize-instrB(datastart+1,formdata,divider))+1)
formsize=lenB(formdata)
next
gainformdata=mydata
end function


譬如说你的页面有3个表单（第一个是文本，第二个是file，第三个是文本），那么你可以这样调用
data=gainformdata(3)
rs("txt1")=BinaryToString(data(0)) '该字段为文本
rs("img")=data(1) '该字段为图片
rs("txt2")=data(2) '该字段为文本

[TonyAmanda]

对于无组件上传的问题,那就送上两页代码吧,希望能够派上用处.
<!--
完成上传功能，使用GetUpload()函数得到Fields类型返回值，
使用BinaryToString()和StringToBinary()函数实现转化。
-->
<%
'限制上传图片大小
Dim UploadSizeLimit

'********************************** 得到上传数据 **********************************'
Function GetUpload()
Dim Result
Set Result = Nothing
Set errchk=Nothing
if Request.ServerVariables("REQUEST_METHOD") = "POST" Then '检查表单是否以POST形式提交'
Dim CT, PosB, Boundary, Length, PosE,errtxt
CT = Request.ServerVariables("HTTP_Content_Type") '读取前页文件头'
'Response.Write "<script>alert ('"+CT+"');
'Response.End
if LCase(Left(CT, 19)) = "multipart/form-data" Then '检查表单的Content是以multipart/form-data形式提交'
PosB = InStr(LCase(CT), "boundary=") '找到内容的分界'
if PosB > 0 Then Boundary = Mid(CT, PosB + 9) '划出内容部分'
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) '给出上传文件的大小'
if "" & UploadSizeLimit<>"" then '如果有图片上传限制就对比上传文件，否则无限制'
UploadSizeLimit = clng(UploadSizeLimit)
if Length > UploadSizeLimit then
Request.BinaryRead(Length)
exit Function
end if
end if

if Length > 0 And Boundary <> "" Then '判断是否有数据提交'
Boundary = "--" & Boundary
Dim Head, Binary
Binary = Request.BinaryRead(Length) 'Reads binary data from client'

'得到上传文件的解决数据'
Set Result = SeparateFields(Binary, Boundary)
Binary = Empty 'Clear variables'
End if
End if
End if

Set GetUpload = Result
End Function


Function SeparateFields(Binary, Boundary) ''对上传的内容分别进行函数换算'
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Dim Fields
Boundary = StringToBinary(Boundary)

PosOpenBoundary = InstrB(Binary, Boundary)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
'Header and file/source field data'
Dim HeaderContent, FieldContent
'Header fields'
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Helping variables'
Dim Field, TwoCharsAfterEndBoundary
'Get end of header'
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Separates field header'
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Separates field content'
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Separates header fields from header'
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Create one field and assign parameters'
Set Field = CreateUploadField()
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Field.Value = FieldContent
Field.Length = LenB(FieldContent)
Fields.Add FormFieldName, Field

'看看是否结束对上传内容的分析？'
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary Then 'This is not ending boundary - go to next form field.'
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
End If
Loop
Set SeparateFields = Fields
End Function

'********************************** Utilities **********************************'
Function BinaryToString(str)
strto = ""
for i=1 to LenB(str)
if AscB(MidB(str, i, 1)) > 127 then
strto = strto & Chr(AscB(MidB(str, i, 1))*256+AscB(MidB(str, i+1, 1)))
i = i + 1
else
strto = strto & Chr(AscB(MidB(str, i, 1)))
end if
next
BinaryToString=strto
End Function

Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B + ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function

'Separates header fields from upload header
Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Name = (SeparateField(Head, "name=", ";")) 'ltrim
If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function

'找出上传文件的开始和结束的位置
Function SeparateField(From, ByVal sStart, ByVal sEnd)
Dim PosB, PosE, sFrom
sFrom = LCase(From)
PosB = InStr(sFrom, sStart)
If PosB > 0 Then
PosB = PosB + Len(sStart)
PosE = InStr(PosB, sFrom, sEnd)
If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
If PosE = 0 Then PosE = Len(sFrom) + 1
SeparateField = Mid(From, PosB, PosE - PosB)
Else
SeparateField = Empty
End If
End Function

'对文件名进行检测并得出结果
Function GetFileName(FullPath)
Dim Pos, PosF
PosF = 0
For Pos = Len(FullPath) To 1 Step -1
Select Case Mid(FullPath, Pos, 1)
Case "/", "\": PosF = Pos + 1: Pos = 0
End Select
Next
If PosF = 0 Then PosF = 1
GetFileName = Mid(FullPath, PosF)
End Function
%>
<script language="JavaScript" runat="server">
//The function creates Field object.
function CreateUploadField(){ return new uf_Init(); }
function uf_Init(){
this.Name = null;
this.ContentDisposition = null;
this.FileName = null;
this.FilePath = null;
this.ContentType = null;
this.Value = null;
this.Length = null;
}
</script>

[TonyAmanda]

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include File="fUpload.asp"-->
<!--#include File="Connection.asp"-->
<%
'Response.Write Request.Form("Uploaded")
'nmnnjjnnnbbbbbbbbbbbbbbbbResponse.End
If Request.Form("Descr")<>"" Then
Dim Field,Fields
Dim Filename,FileType,FileValue,Descr
Set Fields=GetUpload()
For Each Field In Fields.Items
Select Case Field.Name
Case "imgUp"
Filename=Field.Filename
Response.Write "<Script>alert("+Chr(34)+Filename+Chr(34)+");</script>"
FileType=Field.ContentType
FileValue=Field.Value
Case "Description"
Descr=Field.Descr
End Select
Next

If FileType<>"image/gif" And FileType<>"image/pjpeg" Then
Session("strMsg")="必须上传图片文件!!!"
Session("strURL")="Upload_Photo.asp"
Response.Redirect "Alert.asp"
End If

Dim tempPos
tempPos=InStr(Filename,"/")

Dim FSO,tStream
Set FSO=CreateObject("Scripting.FileSystemObject")
Set tStream=FSO.OpenBinaryFile(Filename,ForAppending,True)

MyConn.Execute "INSERT INTO Photos (Name,URL) VALUES ('"+Descr+"','"+Filename+"'"
Else
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="CSS/Main.css" rel="stylesheet" type="text/css">

<script language="JavaScript">
function check()
{
if (document.Upload.imgUp.value=="" ) alert("没有选择图片!!!");
else
{
if (document.Upload.Descr.value=="" )
{
Upload.Descr.value="[没有说明]";
//Upload.Uploaded.value="1";
}
Upload.submit();
}
}
</script>

</head>

<body class="clgreen" bgcolor="#DDDDDD">
<form action="Upload_Photo.asp" method="post" enctype="multipart/form-data" name="Upload">
<table width="100%" border="0" cellspacing="0" cellpadding="0" height="100%">
<tr>
<td align="center"><font size="2">自定义图片</font></td>
</tr>
<tr>
<td align="center"><input type="file" name="imgUp" style="WIDTH:100%;HEIGHT:16px"></td>
</tr>
<tr>
<td align="center"><font size="2">图片说明</font></td>
</tr>
<tr>
<td align="center"><input type="text" name="Descr" style="WIDTH:100%;HEIGHT:16px"></td>
</tr>
<tr>
<td align="center"><input type="button" name="PicUpload" value="上传" onClick="javascript:check()">     <input type="reset" name="Reset" value="清理">
<input type="hidden" name="Uploaded" value="False">
</td>
</tr>
</table>
</form>
</body>
</html>
<%
End If
%>