This example consists of two files: upload.htm and upload.asp. The first file contains the simple HTML form with field for file name, check box and "Send" button. The second file (ASP script) receives uploaded file, writes it to "c:\temp" directory, and reports all submitted form elements.
The script uses the Request.BinaryRead method available in IIS4.0
<HEAD>
<TITLE>Test form for uploading</TITLE>
</HEAD>
<BODY>
<FORM action="upload.asp" enctype="multipart/form-data" method="Post">
<INPUT name="data" type="file" size=30>
<BR>
<INPUT type="checkbox" name="chk" value=1> Check box
<BR>
<INPUT type="submit" value="Send">
</FORM>
</BODY>
| File upload.asp |
<%
'These variables are used in uploading subroutine
'The files will be uploaded into this temporary folder
tmp_directory="c:\temp"
Set sh_gr=CreateObject("shotgraph.image")
Set fs_obj=CreateObject("Scripting.FileSystemObject")
Main()
'You can replace this subroutine with your own code
Sub Main()
Response.Write "<H1>Uploading results</H1>"
t=DoUpload(names,values,filenames)
if not t then
Response.Write "<B>ERROR:</B> The data format is invalid or empty form has been submitted"
Exit Sub
end if
Response.Write "<DL>"
for i=0 to UBound(names)
if filenames(i)="" then
Response.Write "<DT><B>"&names(i)&"</B><DD>Form element is not file and equal "&values(i)
else
Response.Write "<DT><B>"&names(i)&"</B><DD>Form element is file and has been uploaded into "&values(i)
Response.Write " (The user name is "&filenames(i)&")"
'Here we have an opportunity to analize, move, or delete the file.
end if
Next
Response.Write "</DL>"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DO NOT EDIT VB CODE BELOW THIS LINE! '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The "DoUpload" function
'Return values are:
'True - success
'False - data format violation
'If successful, the DoUpload function returns the following three arrays:
' names
' The form element names.
' values
' The form element values. If appropriate form element is "file"
' type, the array element contains the full name of file in
' the tmp_directory
' filenames
' If array element does not contain empty string, the form element
' is a "file" type. In this case the array element contains the
' file name entered by user. This array is an criteria to check
' whether the form element is a "file" type.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function DoUpload(ByRef names, ByRef values, ByRef filenames)
DoUpload=False
content=LCase(Request.ServerVariables("CONTENT_TYPE"))
if InStr(content,"multipart/form-data")<>1 then Exit Function
boundary=GetParam(content,"boundary",present)
if boundary="" then Exit Function
boundary="--"&boundary
size=Request.TotalBytes
a=Request.BinaryRead(size)
maxcount=100
bnd=sh_gr.FindInBinary(a,boundary,0,UBound(a),maxcount)
if not IsArray(bnd) then Exit Function
if UBound(bnd)<=0 then Exit Function
for i=0 to UBound(bnd)-1
if DoFormValue(a,bnd(i)+Len(boundary)+2,bnd(i+1)-2-(bnd(i)+Len(boundary)+2),names,values,filenames) then DoUpload=True
Next
End Function
Function DoFormValue(a,start,size,ByRef names,ByRef values,ByRef filenames)
DoFormValue=False
maxval=1
hdr=sh_gr.FindInBinary(a,Chr(13)&Chr(10)&Chr(13)&Chr(10),start,size,maxval)
if not IsArray(hdr) then Exit Function
headstr=""
sh_gr.WriteBinary a,start,hdr(0)-start,headstr
if headstr="" then Exit Function
headers=Split(headstr,Chr(13)&Chr(10))
for i=0 to UBound(headers)
if InStr(LCase(headers(i)),"content-disposition: form-data")=1 then
formname=GetParam(headers(i),"name",present)
if not present then Exit For
formfilename=GetParam(headers(i),"filename",present)
if present then
if formfilename<>"" then
AddValue names,formname
AddValue filenames,formfilename
AddValue values,CreateFile(a,hdr(0)+4,start+size-(hdr(0)+4))
DoFormValue=True
end if
else
res=""
sh_gr.WriteBinary a,hdr(0)+4,start+size-(hdr(0)+4),res
AddValue values,res
AddValue names,formname
AddValue filenames,""
DoFormValue=True
end if
Exit For
end if
Next
End Function
Sub AddValue(ByRef ar,value)
Dim b()
a=ar
if IsArray(a) then
ReDim preserve a(UBound(a)+1)
else
ReDim b(0)
a=b
end if
a(UBound(a))=value
ar=a
End Sub
Function CreateFile(a,start,size)
Randomize()
Do
x=Rnd()*1000000.0
fname=tmp_directory&"\~upload"&CStr(x)
fname=Replace(fname,",",".")
Loop While fs_obj.FileExists(fname)
CreateFile=fname
if size>0 then
sh_gr.WriteBinary a,start,size,fname
else
Set h=fs_obj.CreateTextFile(fname,True)
h.Close()
Set h=Nothing
end if
End Function
Function GetParam(str,param,ByRef present)
GetParam=""
present=False
p=InStr(str,";")
if p=0 then Exit Function
p=p+1
p1=InStr(p,LCase(str),LCase(param)&"=")
if p1=0 then Exit Function
present=True
p1=p1+Len(param&"=")
p2=InStr(p1,str,";")
if p2>0 then res=Mid(str,p1,p2-p1) else res=Mid(str,p1)
if Left(res,1)="""" and Right(res,1)="""" then res=Mid(res,2,Len(res)-2)
GetParam=res
End Function
Function FindData(string_1,string_2)
p=InStr(LCase(string_1),string_2)
if p=0 then Exit Function
p2=InStr(p+Len(string_2),string_1,";")
if p2<>0 then
result=Mid(string_1,p+Len(string_2),p2-p-Len(string_2))
else
result=Mid(string_1,p+Len(string_2))
end if
if Left(result,1)="""" then result=Mid(result,2,Len(result)-2)
FindData=result
End Function
%>
|
Uploading results
|
Back to examples