By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
458,149 Members | 1,815 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 458,149 IT Pros & Developers. It's quick & easy.

freeASPUpload.asp unicode and file overwriting

P: 1
Hello!

I have used freeASPUpload.asp (from http://www.freeaspupload.net/ ) to upload files to my server. However, there where two problems:
  1. It doesn't support Unicode (I use UTF-8)
  2. Already existing files are overwritten

So I made some changes. I would like to submit at least the Unicode part to the authors, but I cannot find out who they are. Does anybody know??

Any way, I'll just post the code here if someone else runs into the same problem. Changes to the original code:
  • I modified the function String2Byte to support requests made in UTF-8
  • added an internal function GetFileName(strSaveToPath, FileName) that finds out if a file already exists and in that case finds a unique file name
  • added a function "public sub SaveOne(path, num, byref outFileName, byref outLocalFileName)" that saves one file (for example number 0 would be the first file in the request) and returns the original filename and the local file name since it may be renamed if the file already exists in the path specified on the server

So a typical call if you only have uploaded one file might be

Expand|Select|Wrap|Line Numbers
  1.     Dim Upload, fileName, localFileName, localDocumentPath
  2.  
  3.     localDocumentPath = Server.MapPath("/documents")
  4.     Set Upload = New FreeASPUpload
  5.     Upload.SaveOne localDocumentPath, 0, fileName, localFileName
  6.  
I attach the asp-file as .txt
Attached Files
File Type: txt freeASPUploadMod.txt (12.8 KB, 2659 views)
Dec 21 '07 #1
Share this Question
Share on Google+
9 Replies


jhardman
Expert 2.5K+
P: 3,405
Thanks, Lars,

I was going to say that it was made by Persits software, but now I think that's a different package.

Jared
Dec 22 '07 #2

P: 2
Hello!

I have used freeASPUpload.asp (from http://www.freeaspupload.net/ ) to upload files to my server. However, there where two problems:
  1. It doesn't support Unicode (I use UTF-8)
  2. Already existing files are overwritten

So I made some changes. I would like to submit at least the Unicode part to the authors, but I cannot find out who they are. Does anybody know??

Any way, I'll just post the code here if someone else runs into the same problem. Changes to the original code:
  • I modified the function String2Byte to support requests made in UTF-8
  • added an internal function GetFileName(strSaveToPath, FileName) that finds out if a file already exists and in that case finds a unique file name
  • added a function "public sub SaveOne(path, num, byref outFileName, byref outLocalFileName)" that saves one file (for example number 0 would be the first file in the request) and returns the original filename and the local file name since it may be renamed if the file already exists in the path specified on the server

So a typical call if you only have uploaded one file might be

Expand|Select|Wrap|Line Numbers
  1.     Dim Upload, fileName, localFileName, localDocumentPath
  2.  
  3.     localDocumentPath = Server.MapPath("/documents")
  4.     Set Upload = New FreeASPUpload
  5.     Upload.SaveOne localDocumentPath, 0, fileName, localFileName
  6.  
I attach the asp-file as .txt

Hi larsjohanson,

Pls can you post the new functions you added. GetFileName and public sub SaveOne. I have the same problem of overwriting existing files.

Thanks
Jan 24 '08 #3

P: 2
Hi larsjohanson,

I have seen the new functions in the ammended code. But it doesn't work. existing files can is still be overwritten when files of the same name are uploaded.

Is there something am missing?
Jan 25 '08 #4

P: 2
Hi,

I'm having the same problem and so would like to know how to rename files so that they are unique.

Also: larsjohanson - I believe this is the website for the guy who created freeaspupload: http://www.mmartins.com/
Email: (martins@mmartins.com)

Cheers,
Kessa
Feb 18 '08 #5

markrawlingson
Expert 100+
P: 346
I just did this, except I used SoftArtisans FileUp. Should be fairly similar, save for a couple keywords etc.

I used the File System Object to check to see if the file name which was being uploaded exists already within the folder i'm trying to dump the new file into. If it did, I simply tell the user a file with that name already exists and if they want to upload this file they will need to rename it and try again. I also provided a rename tool right on the website for them to rename any file within their "document bank".

Expand|Select|Wrap|Line Numbers
  1. sPath = "/path/to/document/upload/folder/"
  2. Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
  3. Set oFolder = Server.MapPath( sPath )
  4. Set oFileUp = Server.CreateObject("SoftArtisans.FileUp")
  5. oFileUp.Path = Server.MapPath( sPath & "documents")
  6. For Each oFile In oFolder.Files
  7. If oFile.Name = oFileUp.FileName
  8. sError = "Sorry, a file with the name " & oFileUp.FileName & " already exists. Please rename the file and try to upload the file again."
  9. End If
  10. Next
  11.  
note that oFileUp.FileName is not SoftArtisans FileUp - looking at Free ASP Upload, it looks like this is the way that file names are retrieved with that module but I've never used this module so I can't say for certain.

The documentation for Free ASP Upload is poor to say the least, so you'll have to play around with it and perhaps find some further examples of their code online.. but a lot of these modules do have overwrite "switches" so perhaps if you can find some good documentation of the methods and properties of this object you may find one, which should provide an easy solution for the problem. For instance, Persits Upload has a method called "OverWriteFiles" - set to false, it will upload the file with a (1) at the end.

Hope this helps.

Sincerely,
Mark
Feb 18 '08 #6

P: 1
Hi all,

Has anyone taken larsjohanson's code and modified it for freeasp's multiple file upload? It's working well for one, but on multiple uploads - where attach1, attach2, attach3 & attach4 are in use for example - all files are being uploaded with the returned 'outlocalfilename' for attach1.

The necessary code mod is probably staring me in the face, but it's eluded me for 2 days now! Any advice appreciated.

Jackie
Oct 22 '14 #7

P: 1
Thanks Lars,

especially the Unicode part was of high value and it's working perfectly.

Heinz
Jan 11 '17 #8

P: 2
@hb2017
I have tried to use the amended code but still my files gets overwritten
2 Weeks Ago #9

P: 2
<%
' For examples, documentation, and your own free copy, go to:
' http://www.freeaspupload.net
' Note: You can copy and use this script for free and you can make changes
' to the code, but you cannot remove the above comment.

'Changes:
'Aug 2, 2005: Add support for checkboxes and other input elements with multiple values
'Jan 6, 2009: Lars added ASP_CHUNK_SIZE
'Sep 3, 2010: Enforce UTF-8 everywhere; new function to convert byte array to unicode string

const DEFAULT_ASP_CHUNK_SIZE = 200000

const adModeReadWrite = 3
const adTypeBinary = 1
const adTypeText = 2
const adSaveCreateOverWrite = 2

Class FreeASPUpload
Public UploadedFiles
Public FormElements

Private VarArrayBinRequest
Private StreamRequest
Private uploadedYet
Private internalChunkSize

Private Sub Class_Initialize()
Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")
Set FormElements = Server.CreateObject("Scripting.Dictionary")
Set StreamRequest = Server.CreateObject("ADODB.Stream")
StreamRequest.Type = adTypeText
StreamRequest.Open
uploadedYet = false
internalChunkSize = DEFAULT_ASP_CHUNK_SIZE
End Sub

Private Sub Class_Terminate()
If IsObject(UploadedFiles) Then
UploadedFiles.RemoveAll()
Set UploadedFiles = Nothing
End If
If IsObject(FormElements) Then
FormElements.RemoveAll()
Set FormElements = Nothing
End If
StreamRequest.Close
Set StreamRequest = Nothing
End Sub

Public Property Get Form(sIndex)
Form = ""
If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))
End Property

Public Property Get Files()
Files = UploadedFiles.Items
End Property

Public Property Get Exists(sIndex)
Exists = false
If FormElements.Exists(LCase(sIndex)) Then Exists = true
End Property

Public Property Get FileExists(sIndex)
FileExists = false
if UploadedFiles.Exists(LCase(sIndex)) then FileExists = true
End Property

Public Property Get chunkSize()
chunkSize = internalChunkSize
End Property

Public Property Let chunkSize(sz)
internalChunkSize = sz
End Property

'Calls Upload to extract the data from the binary request and then saves the uploaded files
Public Sub Save(path)
Dim streamFile, fileItem, filePath

if Right(path, 1) <> "\" then path = path & "\"

if not uploadedYet then Upload

For Each fileItem In UploadedFiles.Items
filePath = path & fileItem.FileName
Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = adTypeBinary
streamFile.Open
StreamRequest.Position=fileItem.Start
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile filePath, adSaveCreateOverWrite
streamFile.close
Set streamFile = Nothing
fileItem.Path = filePath
Next
End Sub

public sub SaveOne(path, num, byref outFileName, byref outLocalFileName)
Dim streamFile, fileItems, fileItem, fs

set fs = Server.CreateObject("Scripting.FileSystemObject")
if Right(path, 1) <> "\" then path = path & "\"

if not uploadedYet then Upload
if UploadedFiles.Count > 0 then
fileItems = UploadedFiles.Items
set fileItem = fileItems(num)

outFileName = fileItem.FileName
outLocalFileName = GetFileName(path, outFileName)

Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = adTypeBinary
streamFile.Open
StreamRequest.Position = fileItem.Start
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & outLocalFileName, adSaveCreateOverWrite
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & filename
end if
end sub

Public Function SaveBinRequest(path) ' For debugging purposes
StreamRequest.SaveToFile path & "\debugStream.bin", 2
End Function

Public Sub DumpData() 'only works if files are plain text
Dim i, aKeys, f
response.write "Form Items:<br>"
aKeys = FormElements.Keys
For i = 0 To FormElements.Count -1 ' Iterate the array
response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"
Next
response.write "Uploaded Files:<br>"
For Each f In UploadedFiles.Items
response.write "Name: " & f.FileName & "<br>"
response.write "Type: " & f.ContentType & "<br>"
response.write "Start: " & f.Start & "<br>"
response.write "Size: " & f.Length & "<br>"
Next
End Sub

Public Sub Upload()
Dim nCurPos, nDataBoundPos, nLastSepPos
Dim nPosFile, nPosBound
Dim sFieldName, osPathSep, auxStr
Dim readBytes, readLoop, tmpBinRequest

'RFC1867 Tokens
Dim vDataSep
Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
tNewLine = String2Byte(Chr(13))
tDoubleQuotes = String2Byte(Chr(34))
tTerm = String2Byte("--")
tFilename = String2Byte("filename=""")
tName = String2Byte("name=""")
tContentDisp = String2Byte("Content-Disposition")
tContentType = String2Byte("Content-Type:")

uploadedYet = true

on error resume next
' Copy binary request to a byte array, on which functions like InstrB and others can be used to search for separation tokens
readBytes = internalChunkSize
VarArrayBinRequest = Request.BinaryRead(readBytes)
VarArrayBinRequest = midb(VarArrayBinRequest, 1, lenb(VarArrayBinRequest))
Do Until readBytes < 1
tmpBinRequest = Request.BinaryRead(readBytes)
if readBytes > 0 then
VarArrayBinRequest = VarArrayBinRequest & midb(tmpBinRequest, 1, lenb(tmpBinRequest))
end if
Loop
StreamRequest.WriteText(VarArrayBinRequest)
StreamRequest.Flush()
if Err.Number <> 0 then
response.write "<br><br><B>System reported this error:</B><p>"
response.write Err.Description & "<p>"
response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
Exit Sub
end if
on error goto 0 'reset error handling

nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)

If nCurPos <= 1 Then Exit Sub

'vDataSep is a separator like -----------------------------21763138716045
vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)

'Start of current separator
nDataBoundPos = 1

'Beginning of last line
nLastSepPos = FindToken(vDataSep & tTerm, 1)

Do Until nDataBoundPos = nLastSepPos

nCurPos = SkipToken(tContentDisp, nDataBoundPos)
nCurPos = SkipToken(tName, nCurPos)
sFieldName = ExtractField(tDoubleQuotes, nCurPos)

nPosFile = FindToken(tFilename, nCurPos)
nPosBound = FindToken(vDataSep, nCurPos)

If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile
Set oUploadFile = New UploadedFile

nCurPos = SkipToken(tFilename, nCurPos)
auxStr = ExtractField(tDoubleQuotes, nCurPos)
' We are interested only in the name of the file, not the whole path
' Path separator is \ in windows, / in UNIX
' While IE seems to put the whole pathname in the stream, Mozilla seem to
' only put the actual file name, so UNIX paths may be rare. But not impossible.
osPathSep = "\"
if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))

if (Len(oUploadFile.FileName) > 0) then 'File field not left empty
nCurPos = SkipToken(tContentType, nCurPos)

auxStr = ExtractField(tNewLine, nCurPos)
' NN on UNIX puts things like this in the stream:
' ?? python py type=?? python application/x-python
oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line

oUploadFile.Start = nCurPos+1
oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos

If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile
End If
Else
Dim nEndOfData, fieldValueUniStr
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
nEndOfData = FindToken(vDataSep, nCurPos) - 2
fieldValueuniStr = ConvertUtf8BytesToString(nCurPos, nEndOfData-nCurPos)
If Not FormElements.Exists(LCase(sFieldName)) Then
FormElements.Add LCase(sFieldName), fieldValueuniStr
else
FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & fieldValueuniStr
end if

End If

'Advance to next separator
nDataBoundPos = FindToken(vDataSep, nCurPos)
Loop
End Sub

Private Function SkipToken(sToken, nStart)
SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
If SkipToken = 0 then
Response.write "Error in parsing uploaded binary request. The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
Response.End
end if
SkipToken = SkipToken + LenB(sToken)
End Function

Private Function FindToken(sToken, nStart)
FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
End Function

Private Function ExtractField(sToken, nStart)
Dim nEnd
nEnd = InstrB(nStart, VarArrayBinRequest, sToken)
If nEnd = 0 then
Response.write "Error in parsing uploaded binary request."
Response.End
end if
ExtractField = ConvertUtf8BytesToString(nStart, nEnd-nStart)
End Function

'String to byte string conversion
Private Function String2Byte(sString)
Dim i
For i = 1 to Len(sString)
String2Byte = String2Byte & ChrB(AscB(Mid(sString,i,1)))
Next
End Function

Private Function ConvertUtf8BytesToString(start, length)
StreamRequest.Position = 0

Dim objStream
Dim strTmp

' init stream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeBinary
objStream.Open

' write bytes into stream
StreamRequest.Position = start+1
StreamRequest.CopyTo objStream, length
objStream.Flush

' rewind stream and read text
objStream.Position = 0
objStream.Type = adTypeText
strTmp = objStream.ReadText

' close up and return
objStream.Close
Set objStream = Nothing
ConvertUtf8BytesToString = strTmp
End Function
End Class

Class UploadedFile
Public ContentType
Public Start
Public Length
Public Path
Private nameOfFile

' Need to remove characters that are valid in UNIX, but not in Windows
Public Property Let FileName(fN)
nameOfFile = fN
nameOfFile = SubstNoReg(nameOfFile, "\", "_")
nameOfFile = SubstNoReg(nameOfFile, "/", "_")
nameOfFile = SubstNoReg(nameOfFile, ":", "_")
nameOfFile = SubstNoReg(nameOfFile, "*", "_")
nameOfFile = SubstNoReg(nameOfFile, "?", "_")
nameOfFile = SubstNoReg(nameOfFile, """", "_")
nameOfFile = SubstNoReg(nameOfFile, "<", "_")
nameOfFile = SubstNoReg(nameOfFile, ">", "_")
nameOfFile = SubstNoReg(nameOfFile, "|", "_")
End Property

Public Property Get FileName()
FileName = nameOfFile
End Property

'Public Property Get FileN()ame
End Class


' Does not depend on RegEx, which is not available on older VBScript
' Is not recursive, which means it will not run out of stack space
Function SubstNoReg(initialStr, oldStr, newStr)
Dim currentPos, oldStrPos, skip
If IsNull(initialStr) Or Len(initialStr) = 0 Then
SubstNoReg = ""
ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
SubstNoReg = initialStr
Else
If IsNull(newStr) Then newStr = ""
currentPos = 1
oldStrPos = 0
SubstNoReg = ""
skip = Len(oldStr)
Do While currentPos <= Len(initialStr)
oldStrPos = InStr(currentPos, initialStr, oldStr)
If oldStrPos = 0 Then
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
currentPos = Len(initialStr) + 1
Else
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
currentPos = oldStrPos + skip
End If
Loop
End If
End Function

Function GetFileName(strSaveToPath, FileName)
'This function is used when saving a file to check there is not already a file with the same name so that you don't overwrite it.
'It adds numbers to the filename e.g. file.gif becomes file1.gif becomes file2.gif and so on.
'It keeps going until it returns a filename that does not exist.
'You could just create a filename from the ID field but that means writing the record - and it still might exist!
'N.B. Requires strSaveToPath variable to be available - and containing the path to save to
Dim Counter
Dim Flag
Dim strTempFileName
Dim FileExt
Dim NewFullPath
dim objFSO, p
Set objFSO = CreateObject("Scripting.FileSystemObject")
Counter = 0
p = instrrev(FileName, ".")
FileExt = mid(FileName, p+1)
strTempFileName = left(FileName, p-1)
NewFullPath = strSaveToPath & "\" & FileName
Flag = False

Do Until Flag = True
If objFSO.FileExists(NewFullPath) = False Then
Flag = True
GetFileName = Mid(NewFullPath, InstrRev(NewFullPath, "\") + 1)
Else
Counter = Counter + 1
NewFullPath = strSaveToPath & "\" & strTempFileName & Counter & "." & FileExt
End If
Loop
End Function

%>
2 Weeks Ago #10

Post your reply

Sign in to post your reply or Sign up for a free account.