Steynsk
asked on
Change a function in a class to accept a parameter
Hi Expert,
I've found this excellent jquery upload script that has a classic asp version. It is called UploadiFy.
With the help of Bib Monty I succeeded to rename the uploaded files.
Ultimate the goal was to add a case number to a uploaded file. So the caseID is for instance 14 and if a "test.jpg" would be uploaded it should be renamed to "14_test.jpg" after being uploaded.
Like I said the renaming part is clear but now I need to parse the caseID from the default.asp to the code that does the renaming part.
There are three main files:
default.asp
uploader214.asp
uploaderCLS.asp
In line 28 of the default.asp
I Parse the caseID using a parameter to the uploader214.asp file.
In line 19 of uploader214.asp :
UploadifyObject.Save(Serve r.MapPath( UploadiFyF older))
The Save function of the object gets a called with a path parameter.
This function can be found in the uploaderCLS.asp in line 79
I've tried to change this into:
and receive the value :
Public Sub Save(path,caseID)
But when I use it get error aaaHTTP: undifined
Beneath all three files:
default.asp
uploader214.asp
uploaderCLS.asp
I've found this excellent jquery upload script that has a classic asp version. It is called UploadiFy.
With the help of Bib Monty I succeeded to rename the uploaded files.
Ultimate the goal was to add a case number to a uploaded file. So the caseID is for instance 14 and if a "test.jpg" would be uploaded it should be renamed to "14_test.jpg" after being uploaded.
Like I said the renaming part is clear but now I need to parse the caseID from the default.asp to the code that does the renaming part.
There are three main files:
default.asp
uploader214.asp
uploaderCLS.asp
In line 28 of the default.asp
'script' : 'uploader214.asp?sId=<%=session.sessionID%>&caseID=14',
I Parse the caseID using a parameter to the uploader214.asp file.
In line 19 of uploader214.asp :
UploadifyObject.Save(Serve
The Save function of the object gets a called with a path parameter.
UploadifyObject.Save(Server.MapPath(UploadiFyFolder))
This function can be found in the uploaderCLS.asp in line 79
I've tried to change this into:
UploadifyObject.Save(Server.MapPath(UploadiFyFolder),request.querystring("caseId"))
and receive the value :
Public Sub Save(path,caseID)
But when I use it get error aaaHTTP: undifined
Beneath all three files:
default.asp
<%
caseID="10"
application("sessionID")=Session.SessionID
application("uploadpath")="userfiles"
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Uploadify Form</title>
<link href="uploadify214/css/default.css" rel="stylesheet" type="text/css" />
<link href="uploadify214/css/uploadify.css" rel="stylesheet" type="text/css" />
<script type="text/javascript" src="http://ajax.googleapis.com/ajax/libs/jquery/1.5/jquery.min.js"></script>
<script type="text/javascript" src="uploadify214/swfobject.js"></script>
<script type="text/javascript" src="uploadify214/jquery.uploadify.v2.1.4.min.js"></script>
<script type="text/javascript">
function Send_document()
{
$('#uploadify').uploadifyUpload();
}
</script>
<script type="text/javascript">
$(document).ready(function() {
$("#uploadify").uploadify({
'auto' : true,
'uploader' : 'uploadify214/uploadify.swf',
'script' : 'uploader214.asp?sId=<%=session.sessionID%>&caseID=10',
'cancelImg' : 'uploadify214/cancel.png',
'fileDesc' : 'JPG (*.jpg), JPEG (*.jpeg), JPE (*.jpe), JP2 (*.jp2), JFIF (*.jfif), GIF (*.gif), BMP (*.bmp), PNG (*.png), PSD (*.psd), EPS (*.eps), ICO (*.ico), TIF (*.tif), TIFF (*.tiff), AI (*.ai), RAW (*.raw), TGA (*.tga), MNG (*.mng), SVG (*.svg), DOC (*.doc), RTF (*.rtf), TXT (*.txt), WPD (*.wpd), WPS (*.wps), CSV (*.csv), XML (*.xml), XSD (*.xsd), SQL (*.sql), PDF (*.pdf), XLS (*.xls), MDB (*.mdb), PPT (*.ppt), DOCX (*.docx), XLSX (*.xlsx), PPTX (*.pptx), PPSX (*.ppsx), ARTX (*.artx), MP3 (*.mp3), WMA (*.wma), MID (*.mid), MIDI (*.midi), MP4 (*.mp4), MPG (*.mpg), MPEG (*.mpeg), WAV (*.wav), RAM (*.ram), RA (*.ra), AVI (*.avi), MOV (*.mov), FLV (*.flv), M4A (*.m4a), M4V (*.m4v), HTM (*.htm), HTML (*.html), CSS (*.css), SWF (*.swf), JS (*.js), RAR (*.rar), ZIP (*.zip), TAR (*.tar), GZ (*.gz)',
'fileExt' : '*.jpg;*.jpeg;*.jpe;*.jp2;*.jfif;*.gif;*.bmp;*.png;*.psd;*.eps;*.ico;*.tif;*.tiff;*.ai;*.raw;*.tga;*.mng;*.svg;*.doc;*.rtf;*.txt;*.wpd;*.wps;*.csv;*.xml;*.xsd;*.sql;*.pdf;*.xls;*.mdb;*.ppt;*.docx;*.xlsx;*.pptx;*.ppsx;*.artx;*.mp3;*.wma;*.mid;*.midi;*.mp4;*.mpg;*.mpeg;*.wav;*.ram;*.ra;*.avi;*.mov;*.flv;*.m4a;*.m4v;*.htm;*.html;*.css;*.swf;*.js;*.rar;*.zip;*.tar;*.gz',
'folder' : '<%=application("uploadpath")%>',
'multi' : true,
onError: function (a, b, c, d) {
if (d.status == 404)
alert('Could not find upload script. Use a path relative to: '+'<?= getcwd() ?>');
else if (d.type === "HTTP")
alert('error aaa'+d.type+": "+d.status);
else if (d.type ==="File Size")
alert(c.name+' '+d.type+' Limit: '+Math.round(d.sizeLimit/1024)+'KB');
else
alert('error '+d.type+": "+d.text);
},
onComplete : function(event, queueID, fileObj, response, data) {
var path = escape(fileObj.filePath);
$('#filesUploaded').append('<div class=\'uploadifyQueueItem\'><a href='+path+' target=\'_blank\'>'+fileObj.name+'</a></div>');
}
});
});
</script>
</head>
<body>
<form id="formIDdoc" name="formIDdoc" class="form" method="post" action="default.asp">
<p><input class="text-input" name="uploadify" id="uploadify" type="file" size="20" /></p>
<div id="filesUploaded"></div>
</form>
</body>
</html>
uploader214.asp
<!-- #include file="uploaderCLS.asp" -->
<%
'security
on error resume next
if application("sessionID")<>request.querystring("sId") then response.end
if application("sessionID")="" then response.end
if request.querystring("sId")="" then response.end
if err.number<>0 then response.end
on error goto 0
dim UploadiFyPath,UploadiFyFolder,UploadifyObject
UploadiFyPath = Request.ServerVariables("PATH_TRANSLATED")
UploadiFyPath = Replace(UploadiFyPath,"uploader214.asp","",1,-1,1)
UploadiFyFolder=application("uploadpath")
Set UploadifyObject = New FreeASPUpload
UploadifyObject.Save(Server.MapPath(UploadiFyFolder))
Response.Write("<HTML><HEAD></HEAD><BODY></BODY></HTML>")
%>
uploaderCLS.asp
<%
' 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
'costum rename
Dim fso, newFile
Set fso = CreateObject("Scripting.FileSystemObject")
uploadsDirVar = "C:\Inetpub\wwwroot\Umcg\SectorC\entree\JQupload1\userfiles"
newFile = uploadsDirVar&"\"& caseID & fileItem.FileName
response.write newFile
fso.MoveFile filePath, newFile
set fso = nothing
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
%>
Where you see fileItem.FileName is where the file is named. You would first want to define the name something like,
Now you probably need to change
Public Sub Save(path)
to
Public Sub Save(path, caseID)
caseID =request.querystring("name")
' check to make sure we have good data
if not isnumeric(nameID) then
caseID ="0_" ' if we have bad data, then set to zero.
else
caseID = caseID&"_"
end if
Now you probably need to change
Public Sub Save(path)
to
Public Sub Save(path, caseID)
ASKER
Hello Big Monty,
Thanks again for your response. I Don't understand just change only that line? It generates the same error.
Can tell me what to change based on the original situation?
Thanks
Thanks again for your response. I Don't understand just change only that line? It generates the same error.
Can tell me what to change based on the original situation?
Thanks
ASKER
Hello Scot,
Thanks for your quick response.
I don't understand
I've changed the files into the de code beneath but I still get the same error:
uploader214.asp
and uploaderCLS.asp
Thanks for your quick response.
I don't understand
I've changed the files into the de code beneath but I still get the same error:
uploader214.asp
<!-- #include file="uploaderCLS.asp" -->
<%
'security
on error resume next
if application("sessionID")<>request.querystring("sId") then response.end
if application("sessionID")="" then response.end
if request.querystring("sId")="" then response.end
if err.number<>0 then response.end
on error goto 0
dim UploadiFyPath,UploadiFyFolder,UploadifyObject, caseID
caseID=10
UploadiFyPath = Request.ServerVariables("PATH_TRANSLATED")
UploadiFyPath = Replace(UploadiFyPath,"uploader214.asp","",1,-1,1)
UploadiFyFolder=application("uploadpath")
Set UploadifyObject = New FreeASPUpload
UploadifyObject.Save(Server.MapPath(UploadiFyFolder),caseID)
Response.Write("<HTML><HEAD></HEAD><BODY></BODY></HTML>")
%>
and uploaderCLS.asp
<%
' 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
'costum rename
caseID =request.querystring("caseID")
' check to make sure we have good data
if not isnumeric(caseID) then
caseID ="0_" ' if we have bad data, then set to zero.
else
caseID = caseID&"_"
end if
Dim fso, newFile
Set fso = CreateObject("Scripting.FileSystemObject")
uploadsDirVar = "C:\Inetpub\wwwroot\Umcg\SectorC\entree\JQupload1\userfiles"
newFile = uploadsDirVar&"\"& caseID & fileItem.FileName
fso.MoveFile filePath, newFile
set fso = nothing
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
%>
do you get any info on where the error is occurring? such as what page and what line?
I can't find any reference to aaaHTTP anywhere in the code
I can't find any reference to aaaHTTP anywhere in the code
I think you have it a bit backwards. I think Big Monty and I gave you a similar answer except I added a safety function to not trust the incoming data from the querystring.
Try Big Monty's suggestion because that looks easier. Once that works you can add the extra function below. I always assume data from the url or form is bad.
This code would go at the top of your uploader214.asp page
Try Big Monty's suggestion because that looks easier. Once that works you can add the extra function below. I always assume data from the url or form is bad.
This code would go at the top of your uploader214.asp page
caseID =request.querystring("name")
' check to make sure we have good data
if not isnumeric(nameID) then
caseID ="0_" ' if we have bad data, then set to zero.
else
caseID = caseID&"_"
end if
ASKER
Sorry but this is the error I get and I can't get more details.
I've tried to make things work again and went back to a working version. I've had to remove the second parameter from line 19 in uploader214.asp and in line 79 in uploaderCLS.asp to make things work again.
Why does an extra parameter causes the script to crash?
Kind regards,
I've tried to make things work again and went back to a working version. I've had to remove the second parameter from line 19 in uploader214.asp and in line 79 in uploaderCLS.asp to make things work again.
Why does an extra parameter causes the script to crash?
Kind regards,
with both parameters removed, try changing:
newFile = uploadsDirVar&"\"& caseID & fileItem.FileName
to
newFile = uploadsDirVar&"\"& Request("caseID") & fileItem.FileName
newFile = uploadsDirVar&"\"& caseID & fileItem.FileName
to
newFile = uploadsDirVar&"\"& Request("caseID") & fileItem.FileName
ASKER
Yes ok I did but where do I set the value?
In default.asp but just by adding
caseID=10
or else?
Thanks
In default.asp but just by adding
caseID=10
or else?
Thanks
I think the best way about this would be not messing with the class at all as Big Monty suggested and use the original code for that. To change the file name, use FileSystemObject.
http://classicasp.aspfaq.com/files/directories-fso/can-i-rename-a-file-using-filesystemobject.html
http://www.w3schools.com/asp/asp_ref_filesystem.asp
http://classicasp.aspfaq.com/files/directories-fso/can-i-rename-a-file-using-filesystemobject.html
http://www.w3schools.com/asp/asp_ref_filesystem.asp
<%
set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile "c:\oldname.txt", "c:\newname.txt"
set fso = Nothing
%>
Go back to the script that was working and try the fso method.
ASKER
Hi Scott,
Thanks for your time but I don't know where to put wat....
This is my best guess:
uploader214.asp
but results in the same error and the strange error is caused by these lines in the javascript:
Removing that part of the code results only in loosing the error but the script malfunction stays and this time without any error.
Thanks for your time but I don't know where to put wat....
This is my best guess:
uploader214.asp
<!-- #include file="uploaderCLS.asp" -->
<%
caseID="10"
'security
on error resume next
if application("sessionID")<>request.querystring("sId") then response.end
if application("sessionID")="" then response.end
if request.querystring("sId")="" then response.end
if err.number<>0 then response.end
on error goto 0
dim UploadiFyPath,UploadiFyFolder,UploadifyObject
UploadiFyPath = Request.ServerVariables("PATH_TRANSLATED")
UploadiFyPath = Replace(UploadiFyPath,"uploader214.asp","",1,-1,1)
UploadiFyFolder=application("uploadpath")
Set UploadifyObject = New FreeASPUpload
UploadifyObject.Save(Server.MapPath(UploadiFyFolder))
oldFile = "userfiles\"&"\"& fileItem.FileName
newFile = "userfiles\"& caseID & fileItem.FileName
set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile oldFile, newFile
set fso = Nothing
Response.Write("<HTML><HEAD></HEAD><BODY></BODY></HTML>")
%>
but results in the same error and the strange error is caused by these lines in the javascript:
onError: function (a, b, c, d) {
if (d.status == 404)
alert('Could not find upload script. Use a path relative to: '+'<?= getcwd() ?>');
else if (d.type === "HTTP")
alert('error aaa'+d.type+": "+d.status);
else if (d.type ==="File Size")
alert(c.name+' '+d.type+' Limit: '+Math.round(d.sizeLimit/1024)+'KB');
else
alert('error '+d.type+": "+d.text);
},
Removing that part of the code results only in loosing the error but the script malfunction stays and this time without any error.
>With the help of Bib Monty I succeeded to rename the uploaded files.
Does that mean something is working without errors? is that the original code posted?
In your original code you have starting at line 97 what looks like should be renaming.
If all that is working without error, what happens if you try moving the caseID variable above the include file?
Does that mean something is working without errors? is that the original code posted?
In your original code you have starting at line 97 what looks like should be renaming.
'costum rename
Dim fso, newFile
Set fso = CreateObject("Scripting.FileSystemObject")
uploadsDirVar = "C:\Inetpub\wwwroot\Umcg\SectorC\entree\JQupload1\userfiles"
newFile = uploadsDirVar&"\"& caseID & fileItem.FileName
response.write newFile
fso.MoveFile filePath, newFile
set fso = nothing
If all that is working without error, what happens if you try moving the caseID variable above the include file?
<%
caseID="10_"
%>
<!-- #include file="uploaderCLS.asp" -->
<%
'security
on error resume next
if application("sessionID")<>request.querystring("sId") then response.end
if application("sessionID")="" then response.end
if request.querystring("sId")="" then response.end
if err.number<>0 then response.end
on error goto 0
dim UploadiFyPath,UploadiFyFolder,UploadifyObject
UploadiFyPath = Request.ServerVariables("PATH_TRANSLATED")
UploadiFyPath = Replace(UploadiFyPath,"uploader214.asp","",1,-1,1)
UploadiFyFolder=application("uploadpath")
Set UploadifyObject = New FreeASPUpload
UploadifyObject.Save(Server.MapPath(UploadiFyFolder))
Response.Write("<HTML><HEAD></HEAD><BODY></BODY></HTML>")
%>
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you very much
newFile = uploadsDirVar&"\"& caseID & fileItem.FileName
caseID isn't defined as a parameter in the Save() function. you could just change that line to read directly from the querystring:
newFile = uploadsDirVar&"\"& Request("caseID") & fileItem.FileName
that way you don't have to modify the class code