<!--#include file= "Upload.inc"-->
<%
Dim upload,file,formname,formpath,icount,filename,fileext
Set upload=new upload_5xsoft ' Build upload Object
Formpath= "Uploadimages/"
"Add (/) to the directory
If Right (formpath,1) <> "/" Then formpath=formpath& "/"
Icount=0
For every formName in Upload.file ' lists all uploaded files
Set File=upload.file (formName) ' generates a File object
If File.filesize<100 Then
Response.Write "<font size=3><br> please first select the pictures you want to upload [<a href=# onclick=history.go ( -1) > re-upload </a>] </font> "
Response.End
End If
If file.filesize>1000000 Then
Response.Write "<font size=3><br> picture size exceeded limit [<a href=# onclick=history.go ( -1) > re-upload </a>]</ Font> "
Response.End
End If
Fileext=lcase (Right (file.filename,4))
If fileext<> ". jpg" and fileext<> ". gif" Then
Response.Write "<font size=3><br> file format can only be JPG and GIF format [<a href=# onclick=history.go ( -1) > re-upload </a >]</font> "
Response.End
End If
Randomize
Rannum=int (90000*RND) +10000
Filename=formpath&year (now) &month-&day (now) &hour (now) &minute (now) &second (now) & Fileext
Filename1=year (now) &month (now), &day (now), &hour (now) &minute (now) &second
If file. Filesize>0 Then ' if FileSize > 0 indicates file data
File. SaveAs server.mappath (filename) ' Save file '
Response.Write "<script>parent.form1.img.value= '" &FileName1& "' </script>"
Icount=icount+1
End If
Set file=nothing
Next
Set Upload=nothing ' Deletes this object
Response.Write " '
Response.End
%>
Here is the code for UPLOAD.INC.
<script Runat=server language=vbscript>
Dim Upfile_5xsoft_stream
Class Upload_5xsoft
Dim form,file,version
Private Sub Class_Initialize
Dim istart,ifilenamestart,ifilenameend,iend,vbenter,iformstart,iformend,thefile
Dim strdiv,mformname,mformvalue,mfilename,mfilesize,mfilepath,idivlen,mstr
If Request.totalbytes<1 then Exit Sub
Set Form=createobject ("Scripting.Dictionary")
Set File=createobject ("Scripting.Dictionary")
Set Upfile_5xsoft_stream=createobject ("ADODB.stream")
Upfile_5xsoft_stream.mode=3
Upfile_5xsoft_stream.type=1
Upfile_5xsoft_stream.open
Upfile_5xsoft_stream.write Request.BinaryRead (request.totalbytes)
VBENTER=CHR (&CHR) (10)
Idivlen=instring (1,vbenter) +1
Strdiv=substring (1,idivlen)
Iformstart=idivlen
Iformend=instring (Iformstart,strdiv)-1
While Iformstart < Iformend
Istart=instring (Iformstart, "name=" "")
Iend=instring (Istart+6, "" "")
Mformname=substring (istart+6,iend-istart-6)
Ifilenamestart=instring (iend+1, "filename=" "")
If Ifilenamestart>0 and Ifilenamestart<iformend then
Ifilenameend=instring (ifilenamestart+10, "" "")
Mfilename=substring (IFILENAMESTART+10,IFILENAMEEND-IFILENAMESTART-10)
Istart=instring (Ifilenameend+1,vbenter&vbenter)
Iend=instring (Istart+4,vbenter&strdiv)
If Iend>istart Then
Mfilesize=iend-istart-4
Else
Mfilesize=0
End If
Set Thefile=new FileInfo
Thefile.filename=getfilename (Mfilename)
Thefile.filepath=getfilepath (Mfilename)
Thefile.filesize=mfilesize
Thefile.filestart=istart+4
Thefile.formname=formname
File.add Mformname,thefile
Else
Istart=instring (Iend+1,vbenter&vbenter)
Iend=instring (Istart+4,vbenter&strdiv)
If Iend>istart Then
Mformvalue=substring (istart+4,iend-istart-4)
Else
Mformvalue= ""
End If
Form. ADD Mformname,mformvalue
End If
Iformstart=iformend+idivlen
Iformend=instring (Iformstart,strdiv)-1
Wend
End Sub
Private Function subString (Thestart,thelen)
Dim i,c,stemp
Upfile_5xsoft_stream.position=thestart-1
Stemp= ""
For I=1 to TheLen
If Upfile_5xsoft_stream.eos then Exit for
C=ASCB (Upfile_5xsoft_stream.read (1))
If C > 127 Then
If Upfile_5xsoft_stream.eos then Exit for
STEMP=STEMP&CHR (AscW (ChrB (AscB (Upfile_5xsoft_stream.read (1)) &CHRB (c)))
I=i+1
Else
STEMP=STEMP&CHR (c)
End If
Next
Substring=stemp
End Function
Private Function instring (THESTART,VARSTR)
Dim i,j,bt,thelen,str
Instring=0
Str=tobyte (VARSTR)
Thelen=lenb (STR)
For I=thestart to Upfile_5xsoft_stream.size-thelen
If I>upfile_5xsoft_stream.size then Exit Function
Upfile_5xsoft_stream.position=i-1
If AscB (Upfile_5xsoft_stream.read (1)) =ASCB (MidB (str,1)) Then
Instring=i
For j=2 to TheLen
If Upfile_5xsoft_stream.eos Then
Instring=0
Exit for
End If
If AscB (Upfile_5xsoft_stream.read (1)) <>ASCB (MidB (str,j,1)) Then
Instring=0
Exit for
End If
Next
If Instring<>0 then Exit Function
End If
Next
End Function
Private Sub class_terminate
form. RemoveAll
file. RemoveAll
Set form=nothing
set file=nothing
Upfile_5xsoft_stream.close
set up File_5xsoft_stream=nothing
End Sub
private function GetFilePath (fullpath)
If fullpath <> "Then
GetFilePath = Left (Fullpath,instrrev (FullPath," "))
E LSE
GetFilePath = "
end If
End function
private function GetFileName (fullpath)
If fullpath <> "" Then
GetFileName = Mid (Fullpath,instrrev (FULLP Ath, "") +1
Else
getfilename = "
end If
End function
Private function ToByte (STR)
Dim I,icode,c,ilow,ihigh
Tobyte= ""
For I=1 to Len (STR)
C=mid (str,i,1)
Icode =ASC (c)
If icode<0 Then icode = Icode + 65535
If icode>255 Then
Ilow = Left (Hex (ASC (c)), 2)
Ihigh =right (Hex (ASC (c)), 2)
ToByte = ToByte & ChrB ("&h" &ilow) & ChrB ("&h" &ihigh)
Else
ToByte = ToByte & ChrB (AscB (c))
End If
Next
End Function
End Class
Class FileInfo
Dim Formname,filename,filepath,filesize,filestart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
filestart= 0
FormName = ""
End Sub
Public Function SaveAs (fullpath)
Dim dr,errorchar,i
Saveas=1
If trim (fullpath) = "" or filesize=0 or filestart=0 or filename= "" Then Exit function
If Filestart=0 or right (fullpath,1) = "/" Then Exit function
Set Dr=createobject ("ADODB.stream")
Dr. Mode=3
Dr. Type=1
Dr. Open
Upfile_5xsoft_stream.position=filestart-1
Upfile_5xsoft_stream.copyto dr,filesize
Dr. SaveToFile fullpath,2
Dr. Close
Set dr=nothing
Saveas=0
End Function
End Class
</SCRIPT>