file rename Problem in asp upload

H

hardik

can anyone tell me how i can change the filename which is going to
uploaded


here is a code for uploading a file

<!-- #include file="clsUpload.asp" -->
Set objUpload = New clsUpload
If objUpload.Files.Count > 0 Then
objUpload.Files.Item(0).Save Server.MapPath("cupload\")
ResumeFileName=objUpload.Files.Item(0).FileName
End If


now here i wants to give my filename instead of the filename which is
selected by user like 54.txt instead of resume.doc bcz users can post
those file with same name i need to rename the files so plz tell me is
there any way i can upload the filename with the diffrent filename.

i am including the file <!-- #include file="clsUpload.asp" --> for
clsUpload component and here are the contents of the file...



<SCRIPT LANGUAGE=vbscript RUNAT=Server>
Class clsUpload
'========================================================='
' This class will parse the binary contents of the '
' request, and populate the Form and Files collections. '
'========================================================='
Private m_objFiles
Private m_objForm

Public Property Get Form()
Set Form = m_objForm
End Property

Public Property Get Files()
Set Files = m_objFiles
End Property

Private Sub Class_Initialize()
Set m_objFiles = New clsCollection
Set m_objForm = New clsCollection
ParseRequest
End Sub

Private Sub ParseRequest()
Dim lngTotalBytes, lngPosBeg, lngPosEnd, lngPosBoundary, lngPosTmp,
lngPosFileName
Dim strBRequest, strBBoundary, strBContent
Dim strName, strFileName, strContentType, strValue, strTemp
Dim objFile

'Grab the entire contents of the Request as a Byte string
lngTotalBytes = Request.TotalBytes
strBRequest = Request.BinaryRead(lngTotalBytes)

'Find the first Boundary
lngPosBeg = 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2Bstr(Chr(13)))
If lngPosEnd > 0 Then
strBBoundary = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
lngPosBoundary = InStrB(1, strBRequest, strBBoundary)
End If
If strBBoundary = "" Then
'The form must have been submitted *without*
ENCTYPE="multipart/form-data"
'But since we already called Request.BinaryRead, we can no longer
access
'the Request.Form collection, so we need to parse the request and
populate
'our own form collection.
lngPosBeg = 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
Do While lngPosBeg < LenB(strBRequest)
'Parse the element and add it to the collection
strTemp = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd -
lngPosBeg))
lngPosTmp = InStr(1, strTemp, "=")
strName = URLDecode(Left(strTemp, lngPosTmp - 1))
strValue = URLDecode(Right(strTemp, Len(strTemp) - lngPosTmp))
m_objForm.Add strName, strValue
'Find the next element
lngPosBeg = lngPosEnd + 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
If lngPosEnd = 0 Then lngPosEnd = LenB(strBRequest) + 1
Loop
Else
'The form was submitted with ENCTYPE="multipart/form-data"
'Loop through all the boundaries, and parse them into either the
'Form or Files collections.
Do Until (lngPosBoundary = InStrB(strBRequest, strBBoundary &
UStr2Bstr("--")))
'Get the element name
lngPosTmp = InStrB(lngPosBoundary, strBRequest,
UStr2BStr("Content-Disposition"))
lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr("name="))
lngPosBeg = lngPosTmp + 6
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(Chr(34)))
strName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd -
lngPosBeg))
'Look for an element named 'filename'
lngPosFileName = InStrB(lngPosBoundary, strBRequest,
UStr2BStr("filename="))
'If found, we have a file, otherwise it is a normal form element
If lngPosFileName <> 0 And lngPosFileName < InStrB(lngPosEnd,
strBRequest, strBBoundary) Then 'It is a file
'Get the FileName
lngPosBeg = lngPosFileName + 10
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(chr(34)))
strFileName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd -
lngPosBeg))
'Get the ContentType
lngPosTmp = InStrB(lngPosEnd, strBRequest,
UStr2BStr("Content-Type:"))
lngPosBeg = lngPosTmp + 14
lngPosEnd = InstrB(lngPosBeg, strBRequest, UStr2BStr(chr(13)))
strContentType = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd
- lngPosBeg))
'Get the Content
lngPosBeg = lngPosEnd + 4
lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
strBContent = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
If strFileName <> "" And strBContent <> "" Then
'Create the File object, and add it to the Files collection
Set objFile = New clsFile
objFile.Name = strName
objFile.FileName = Right(strFileName, Len(strFileName) -
InStrRev(strFileName, "\"))
objFile.ContentType = strContentType
objFile.Blob = strBContent
m_objFiles.Add strName, objFile
End If
Else 'It is a form element
'Get the value of the form element
lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr(chr(13)))
lngPosBeg = lngPosTmp + 4
lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
strValue = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd -
lngPosBeg))
'Add the element to the collection
m_objForm.Add strName, strValue
End If
'Move to Next Element
lngPosBoundary = InStrB(lngPosBoundary + LenB(strBBoundary),
strBRequest, strBBoundary)
Loop
End If
End Sub

Private Function BStr2UStr(BStr)
'Byte string to Unicode string conversion
Dim lngLoop
BStr2UStr = ""
For lngLoop = 1 to LenB(BStr)
BStr2UStr = BStr2UStr & Chr(AscB(MidB(BStr,lngLoop,1)))
Next
End Function

Private Function UStr2Bstr(UStr)
'Unicode string to Byte string conversion
Dim lngLoop
Dim strChar
UStr2Bstr = ""
For lngLoop = 1 to Len(UStr)
strChar = Mid(UStr, lngLoop, 1)
UStr2Bstr = UStr2Bstr & ChrB(AscB(strChar))
Next
End Function

Private Function URLDecode(Expression)
'Why doesn't ASP provide this functionality for us?
Dim strSource, strTemp, strResult
Dim lngPos
strSource = Replace(Expression, "+", " ")
For lngPos = 1 To Len(strSource)
strTemp = Mid(strSource, lngPos, 1)
If strTemp = "%" Then
If lngPos + 2 < Len(strSource) Then
strResult = strResult & Chr(CInt("&H" & Mid(strSource, lngPos + 1,
2)))
lngPos = lngPos + 2
End If
Else
strResult = strResult & strTemp
End If
Next
URLDecode = strResult
End Function

End Class

Class clsCollection
'========================================================='
' This class is a pseudo-collection. It is not a real '
' collection, because there is no way that I am aware '
' of to implement an enumerator to support the '
' For..Each syntax using VBScript classes. '
'========================================================='
Private m_objDicItems

Private Sub Class_Initialize()
Set m_objDicItems = Server.CreateObject("Scripting.Dictionary")
m_objDicItems.CompareMode = vbTextCompare
End Sub

Public Property Get Count()
Count = m_objDicItems.Count
End Property

Public Default Function Item(Index)
Dim arrItems
If IsNumeric(Index) Then
arrItems = m_objDicItems.Items
If IsObject(arrItems(Index)) Then
Set Item = arrItems(Index)
Else
Item = arrItems(Index)
End If
Else
If m_objDicItems.Exists(Index) Then
If IsObject(m_objDicItems.Item(Index)) Then
Set Item = m_objDicItems.Item(Index)
Else
Item = m_objDicItems.Item(Index)
End If
End If
End If
End Function

Public Function Key(Index)
Dim arrKeys
If IsNumeric(Index) Then
arrKeys = m_objDicItems.Keys
Key = arrKeys(Index)
End If
End Function

Public Sub Add(Name, Value)
If m_objDicItems.Exists(Name) Then
m_objDicItems.Item(Name) = Value
Else
m_objDicItems.Add Name, Value
End If
End Sub
End Class

Class clsFile
'========================================================='
' This class is used as a container for a file sent via '
' an http multipart/form-data post. '
'========================================================='
Private m_strName
Private m_strContentType
Private m_strFileName
Private m_Blob

Public Property Get Name() : Name = m_strName : End Property
Public Property Let Name(vIn) : m_strName = vIn : End Property
Public Property Get ContentType() : ContentType = m_strContentType :
End Property
Public Property Let ContentType(vIn) : m_strContentType = vIn : End
Property
Public Property Get FileName() : FileName = m_strFileName : End
Property
Public Property Let FileName(vIn) : m_strFileName = vIn : End Property
Public Property Get Blob() : Blob = m_Blob : End Property
Public Property Let Blob(vIn) : m_Blob = vIn : End Property

Public Sub Save(Path)
Dim objFSO, objFSOFile
Dim lngLoop
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFSOFile = objFSO.CreateTextFile(objFSO.BuildPath(Path,
m_strFileName))
For lngLoop = 1 to LenB(m_Blob)
objFSOFile.Write Chr(AscB(MidB(m_Blob, lngLoop, 1)))
Next
objFSOFile.Close
End Sub
End Class
</SCRIPT>
 
R

Ray Costanzo [MVP]

I added this SaveAs method to this class a number of years back before my
company was convinced that spending $100 for an upload component was the
REAL solution. I strongly suggest you try to convince your company of the
same.


Public Sub SaveAs(Path, NewFileName)
Dim objFSO, objFSOFile
Dim lngLoop
Dim strSource, strTarget

Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

strSource = objFSO.BuildPath(Path, m_strFileName)
strTarget = objFSO.BuildPath(Path, NewFileName)



Set objFSOFile = objFSO.CreateTextFile(strSource)
For lngLoop = 1 to LenB(m_Blob)
objFSOFile.Write Chr(AscB(MidB(m_Blob, lngLoop, 1)))
Next
objFSOFile.Close


If objFSO.FileExists(strTarget) Then objFSO.DeleteFile strTarget, True

objFSO.MoveFile strSource, strTarget

If objFSO.FileExists(strSource) Then objFSO.DeleteFile strSource
End Sub

Ray at work
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

Forum statistics

Threads
473,755
Messages
2,569,536
Members
45,020
Latest member
GenesisGai

Latest Threads

Top