Question

VBSCRIPT script problem with clsUpload.asp

Asked by: frasierphilips

I am having a major headache with an ASP based VBSCRIPT file - I have already posted one question on this subject but it ground to a halt.  Now I've had more time to think about it, I want to rephrase my question.

The ASP/VBSCRIPT file is hosted on a commercial ISP (1 & 1) - their technical help has been next to useless, giving me incorrect information on one occasion.

Basically the problem is this, I need to upload a file from an HTML form along with several text fields.   I am using the widely available clsUpload.asp to retrieve the sent data - it is included at the head of the .asp file which captures the transmitted data.

Whilst everything appears to be working fine, with all the data arriving at the server, the filename of the uploaded file does not seem to be being transmitted (the file itsself is, I can Save it onto the server if I directly specify a filename).

Does anyone know why this could be happening?  I have attached a stripped down version of the form HTML file and the receiving ASP file.  I would ideally like a solution but if I can determine why it's happening I can perhaps approach the ISP.

FORM FILE:-
<html>
 
<head>
<meta http-equiv="content-type" content="text/html;charset=iso-8859-1">
<title>Whitby Hospitality Association</title>
 
</head>
 
<body marginwidth="0" marginheight="0" leftmargin="0" topmargin="0" bgcolor="white">
 
<FORM method="post" encType="multipart/form-data" ACTION="asend.asp">
 
<div align="center">
 
<table cellpadding="0" cellspacing="0" border="0" width="600">
 
<tr>
	<td valign="top" align="left" width="600">
 
		<input type="hidden" name="ssid" value="<%=mySessionID%>">
		<p class="form">Email All Members<br><br>
 
		Subject:<br>
		<input type="text" name="subject" size="48" class="text" value="WHA Contact"><br><br>
 
		Text:<br>
		<textarea name="body" cols="40" rows="8"></textarea>
		<br>&nbsp;<br>
 
		Select a document to upload (if required):<br>
		<INPUT TYPE=FILE SIZE=40 NAME="File1" class="button">
		<br><br>
		
		<INPUT TYPE="submit" NAME="cmdSubmit" VALUE="Send Email to ALL members">&nbsp;&nbsp;&nbsp;
		<input type="reset" value="Clear Form">
	</td>
</tr>
	
<tr>
	<td valign="top" align="left" width="600"><img src="../images/space.gif" width="600" height="4" border="0" alt="">
	</td>
</tr>
 
</table>
 
</div>
 
</form>
 
</body>
 
</html>
 
 
RECEIVING FILE
<%@ Language=VBScript %>
 
<!--#INCLUDE FILE="clsUpload.asp"-->
 
<html>
 
<head>
<meta http-equiv="content-type" content="text/html;charset=iso-8859-1">
<title>Whitby Hospitality Association</title>
</head>
 
<body marginwidth="0" marginheight="0" leftmargin="0" topmargin="0" bgcolor="white">
 
<%
Set objUpload = New clsUpload
 
body = objUpload.Fields("body").Value
subject = objUpload.Fields("subject").Value
%>
 
Received<br><br>
 
<%
if objUpload.Fields("File1").Length > 0 then
	
	strFileName = objUpload.Fields("File1").FileName
	strPath = Server.MapPath("docs") & "\" & strFileName
 
	Response.Write body & "<br><br>"
	Response.Write subject & "<br><br>"
	Response.Write strFileName
 
end if
 
%>
 
</body>
 
</html>

                                  
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:

Select allOpen in new window

This Question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

  • Plus...
  • 30 Day FREE access, no risk, no obligation
  • Collaborate with the world's top tech experts
  • Unlimited access to our exclusive solution database
  • Never be left without tech help again

Subscribe Now

Asked On
2009-09-05 at 14:20:22ID24710260
Tags

ASP VBSCRIPT clsUpload

Topics

VB Script

,

Active Server Pages (ASP)

Participating Experts
2
Points
500
Comments
6

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

  • "The time we save is the biggest benefit of Experts Exchange to Warner Bros. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange." Mike Kapnisakis, Warner Bros.
  • "Our team likes having a resource that is more secure than just using Google and most experts using this service really know their stuff. It's nice to look here first versus using Google." Dayna Sellner, Lockheed Martin
  • "Anytime that I've been stumped with a problem, 9 out of 10 times Experts Exchange has either the accepted solution or an open discussion of the potential solution to the problem." Kenny Red, eBay Inc.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Experts Exchange has been collecting answers to technology questions since 1996…3 million and counting! If you have a question, chances are we already have your answer.

Screenshot of Experts Exchange Knowledgebase

Need individual assistance?

Our experts are ready to help.

If you can't find the exact answer you're looking for, ask our exclusive community of 50,000 experts. You’ll get a personalized answer from a trusted professional.

Screenshot of Experts Exchange Knowledgebase

Want to learn from the best?

Read articles from industry experts.

Thousands of free tech tips, tricks, how-to’s and tutorials are available in our peer reviewed articles section. See for yourself how smart our experts are, no login required.

Screenshot of an Article

Working on a long term project?

Store your work and research.

Save solutions to your questions, answers you’ve discovered through searching plus helpful articles in your personal knowledgebase for easy future access.

Screenshot of Experts Exchange Knowledgebase

Access the answers to your technology questions today.

Subscribe Now

30-day free trial. Register in 60 seconds.

What Makes Experts Exchange Unique?

Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.

Trusted by the world's most respected brands.

image of each brand's logo

Faithfully serving IT professionals since 1996.

Experts Exchange Logo

Try it out and discover for yourself.

Subscribe Now

30-day free trial. Register in 60 seconds.

Related Solutions

  1. VBScripting
    I am developing some webpages that will include database activity, but am having trouble with getting basic vbscripts to run under the Netscape brower family. All scripts work properly using IE 4.01. I have searched the Netscape FAQ's and found nothing that discusses the us...
  2. VBScript
    Hi, How can I use VBScript to detect the browser that I am using .
  3. VBScript
    i have a question bout writing vbscript in unix. i was wondering how do i write it like what software would i use to write it in and how do you run it in unix? or is there a way to write vbscript in unix all together? thanks for your time bigk
  4. vbscript
    is vbscript in web pages widely used? can it be used by any modern browser? thanks!
  5. VBscript
    Hi, Is there a vbscript code to check if a machine is PXE-enabled or not? Is there a class in WMI that is used to check if the machine is PXE-Enabled? Thanks, Joseph.

Free Tech Articles

  1. WARNING: 5 Reasons why you should NEVER fix a computer for free.
    It is in our nature to love the puzzle. We are obsessed. The lot of us. We love puzzles. We love the challenge. We thrive on finding the answer. We hate disarray. It bothers us deep in our soul. W...
  2. SCCM OSD Basic troubleshooting
    SCCM 2007 OSD is a fantastic way to deploy operating systems, however, like most things SCCM issues can sometimes be difficult to resolve due to the sheer volume of logs to sift through and the dispe...
  3. Migrate Small Business Server 2003 to Exchange 2010 and Windows 2008 R2
    This guide is intended to provide step by step instructions on how to migrate from Small Business Server 2003 to Windows 2008 R2 with Exchange 2010. For this migration to work you will need the fo...
  4. Create a Win7 Gadget
    This article shows you how to create a simple "Gadget" -- a sort of mini-application supported by Windows 7 and Vista. Gadgets can be dropped anywhere on the desktop to provide instant information, ...
  5. Outlook continually prompting for username and password
    There have been a lot of questions recently regarding Outlook prompting for a username and password whilst using Exchange 2007. There are a few reasons why this would happen and I will try to cover t...
  6. Backup Exchange 2010 Information Store using Windows Backup
    There seems to be quite a lot of confusion around the ability to backup Exchange 2010 using the built in Windows Backup feature. This stems from the omission of this feature prior to Exchange 2007 s...

Cloud Class Webinars

  1. Avoiding Bugs in Microsoft Access
    Alison Balter takes and in-depth look at avoiding bugs in Access. In this webinar you will learn about using the immediate window to debug your applications, invoking the debugger, using breakpoints to troubleshoot, stepping through code, setting the next statement to execute, ...
  2. Top 10 Best New Features in Visio 2010
    Scott Helmers gives live demonstrations of the top 10 new features in Visio 2010. This webinar will teach you how to create compelling diagrams by adding shapes to the page with a single click, linking the shapes in a diagram to data in Excel (or SQL Server, or SharePoint), ...
  3. IT Consultant Business Secrets Revealed
    Michael Munger, Experts Exchange tech pro and IT consultant, pulls back the curtain on his very successful businesses and answers question on every IT consultant and business owner should know about. He shares secrets on what he did to solve the 5 most common problems in IT, ...
  4. Disaster Recovery and Business Continuity
    Quest CTO, Mike Billon, gives an overview of the steps involved in building a dunamic disaster recovery plan. Through case studies and an examination of software/hardware tooles for monitoring and testing, you'll gain a better understandin of where you are, where you want ...
  5. Organize Your Visio Diagrams with Containers and Lists
    Scott Helmers uses cross functional flowcharts, wireframe diagrams, data graphic legends and seating charts to teach you: how to ustilize all three new structured diagram components in Visio 2010, the best practices for organizeing shapes in previous version of Visio, how to organize ...
  6. How to Us Objects, Properties, Events and Methods in Microsoft Access
    Alison Dalter gives an in-depbth look at objects, properties, events and methods in Microsoft Access. In this webinar you will learn about using the object browser, referring to objects, working with properties and methods, working with object variables, understanding the ...

Join the Community

Give a Little. Get a Lot.

Join the community of experts here and help other tech pros by answering question in your area of expertise. You can earn FREE access to all Experts Exchange's premium features and resources.

Join the Community

Answers

 

by: poweraddictPosted on 2009-09-05 at 23:24:06ID: 25268880

please post the code of clsUpload

 

by: frasierphilipsPosted on 2009-09-06 at 12:48:50ID: 25271231

clsUpload.asp is a freeware file.  It's attached below, with a required file clsField.asp tagged on afterwards.

CLSUPLOAD
 
-------------------------------
 
<!--METADATA
	TYPE="TypeLib"
	NAME="Microsoft ActiveX Data Objects 2.5 Library"
	UUID="{00000205-0000-0010-8000-00AA006D2EA4}"
	VERSION="2.5"
-->
<!--#INCLUDE FILE="clsField.asp"-->
<%
' ------------------------------------------------------------------------------
'	Author:		Lewis Moten
'	Email:		Lewis@Moten.com
'	URL:		http://www.lewismoten.com
'	Date:		March 19, 2002
' ------------------------------------------------------------------------------
 
' Upload class retrieves multi-part form data posted to web page
' and parses it into objects that are easy to interface with.
' Requires MDAC (ADODB) COM components found on most servers today
' Additional compenents are not necessary.
'
' Demo:
'	Set objUpload = new clsUpload
'		Initializes object and parses all posted multi-part from data.
'		Once this as been done, Access to the Request object is restricted
'
'	objUpload.Count
'		Number of fields retrieved
'
'		use: Response.Write "There are " & objUpload.Count & " fields."
'
'	objUpload.Fields
'		Access to field objects.  This is the default propert so it does
'		not necessarily have to be specified.  You can also determine if
'		you wish to specify the field index, or the field name.
'
'		Use:
'			Set objField = objUpload.Fields("File1")
'			Set objField = objUpload("File1")
'			Set objField = objUpload.Fields(0)
'			Set objField = objUpload(0)
'			Response.Write objUpload("File1").Name
'			Response.Write objUpload(0).Name
'
' ------------------------------------------------------------------------------
'
' List of all fields passed:
'
'	For i = 0 To objUpload.Count - 1
'		Response.Write objUpload(i).Name & "<BR>"
'	Next
'
' ------------------------------------------------------------------------------
'
' HTML needed to post multipart/form-data
'
'<FORM method="post" encType="multipart/form-data" action="Upload.asp">
'	<INPUT type="File" name="File1">
'	<INPUT type="Submit" value="Upload">
'</FORM>
 
Class clsUpload
' ------------------------------------------------------------------------------
 
	Private mbinData			' bytes visitor sent to server
	Private mlngChunkIndex		' byte where next chunk starts
	Private mlngBytesReceived	' length of data
	Private mstrDelimiter		' Delimiter between multipart/form-data (43 chars)
 
	Private CR					' ANSI Carriage Return
	Private LF					' ANSI Line Feed
	Private CRLF				' ANSI Carriage Return & Line Feed
	
	Private mobjFieldAry()		' Array to hold field objects
	Private mlngCount			' Number of fields parsed
	
' ------------------------------------------------------------------------------
	Private Sub RequestData
 
		Dim llngLength		' Number of bytes received
		
		' Determine number bytes visitor sent
		mlngBytesReceived = Request.TotalBytes
		
		' Store bytes recieved from visitor
		mbinData = Request.BinaryRead(mlngBytesReceived)
		
	End Sub
' ------------------------------------------------------------------------------
	Private Sub ParseDelimiter()
 
		' Delimiter seperates multiple pieces of form data
			' "around" 43 characters in length
			' next character afterwards is carriage return (except last line has two --)
			' first part of delmiter is dashes followed by hex number
			' hex number is possibly the browsers session id?
 
		' Examples:
 
		' -----------------------------7d230d1f940246
		' -----------------------------7d22ee291ae0114
 
		mstrDelimiter = MidB(mbinData, 1, InStrB(1, mbinData, CRLF) - 1)
		
	End Sub
' ------------------------------------------------------------------------------
	Private Sub ParseData()
 
		' This procedure loops through each section (chunk) found within the
		' delimiters and sends them to the parse chunk routine
		
		Dim llngStart	' start position of chunk data
		Dim llngLength	' Length of chunk
		Dim llngEnd		' Last position of chunk data
		Dim lbinChunk	' Binary contents of chunk
		
		' Initialize at first character
		llngStart = 1
		
		' Find start position
		llngStart = InStrB(llngStart, mbinData, mstrDelimiter & CRLF)
		
		' While the start posotion was found
		While Not llngStart = 0
			
			' Find the end position (after the start position)
			llngEnd = InStrB(llngStart + 1, mbinData, mstrDelimiter) - 2
			
			' Determine Length of chunk
			llngLength = llngEnd - llngStart
			
			' Pull out the chunk
			lbinChunk = MidB(mbinData, llngStart, llngLength)
			
			' Parse the chunk
			Call ParseChunk(lbinChunk)
			
			' Look for next chunk after the start position
			llngStart = InStrB(llngStart + 1, mbinData, mstrDelimiter & CRLF)
			
		Wend
		
	End Sub
' ------------------------------------------------------------------------------
	Private Sub ParseChunk(ByRef pbinChunk)
	
		' This procedure gets a chunk passed to it and parses its contents.
		' There is a general format that the chunk follows.
 
		' First, the deliminator appears
 
		' Next, headers are listed on each line that define properties of the chunk.
 
		'	Content-Disposition: form-data: name="File1"; filename="C:\Photo.gif"
		'	Content-Type: image/gif
	
		' After this, a blank line appears and is followed by the binary data.
		
		Dim lstrName			' Name of field
		Dim lstrFileName		' File name of binary data
		Dim lstrContentType		' Content type of binary data
		Dim lbinData			' Binary data
		Dim lstrDisposition		' Content Disposition
		Dim lstrValue			' Value of field
		
		' Parse out the content dispostion
		lstrDisposition = ParseDisposition(pbinChunk)
 
			' And Parse the Name
			lstrName = ParseName(lstrDisposition)
 
			' And the file name
			lstrFileName = ParseFileName(lstrDisposition)
 
		' Parse out the Content Type
		lstrContentType = ParseContentType(pbinChunk)
		
		' If the content type is not defined, then assume the
		' field is a normal form field
		If lstrContentType = "" Then
 
			' Parse Binary Data as Unicode
			lstrValue = CStrU(ParseBinaryData(pbinChunk))
		
		' Else assume the field is binary data
		Else
			
			' Parse Binary Data
			lbinData = ParseBinaryData(pbinChunk)
 
		End If
		
		' Add a new field
		Call AddField(lstrName, lstrFileName, lstrContentType, lstrValue, lbinData)
		
	End Sub
' ------------------------------------------------------------------------------
	Private Sub AddField(ByRef pstrName, ByRef pstrFileName, ByRef pstrContentType, ByRef pstrValue, ByRef pbinData)
 
		Dim lobjField		' Field object class
		
		' Add a new index to the field array
		' Make certain not to destroy current fields
		ReDim Preserve mobjFieldAry(mlngCount)
 
		' Create new field object
		Set lobjField = New clsField
		
		' Set field properties
		lobjField.Name = pstrName
		lobjField.FilePath = pstrFileName				
		lobjField.ContentType = pstrContentType
 
		' If field is not a binary file
		If LenB(pbinData) = 0 Then
			
			lobjField.BinaryData = ChrB(0)
			lobjField.Value = pstrValue
			lobjField.Length = Len(pstrValue)
 
		' Else field is a binary file
		Else
 
			lobjField.BinaryData = pbinData
			lobjField.Length = LenB(pbinData)
			lobjField.Value = ""
 
		End If
 
		' Set field array index to new field
		Set mobjFieldAry(mlngCount) = lobjField
		
		' Incriment field count
		mlngCount = mlngCount + 1
		
	End Sub
' ------------------------------------------------------------------------------
	Private Function ParseBinaryData(ByRef pbinChunk)
	
		' Parses binary content of the chunk
		
		Dim llngStart	' Start Position
 
		' Find first occurence of a blank line
		llngStart = InStrB(1, pbinChunk, CRLF & CRLF)
		
		' If it doesn't exist, then return nothing
		If llngStart = 0 Then Exit Function
		
		' Incriment start to pass carriage returns and line feeds
		llngStart = llngStart + 4
		
		' Return the last part of the chunk after the start position
		ParseBinaryData = MidB(pbinChunk, llngStart)
		
	End Function
' ------------------------------------------------------------------------------
	Private Function ParseContentType(ByRef pbinChunk)
		
		' Parses the content type of a binary file.
		'	example: image/gif is the content type of a GIF image.
		
		Dim llngStart	' Start Position
		Dim llngEnd		' End Position
		Dim llngLength	' Length
		
		' Fid the first occurance of a line starting with Content-Type:
		llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Type:"), vbTextCompare)
		
		' If not found, return nothing
		If llngStart = 0 Then Exit Function
		
		' Find the end of the line
		llngEnd = InStrB(llngStart + 15, pbinChunk, CR)
		
		' If not found, return nothing
		If llngEnd = 0 Then Exit Function
		
		' Adjust start position to start after the text "Content-Type:"
		llngStart = llngStart + 15
		
		' If the start position is the same or past the end, return nothing
		If llngStart >= llngEnd Then Exit Function
		
		' Determine length
		llngLength = llngEnd - llngStart
		
		' Pull out content type
		' Convert to unicode
		' Trim out whitespace
		' Return results
		ParseContentType = Trim(CStrU(MidB(pbinChunk, llngStart, llngLength)))
 
	End Function
' ------------------------------------------------------------------------------
	Private Function ParseDisposition(ByRef pbinChunk)
	
		' Parses the content-disposition from a chunk of data
		'
		' Example:
		'
		'	Content-Disposition: form-data: name="File1"; filename="C:\Photo.gif"
		'
		'	Would Return:
		'		form-data: name="File1"; filename="C:\Photo.gif"
		
		Dim llngStart	' Start Position
		Dim llngEnd		' End Position
		Dim llngLength	' Length
		
		' Find first occurance of a line starting with Content-Disposition:
		llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Disposition:"), vbTextCompare)
		
		' If not found, return nothing
		If llngStart = 0 Then Exit Function
		
		' Find the end of the line
		llngEnd = InStrB(llngStart + 22, pbinChunk, CRLF)
		
		' If not found, return nothing
		If llngEnd = 0 Then Exit Function
		
		' Adjust start position to start after the text "Content-Disposition:"
		llngStart = llngStart + 22
		
		' If the start position is the same or past the end, return nothing
		If llngStart >= llngEnd Then Exit Function
		
		' Determine Length
		llngLength = llngEnd - llngStart
		
		' Pull out content disposition
		' Convert to Unicode
		' Return Results
		ParseDisposition = CStrU(MidB(pbinChunk, llngStart, llngLength))
 
	End Function
' ------------------------------------------------------------------------------
	Private Function ParseName(ByRef pstrDisposition)
 
		' Parses the name of the field from the content disposition
		'
		' Example
		'
		'	form-data: name="File1"; filename="C:\Photo.gif"
		'
		'	Would Return:
		'		File1
		
		Dim llngStart	' Start Position
		Dim llngEnd		' End Position
		Dim llngLength	' Length
		
		' Find first occurance of text name="
		llngStart = InStr(1, pstrDisposition, "name=""", vbTextCompare)
		
		' If not found, return nothing
		If llngStart = 0 Then Exit Function
		
		' Find the closing quote
		llngEnd = InStr(llngStart + 6, pstrDisposition, """")
		
		' If not found, return nothing
		If llngEnd = 0 Then Exit Function
		
		' Adjust start position to start after the text name="
		llngStart = llngStart + 6
		
		' If the start position is the same or past the end, return nothing
		If llngStart >= llngEnd Then Exit Function
		
		' Determine Length
		llngLength = llngEnd - llngStart
		
		' Pull out field name
		' Return results
		ParseName = Mid(pstrDisposition, llngStart, llngLength)
		
	End Function
' ------------------------------------------------------------------------------
	Private Function ParseFileName(ByRef pstrDisposition)
		' Parses the name of the field from the content disposition
		'
		' Example
		'
		'	form-data: name="File1"; filename="C:\Photo.gif"
		'
		'	Would Return:
		'		C:\Photo.gif
		
		Dim llngStart	' Start Position
		Dim llngEnd		' End Position
		Dim llngLength	' Length
		
		' Find first occurance of text filename="
		llngStart = InStr(1, pstrDisposition, "filename=""", vbTextCompare)
		
		' If not found, return nothing
		If llngStart = 0 Then Exit Function
		
		' Find the closing quote
		llngEnd = InStr(llngStart + 10, pstrDisposition, """")
		
		' If not found, return nothing
		If llngEnd = 0 Then Exit Function
		
		' Adjust start position to start after the text filename="
		llngStart = llngStart + 10
		
		' If the start position is the same of past the end, return nothing
		If llngStart >= llngEnd Then Exit Function
		
		' Determine length
		llngLength = llngEnd - llngStart
		
		' Pull out file name
		' Return results
		ParseFileName = Mid(pstrDisposition, llngStart, llngLength)
		
	End Function
' ------------------------------------------------------------------------------
	Public Property Get Count()
		
		' Return number of fields found
		Count = mlngCount
		
	End Property
' ------------------------------------------------------------------------------
	
	Public Default Property Get Fields(ByVal pstrName)
 
		Dim llngIndex	' Index of current field
		
		' If a number was passed
		If IsNumeric(pstrName) Then
			
			llngIndex = CLng(pstrName)
			
			' If programmer requested an invalid number
			If llngIndex > mlngCount - 1 Or llngIndex < 0 Then
				' Raise an error
				Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.")
				Exit Property
			End If
				
			' Return the field class for the index specified
			Set Fields = mobjFieldAry(pstrName)
		
		' Else a field name was passed
		Else
		
			' convert name to lowercase
			pstrName = LCase(pstrname)
			
			' Loop through each field
			For llngIndex = 0 To mlngCount - 1
				
				' If name matches current fields name in lowercase
				If LCase(mobjFieldAry(llngIndex).Name) = pstrName Then
					
					' Return Field Class
					Set Fields = mobjFieldAry(llngIndex)
					Exit Property
					
				End If
			
			Next
		
		End If
 
		' If matches were not found, return an empty field
		Set Fields = New clsField
		
'		' ERROR ON NonExistant:
'		' If matches were not found, raise an error of a non-existent field
'		Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.")
'		Exit Property
 
	End Property
' ------------------------------------------------------------------------------
	Private Sub Class_Terminate()
		
		' This event is called when you destroy the class.
		'
		' Example:
		'	Set objUpload = Nothing
		'
		' Example:
		'	Response.End
		'
		' Example:
		'	Page finnishes executing ...
		
		Dim llngIndex	' Current Field Index
		
		' Loop through fields
		For llngIndex = 0 To mlngCount - 1
			
			' Release field object
			Set mobjFieldAry(llngIndex) = Nothing
			
		Next
		
		' Redimension array and remove all data within
		ReDim mobjFieldAry(-1)
		
	End Sub
' ------------------------------------------------------------------------------
	Private Sub Class_Initialize()
		
		' This event is called when you instantiate the class.
		'
		' Example:
		'	Set objUpload = New clsUpload
		
		' Redimension array with nothing
		ReDim mobjFieldAry(-1)
		
		' Compile ANSI equivilants of carriage returns and line feeds
		
		CR = ChrB(Asc(vbCr))	' vbCr		Carriage Return
		LF = ChrB(Asc(vbLf))	' vbLf		Line Feed
		CRLF = CR & LF			' vbCrLf	Carriage Return & Line Feed
 
		' Set field count to zero
		mlngCount = 0
		
		' Request data
		Call RequestData
		
		' Parse out the delimiter
		Call ParseDelimiter()
		
		' Parse the data
		Call ParseData
		
	End Sub
' ------------------------------------------------------------------------------
	Private Function CStrU(ByRef pstrANSI)
		
		' Converts an ANSI string to Unicode
		' Best used for small strings
		
		Dim llngLength	' Length of ANSI string
		Dim llngIndex	' Current position
		
		' determine length
		llngLength = LenB(pstrANSI)
		
		' Loop through each character
		For llngIndex = 1 To llngLength
		
			' Pull out ANSI character
			' Get Ascii value of ANSI character
			' Get Unicode Character from Ascii
			' Append character to results
			CStrU = CStrU & Chr(AscB(MidB(pstrANSI, llngIndex, 1)))
		
		Next
 
	End Function
' ------------------------------------------------------------------------------
	Private Function CStrB(ByRef pstrUnicode)
 
		' Converts a Unicode string to ANSI
		' Best used for small strings
		
		Dim llngLength	' Length of ANSI string
		Dim llngIndex	' Current position
		
		' determine length
		llngLength = Len(pstrUnicode)
		
		' Loop through each character
		For llngIndex = 1 To llngLength
		
			' Pull out Unicode character
			' Get Ascii value of Unicode character
			' Get ANSI Character from Ascii
			' Append character to results
			CStrB = CStrB & ChrB(Asc(Mid(pstrUnicode, llngIndex, 1)))
		
		Next
		
	End Function
' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>
 
CLSFIELD
 
-------------------------------
 
<%
' ------------------------------------------------------------------------------
'	Author:		Lewis Moten
'	Email:		Lewis@Moten.com
'	URL:		http://www.lewismoten.com
'	Date:		March 19, 2002
' ------------------------------------------------------------------------------
 
' Field class represents interface to data passed within one field
'
' Two available methods of getting a field:
'	Set objField = objUpload.Fields("File1")
'	Set objField = objUpload("File1")
'
'
'	objField.Name
'		Name of the field as defined on the form
'
'	objFiled.Filepath
'		Path that file was sent from
'
'		ie: C:\Documents and Settings\lmoten\Desktop\Photo.gif
'
'	objField.FileDir
'		Directory that file was sent from
'
'		ie: C:\Documents and Settings\lmoten\Desktop
'
'	objField.FileExt
'		Uppercase Extension of the file
'
'		ie: GIF
'
'	objField.FileName
'		Name of the file
'
'		use: Response.AddHeader "Content-Disposition", "filename=""" & objField.FileName & """"
'
'		ie: Photo.gif
'
'	objField.ContentType
'		Type of binary data
'
'		use: Response.ContentType = objField.ContentType
'
'		ie: image/gif
'
'	objField.Value
'		Unicode value passed from form.  This value is empty if the field is binary data.
'
'		use: Response.Write "The value of this field is: " & objField.Value
'
'	objField.BinaryData
'		Contents of files binary data. (Integer SubType Array)
'
'		use: Response.BinaryWrite objField.BinaryData
'
'	objField.BLOB
'		Same thing as BinaryData but with a shorter name.  Added to help prevent
'		confusion with database access.
'
'		use: Call lobjRs.Fields("Image").AppendChunk(objField.BLOB)
'
'	objField.Length
'		byte size of Value or BinaryData - depending on type of field
'
'		use: Response.Write "The size of this file is: " & objField.Length
'
'	objField.BinaryAsText()
'		Converts binary data into unicode format.  Useful when you expect the user
'		to upload a text file and you have the need to interact with it.
'
'		use: Response.Write objField.BinaryAsText()
'
'	objField.SaveAs()
'		Saves binary data to a specified path.  This will overwrite any existing files.
'
'		use: objField.SaveAs(Server.MapPath("/Uploads/") & "\" & objField.FileName)
'
' ------------------------------------------------------------------------------
Class clsField
	
	Public Name				' Name of the field defined in form
 
	Private mstrPath		' Full path to file on visitors computer
							' C:\Documents and Settings\lmoten\Desktop\Photo.gif
	
	Public FileDir			' Directory that file existed in on visitors computer
							' C:\Documents and Settings\lmoten\Desktop
 
	Public FileExt			' Extension of the file
							' GIF
 
	Public FileName			' Name of the file
							' Photo.gif
	
	Public ContentType		' Content / Mime type of file
							' image/gif
							
	Public Value			' Unicode value of field (used for normail form fields - not files)
	
	Public BinaryData		' Binary data passed with field (for files)
 
	Public Length			' byte size of value or binary data
 
	Private mstrText		' Text buffer 
								' If text format of binary data is requested more then
								' once, this value will be read to prevent extra processing
	
' ------------------------------------------------------------------------------
	Public Property Get BLOB()
		BLOB = BinaryData
	End Property
' ------------------------------------------------------------------------------
	Public Function BinaryAsText()
		
		' Binary As Text returns the unicode equivilant of the binary data.
		' this is useful if you expect a visitor to upload a text file that
		' you will need to work with.
		
		' NOTICE:
		' NULL values will prematurely terminate your Unicode string.
		' NULLs are usually found within binary files more often then plain-text files.
		' a simple way around this may consist of replacing null values with another character
		' such as a space " "
 
		Dim lbinBytes
		Dim lobjRs
		
		' Don't convert binary data that does not exist
		If Length = 0 Then Exit Function
		If LenB(BinaryData) = 0 Then Exit Function
		
		' If we previously converted binary to text, return the buffered content
		If Not Len(mstrText) = 0 Then
			BinaryAsText = mstrText
			Exit Function
		End If
		
		' Convert Integer Subtype Array to Byte Subtype Array
		lbinBytes = ASCII2Bytes(BinaryData)
   		
   		' Convert Byte Subtype Array to Unicode String
   		mstrText = Bytes2Unicode(lbinBytes)
   		
   		' Return Unicode Text
    	BinaryAsText = mstrText
 
	End Function
' ------------------------------------------------------------------------------
	Public Sub SaveAs(ByRef pstrFileName)
 
		Dim lobjStream
		Dim lobjRs
		Dim lbinBytes
		
		' Don't save files that do not posess binary data
		If Length = 0 Then Exit Sub
		If LenB(BinaryData) = 0 Then Exit Sub
		
		' Create magical objects from never never land
		Set lobjStream = Server.CreateObject("ADODB.Stream")
		
		' Let stream know we are working with binary data
		lobjStream.Type = adTypeBinary
		
		' Open stream
		Call lobjStream.Open()
 
		' Convert Integer Subtype Array to Byte Subtype Array
		lbinBytes = ASCII2Bytes(BinaryData)
		
		' Write binary data to stream
		Call lobjStream.Write(lbinBytes)
		
		' Save the binary data to file system
		'	Overwrites file if previously exists!
		Call lobjStream.SaveToFile(pstrFileName, adSaveCreateOverWrite)
		
		' Close the stream object
		Call lobjStream.Close()
		
		' Release objects
		Set lobjStream = Nothing
	
	End Sub
' ------------------------------------------------------------------------------
	Public Property Let FilePath(ByRef pstrPath)
		
		mstrPath = pstrPath
		
		' Parse File Ext
		If Not InStrRev(pstrPath, ".") = 0 Then
			FileExt = Mid(pstrPath, InStrRev(pstrPath, ".") + 1)
			FileExt = UCase(FileExt)
		End If
		
		' Parse File Name
		If Not InStrRev(pstrPath, "\") = 0 Then
			FileName = Mid(pstrPath, InStrRev(pstrPath, "\") + 1)
		End If
		
		' Parse File Dir
		If Not InStrRev(pstrPath, "\") = 0 Then
			FileDir = Mid(pstrPath, 1, InStrRev(pstrPath, "\") - 1)
		End If
		
	End Property
' ------------------------------------------------------------------------------
	Public Property Get FilePath()
		FilePath = mstrPath
	End Property
' ------------------------------------------------------------------------------
	Private Function ASCII2Bytes(ByRef pbinBinaryData)
	
		Dim lobjRs
		Dim llngLength
		Dim lbinBuffer
		
		' get number of bytes
		llngLength = LenB(pbinBinaryData)
		
		Set lobjRs = Server.CreateObject("ADODB.Recordset")
		
		' create field in an empty recordset to hold binary data
		Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
		
		' Open recordset
		Call lobjRs.Open()
		
		' Add a new record to recordset
		Call lobjRs.AddNew()
		
		' Populate field with binary data
		Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0))
		
		' Update / Convert Binary Data
			' Although the data we have is binary - it has still been
			' formatted as 4 bytes to represent each byte.  When we
			' update the recordset, the Integer Subtype Array that we
			' passed into the Recordset will be converted into a
			' Byte Subtype Array
		Call lobjRs.Update()
		
		' Request binary data and save to stream
		lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
		
		' Close recordset
		Call lobjRs.Close()
		
		' Release recordset from memory
		Set lobjRs = Nothing
		
		' Return Bytes
		ASCII2Bytes = lbinBuffer
		
	End Function
' ------------------------------------------------------------------------------
	Private Function Bytes2Unicode(ByRef pbinBytes)
 
		Dim lobjRs
		Dim llngLength
		Dim lstrBuffer
		
		llngLength = LenB(pbinBytes)
				
		Set lobjRs = Server.CreateObject("ADODB.Recordset")
 
		' Create field in an empty recordset to hold binary data
    	Call lobjRs.Fields.Append("BinaryData", adLongVarChar, llngLength)
    	
    	' Open Recordset
    	Call lobjRs.Open()
    	
    	' Add a new record to recordset
    	Call lobjRs.AddNew()
    	
    	' Populate field with binary data
    	Call lobjRs.Fields("BinaryData").AppendChunk(pbinBytes)
    	
    	' Update / Convert.
    		' Ensure bytes are proper subtype
    	Call lobjRs.Update()
    	
    	' Request unicode value of binary data
    	lstrBuffer = lobjRs.Fields("BinaryData").Value
    	
    	' Close recordset
    	Call lobjRs.Close()
 
    	' Release recordset from memory
    	Set lobjRs = Nothing
	
		' Return Unicode
		Bytes2Unicode = lstrBuffer
		
	End Function
 
' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>

                                              
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:

Select allOpen in new window

 

by: hieloPosted on 2009-09-07 at 10:32:05ID: 25276350

>>the filename of the uploaded file does not seem to be being transmitted
If I am not mistake, this problem is only occurring in non-IE browsers, correct?

 

by: frasierphilipsPosted on 2009-09-07 at 11:14:21ID: 25276535

Nope, I'm using IE8 to test it

 

by: hieloPosted on 2009-09-07 at 12:18:48ID: 25276831

>>I'm using IE8 to test it
OK, well I don't have that browser, but some years ago, I saw someone with the same problem. It worked fine on IE6, but NON-IE browsers did not worked. The reason is because IE6 was passing the full path of the image - ex:
C:\Test\image1.gif

but the other browsers were (CORRECTLY) not disclosing the full path. They simply reported
image1.gif

The browser is NOT supposed to send the Directory AND the image name. It should send just the image name. That script was tested for IE6 only (back then).

However, if you look at the posts on the site where you got that script, the problem and the solution is reported by others. It's a long post, but the issue is resolved on that page.

 

by: frasierphilipsPosted on 2009-09-07 at 12:45:14ID: 31625351

Thanks - Can't think why I didn't look there 1st

20120131-EE-VQP-002

3 Ways to Join

30-Day Free Trial

The Experts

98% positive feedback on 31,087 answers since March 2000. angeliii is a Microsoft Most Valuable Professional for his work with MS SQL Server & Develoment.

He has also proven his knowledge of Visual Basic Programming, PHP Scripting and Oracle Databases.

The Experts

97% positive feedback on 10,752 answers since July 2000. lrmoore has more than 18 years experience in the networking industry.

The six-time Mircosoft MVPs specialties include firewalls, virtual private networking, and network management.

Testimonials

"...and excellent source for support... Kind of like having your very own IT dept." Electriciansnet

Testimonials

"I was apprehensive at signing up at first. However... it has already made my life as an IT administrator much easier." JaCrews

Testimonials

"WOW! You guys have great, active, and knowledgeable people on here." moore50

Business Clients

Business Clients

In the Press

"If you’ve got a question... Experts Exchange can supply an answer.”

In the Press

"...an invaluable aid for both IT professionals and those who require tech support."

In the Press

"where IT professionals provide quick answers on just about any topic"

Business Account Plans

Loading Advertisement...