这个在asp和cgi里面都是分析传送上来的数据就可以了
代码如下，这个函数是把接收到的文件和一些提交上来的值放在了Scripting.Dictionary
里了，其实也没什么，就是找到各个的界线地方，然后分析
function GetUpload()
Dim Result
Set Result = Nothing
dim CT,PosB, Boundary, Length, PosE
'This is upload request.
'Get the boundary and length from Content-Type header
CT=Request.ServerVariables("HTTP_CONTENT_TYPE")
PosB = InStr(LCase(CT), "boundary=") 'Finds boundary
if PosB > 0 then Boundary = Mid(CT, PosB + 9) 'Separetes boundary
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
if Length > UploadSizeLimit then
'Request.BinaryRead (Length)
Session("sysMsg")="The File you upload exceeds limit of " & FormatNumber(UploadSizeLimit, 0) & "B<br>"
Session("sysMsg")= Session("sysMsg") &"<a href=""javascript:history.back()"">back</a>"
Randomize
Response.Redirect "showMessage.asp?ra="&rnd
end If
If Length > 0 And Boundary <> "" Then 'Are there required informations about upload ?
Boundary = "--" & Boundary
dim Head, Binary
Binary = Request.BinaryRead(Length) 'Reads binary data from client
'Retrieves the upload fields from binary data
set Result = SeparateFields(Binary, Boundary)
Binary = Empty 'Clear variables
else
Session("sysMsg")="The File you upload size is Zero"
Session("sysMsg")= Session("sysMsg") &"<a href=""javascript:history.back()"">back</a>"
Randomize
Response.Redirect "showMessage.asp?ra="&rnd
end If
set GetUpload = Result
end function
'********************************** SeparateFields **********************************
'This function retrieves the upload fields from binary data and retuns the fields as array
'Binary is safearray of all raw binary data from input.
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)
'Response.Write FormFieldName&"*"&BinaryToString(Field.Value)&"#<br>"
Fields.Add FormFieldName, Field
'Is this ending boundary ?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
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(Binary)
Dim I, S
for I=1 to LenB(Binary)
S = S & Chr(AscB(MidB(Binary,I,1)))
next
BinaryToString = S
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
'Separets one filed between sStart and sEnd
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
'Separetes file name from the full path of file
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 RUNAT=SERVER LANGUAGE=JavaSCRIPT>
//The function creates Field object. I'm sorry to use JavaScript, but VBScript can't create custom objects till version 5.0
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>
<br>