brainbolt
asked on
FreeASPUpload - Need help preventing overwrite
I need help tweaking freeASPUpload (http://www.freeaspupload.net).
I've been able to modifiy it to insert additional text fields to an Access DB while the file is uploaded, but I need to put in some overwrite protection. Currently, if a user uploads a file with a duplicate name, the older file is overwritten, which is unacceptable for this application.
I'm open to either checking if the filename already exists in the destination folder and stopping the upload process, or renaming the file if a duplicate name is found, but I haven't been able to succesfully implement either one of those options. I am new to ASP, so please bear with me.
Here are my files:
uploadTester3.asp - modified version of uploadTester.asp
************* START UPLOADTESTER3.ASP *******************
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
%>
<!-- #include file="freeaspupload.asp" -->
<%
dim SONum
SONum=Request.Querystring( "csono_tri m")
' ************************** ********** ********** ******
' Change the value of the variable below to the pathname
' of a directory with write permissions, for example "C:\Inetpub\wwwroot"
Dim uploadsDirVar
uploadsDirVar = "e:\shared\sodocs\" & SONum & "\"
' ************************** ********** ********** ******
' Note: this file uploadTester.asp is just an example to demonstrate
' the capabilities of the freeASPUpload.asp class. There are no plans
' to add any new features to uploadTester.asp itself. Feel free to add
' your own code. If you are building a content management system, you
' may also want to consider this script: http://www.webfilebrowser.com/
function OutputForm()
%>
<h2 align="center">Upload new document for <% = SONum %></h2>
<div align=center>
<form name="frmSend" method="POST" enctype="multipart/form-da ta" action="" onSubmit="return onSubmitForm();">
<input type="hidden" name="dupdate" value="<% = date & " " & time %>">
<input type="hidden" name="csono_trim" value=<% = SONum %>>
Click "Browse" to locate the files to upload<br>
<table border="1" id="table1" bordercolordark="#000000" cellspacing="0">
<tr bgcolor="#E5E5E5">
<td><b>File</b></td>
<td><b>Type</b></td>
<td><b>Notes</b></td>
</tr>
<tr>
<td> <input name="filename" type="file" size=35></td>
<td><select size="1" name="doctype">
<option value="DRAWING">Drawing</o ption>
<option value="PROPOSAL">Proposal< /option>
<option value="FRTQUOTE">Freight Quote</option>
<option value="SGNDRAWING">Signed Drawing</option>
<option value="SGNPROPOSA">Signed Proposal</option>
<option value="SGNTERMS">Signed Terms</option>
<option value="SGNINSTALL">Signed Install Waiver</option>
<option value="PACKLIST">Packing List</option>
<option value="FRTBILL">Bill Of Lading</option>
<option value="PUNCHSO">Punch SO</option>
</select></td>
<td> <input name="docnotes" type="text" size=35></td>
</tr>
</table>
<p>
<input style="margin-top:4" type=submit value="Upload">
</p>
</form>
</div>
<%
end function
function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scrip ting.FileS ystemObjec t")
if not fso.FolderExists(uploadsDi rVar) then
Fso.CreateFolder(uploadsDi rVar)
'TestEnvironment = "<div align=center><B>Folder " & uploadsDirVar & " does not exist.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions.</div>"
'exit function
end if
fileName = uploadsDirVar & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileNam e, true)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
Err.Clear
testFile.Close
fso.DeleteFile(fileName)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have delete permissions</B>, although it does have write permissions.<br>Change the permissions for IUSR_<I>computername</I> on this folder."
exit function
end if
Err.Clear
Set streamTest = Server.CreateObject("ADODB .Stream")
If Err.Number<>0 then
TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."
exit function
end if
Set streamTest = Nothing
end function
function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function
SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
'''''' GET FILENAME ''''''''
dim filenameee
filenameee = Upload.UploadedFiles(fileK ey).FileNa me
''''''' END FILENAME '''''''
'SaveFiles = SaveFiles & Upload.UploadedFiles(fileK ey).FileNa me & " (" & Upload.UploadedFiles(fileK ey).Length & "B) "
'SaveFiles = SaveFiles & Upload.UploadedFiles(fileK ey).FileNa me
SaveFiles = Upload.UploadedFiles(fileK ey).FileNa me
next
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
'''''''''''''''''''''''''' '''''INSER T STATEMENT''''''''''''''''' '''''''''' '''''''''' '''''''''' '''''''
dim ssql
dim connection
dim sconnstring
'To get information from any other textfields use this code.
dim varDupdate
dim varCsono_trim
dim varDoctype
dim varDocnotes
varDupdate = upload.form("dupdate")
varCsono_trim = upload.form("csono_trim")
varDoctype = upload.form("doctype")
varDocnotes = upload.form("docnotes")
sSQL="INSERT INTO [sodocs] (csono_trim,dupdate,filena me,doctype ,docnotes) VALUES ('" & varCsono_trim & "','" & varDupdate & "','" & filenameee & "','" & varDoctype & "','" & varDocnotes & "')"
sConnString="PROVIDER=Micr osoft.Jet. OLEDB.4.0; " & _
"Data Source=e:\inetpub\database s\am_soman ager.mdb"
'"Data Source=" & Server.MapPath("accessdb.m db")
Set connection = Server.CreateObject("ADODB .Connectio n")
connection.Open(sConnStrin g)
connection.execute(sSQL)
Connection.Close
Set Connection = Nothing
'Response.AddHeader "Refresh", "2;URL=it.asp?csono_trim=" & SOnum
end function
%>
<HTML>
<HEAD>
<TITLE>SO Document Manager</TITLE>
<script>
function onSubmitForm() {
var formDOMObj = document.frmSend;
if (formDOMObj.filename.value == "" )
// && formDOMObj.attach2.value == "" && formDOMObj.attach3.value == "" && formDOMObj.attach4.value == "" )
alert("Please press the browse button and pick a file.")
else
return true;
return false;
}
</script>
</HEAD>
<BODY>
<%
Dim diagnostics
if Request.ServerVariables("R EQUEST_MET HOD") <> "POST" then
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write diagnostics
response.write "<p>After you correct this problem, reload the page."
else
OutputForm()
end if
else
OutputForm()
response.write "<center><b>Uploaded: </b>" & SaveFiles() & "</center>"
response.write "<br>"
end if
%>
<%
dim conn, rsDoclist
set conn=Server.CreateObject(" ADODB.Conn ection")
conn.Provider="Microsoft.J et.OLEDB.4 .0"
conn.Open "e:\inetpub\databases\am_s omanager.m db"
set rsDoclist = Server.CreateObject("ADODB .recordset ")
rsDoclist.Open "SELECT dupdate, filename, doctype, docnotes FROM sodocs WHERE csono_trim='" & SONum & "' ORDER BY dupdate DESC", conn
%>
<h2 align="center">Existing document list for <% = SONum %></h2>
<table border="1" id="table2" bordercolordark="#000000" cellspacing="0" align=center>
<tr>
<td bgcolor="#E5E5E5"><b>Date Added</b></td>
<td bgcolor="#E5E5E5"><b>File< /b></td>
<td bgcolor="#E5E5E5"><b>Type< /b></td>
<td bgcolor="#E5E5E5"><b>Notes </b></td>
</tr>
<%do until rsDoclist.EOF%>
<tr>
<td><% = rsDoclist.Fields("dupdate" ).Value %></td>
<td><a href="../../SODocs/<% = SONum %>/<% = rsDoclist.Fields("filename ").Value %>"><% = rsDoclist.Fields("filename ").Value %></a></td>
<td><% = rsDoclist.Fields("doctype" ).Value %></td>
<td><% = rsDoclist.Fields("docnotes ").Value %></td>
</tr>
<%
rsDoclist.MoveNext
loop
rsDoclist.close
conn.close%>
</table>
</BODY>
</HTML>
************* END UPLOADTESTER3.ASP *******************
freeASPUpload.asp - unmodified from the original
************* START FREEASPUPLOAD.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
Class FreeASPUpload
Public UploadedFiles
Public FormElements
Private VarArrayBinRequest
Private StreamRequest
Private uploadedYet
Private Sub Class_Initialize()
Set UploadedFiles = Server.CreateObject("Scrip ting.Dicti onary")
Set FormElements = Server.CreateObject("Scrip ting.Dicti onary")
Set StreamRequest = Server.CreateObject("ADODB .Stream")
StreamRequest.Type = 1 'adTypeBinary
StreamRequest.Open
uploadedYet = false
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(sI ndex))
End Property
Public Property Get Files()
Files = UploadedFiles.Items
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
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB .Stream")
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fil eItem.Star t
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
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
Private Sub Upload()
Dim nCurPos, nDataBoundPos, nLastSepPos
Dim nPosFile, nPosBound
Dim sFieldName, osPathSep, auxStr
'RFC1867 Tokens
Dim vDataSep
Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
tNewLine = Byte2String(Chr(13))
tDoubleQuotes = Byte2String(Chr(34))
tTerm = Byte2String("--")
tFilename = Byte2String("filename=""")
tName = Byte2String("name=""")
tContentDisp = Byte2String("Content-Dispo sition")
tContentType = Byte2String("Content-Type: ")
uploadedYet = true
on error resume next
VarArrayBinRequest = Request.BinaryRead(Request .TotalByte s)
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 -------------------------- ---2176313 8716045
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(auxSt r, 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 streaa:
' ?? python py type=?? python application/x-python
oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxSt r, " "))
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
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
nEndOfData = FindToken(vDataSep, nCurPos) - 2
If Not FormElements.Exists(LCase( sFieldName )) Then
FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayB inRequest, nCurPos, nEndOfData-nCurPos))
else
FormElements.Item(LCase(sF ieldName)) = FormElements.Item(LCase(sF ieldName)) & ", " & String2Byte(MidB(VarArrayB inRequest, nCurPos, nEndOfData-nCurPos))
end if
End If
'Advance to next separator
nDataBoundPos = FindToken(vDataSep, nCurPos)
Loop
StreamRequest.Write(VarArr ayBinReque st)
End Sub
Private Function SkipToken(sToken, nStart)
SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
If SkipToken = 0 then
Response.write "Error in parsing uploaded binary request."
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 = String2Byte(MidB(VarArrayB inRequest, nStart, nEnd-nStart))
End Function
'String to byte string conversion
Private Function Byte2String(sString)
Dim i
For i = 1 to Len(sString)
Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1) ))
Next
End Function
'Byte string to string conversion
Private Function String2Byte(bsString)
Dim i
String2Byte =""
For i = 1 to LenB(bsString)
String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1 )))
Next
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
%>
************* END FREEASPUPLOAD.ASP *******************
Sorry for the long post, but I thought it would be better than linking to the files.
I've been able to modifiy it to insert additional text fields to an Access DB while the file is uploaded, but I need to put in some overwrite protection. Currently, if a user uploads a file with a duplicate name, the older file is overwritten, which is unacceptable for this application.
I'm open to either checking if the filename already exists in the destination folder and stopping the upload process, or renaming the file if a duplicate name is found, but I haven't been able to succesfully implement either one of those options. I am new to ASP, so please bear with me.
Here are my files:
uploadTester3.asp - modified version of uploadTester.asp
************* START UPLOADTESTER3.ASP *******************
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
%>
<!-- #include file="freeaspupload.asp" -->
<%
dim SONum
SONum=Request.Querystring(
' **************************
' Change the value of the variable below to the pathname
' of a directory with write permissions, for example "C:\Inetpub\wwwroot"
Dim uploadsDirVar
uploadsDirVar = "e:\shared\sodocs\" & SONum & "\"
' **************************
' Note: this file uploadTester.asp is just an example to demonstrate
' the capabilities of the freeASPUpload.asp class. There are no plans
' to add any new features to uploadTester.asp itself. Feel free to add
' your own code. If you are building a content management system, you
' may also want to consider this script: http://www.webfilebrowser.com/
function OutputForm()
%>
<h2 align="center">Upload new document for <% = SONum %></h2>
<div align=center>
<form name="frmSend" method="POST" enctype="multipart/form-da
<input type="hidden" name="dupdate" value="<% = date & " " & time %>">
<input type="hidden" name="csono_trim" value=<% = SONum %>>
Click "Browse" to locate the files to upload<br>
<table border="1" id="table1" bordercolordark="#000000" cellspacing="0">
<tr bgcolor="#E5E5E5">
<td><b>File</b></td>
<td><b>Type</b></td>
<td><b>Notes</b></td>
</tr>
<tr>
<td> <input name="filename" type="file" size=35></td>
<td><select size="1" name="doctype">
<option value="DRAWING">Drawing</o
<option value="PROPOSAL">Proposal<
<option value="FRTQUOTE">Freight Quote</option>
<option value="SGNDRAWING">Signed Drawing</option>
<option value="SGNPROPOSA">Signed Proposal</option>
<option value="SGNTERMS">Signed Terms</option>
<option value="SGNINSTALL">Signed Install Waiver</option>
<option value="PACKLIST">Packing List</option>
<option value="FRTBILL">Bill Of Lading</option>
<option value="PUNCHSO">Punch SO</option>
</select></td>
<td> <input name="docnotes" type="text" size=35></td>
</tr>
</table>
<p>
<input style="margin-top:4" type=submit value="Upload">
</p>
</form>
</div>
<%
end function
function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scrip
if not fso.FolderExists(uploadsDi
Fso.CreateFolder(uploadsDi
'TestEnvironment = "<div align=center><B>Folder " & uploadsDirVar & " does not exist.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions.</div>"
'exit function
end if
fileName = uploadsDirVar & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileNam
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
Err.Clear
testFile.Close
fso.DeleteFile(fileName)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have delete permissions</B>, although it does have write permissions.<br>Change the permissions for IUSR_<I>computername</I> on this folder."
exit function
end if
Err.Clear
Set streamTest = Server.CreateObject("ADODB
If Err.Number<>0 then
TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."
exit function
end if
Set streamTest = Nothing
end function
function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function
SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
'''''' GET FILENAME ''''''''
dim filenameee
filenameee = Upload.UploadedFiles(fileK
''''''' END FILENAME '''''''
'SaveFiles = SaveFiles & Upload.UploadedFiles(fileK
'SaveFiles = SaveFiles & Upload.UploadedFiles(fileK
SaveFiles = Upload.UploadedFiles(fileK
next
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
''''''''''''''''''''''''''
dim ssql
dim connection
dim sconnstring
'To get information from any other textfields use this code.
dim varDupdate
dim varCsono_trim
dim varDoctype
dim varDocnotes
varDupdate = upload.form("dupdate")
varCsono_trim = upload.form("csono_trim")
varDoctype = upload.form("doctype")
varDocnotes = upload.form("docnotes")
sSQL="INSERT INTO [sodocs] (csono_trim,dupdate,filena
sConnString="PROVIDER=Micr
"Data Source=e:\inetpub\database
'"Data Source=" & Server.MapPath("accessdb.m
Set connection = Server.CreateObject("ADODB
connection.Open(sConnStrin
connection.execute(sSQL)
Connection.Close
Set Connection = Nothing
'Response.AddHeader "Refresh", "2;URL=it.asp?csono_trim="
end function
%>
<HTML>
<HEAD>
<TITLE>SO Document Manager</TITLE>
<script>
function onSubmitForm() {
var formDOMObj = document.frmSend;
if (formDOMObj.filename.value
// && formDOMObj.attach2.value == "" && formDOMObj.attach3.value == "" && formDOMObj.attach4.value == "" )
alert("Please press the browse button and pick a file.")
else
return true;
return false;
}
</script>
</HEAD>
<BODY>
<%
Dim diagnostics
if Request.ServerVariables("R
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write diagnostics
response.write "<p>After you correct this problem, reload the page."
else
OutputForm()
end if
else
OutputForm()
response.write "<center><b>Uploaded: </b>" & SaveFiles() & "</center>"
response.write "<br>"
end if
%>
<%
dim conn, rsDoclist
set conn=Server.CreateObject("
conn.Provider="Microsoft.J
conn.Open "e:\inetpub\databases\am_s
set rsDoclist = Server.CreateObject("ADODB
rsDoclist.Open "SELECT dupdate, filename, doctype, docnotes FROM sodocs WHERE csono_trim='" & SONum & "' ORDER BY dupdate DESC", conn
%>
<h2 align="center">Existing document list for <% = SONum %></h2>
<table border="1" id="table2" bordercolordark="#000000" cellspacing="0" align=center>
<tr>
<td bgcolor="#E5E5E5"><b>Date Added</b></td>
<td bgcolor="#E5E5E5"><b>File<
<td bgcolor="#E5E5E5"><b>Type<
<td bgcolor="#E5E5E5"><b>Notes
</tr>
<%do until rsDoclist.EOF%>
<tr>
<td><% = rsDoclist.Fields("dupdate"
<td><a href="../../SODocs/<% = SONum %>/<% = rsDoclist.Fields("filename
<td><% = rsDoclist.Fields("doctype"
<td><% = rsDoclist.Fields("docnotes
</tr>
<%
rsDoclist.MoveNext
loop
rsDoclist.close
conn.close%>
</table>
</BODY>
</HTML>
************* END UPLOADTESTER3.ASP *******************
freeASPUpload.asp - unmodified from the original
************* START FREEASPUPLOAD.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
Class FreeASPUpload
Public UploadedFiles
Public FormElements
Private VarArrayBinRequest
Private StreamRequest
Private uploadedYet
Private Sub Class_Initialize()
Set UploadedFiles = Server.CreateObject("Scrip
Set FormElements = Server.CreateObject("Scrip
Set StreamRequest = Server.CreateObject("ADODB
StreamRequest.Type = 1 'adTypeBinary
StreamRequest.Open
uploadedYet = false
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(
End Property
Public Property Get Files()
Files = UploadedFiles.Items
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
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fil
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
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)
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
Private Sub Upload()
Dim nCurPos, nDataBoundPos, nLastSepPos
Dim nPosFile, nPosBound
Dim sFieldName, osPathSep, auxStr
'RFC1867 Tokens
Dim vDataSep
Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
tNewLine = Byte2String(Chr(13))
tDoubleQuotes = Byte2String(Chr(34))
tTerm = Byte2String("--")
tFilename = Byte2String("filename=""")
tName = Byte2String("name=""")
tContentDisp = Byte2String("Content-Dispo
tContentType = Byte2String("Content-Type:
uploadedYet = true
on error resume next
VarArrayBinRequest = Request.BinaryRead(Request
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
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 --------------------------
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
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
' 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(auxSt
if (Len(oUploadFile.FileName)
nCurPos = SkipToken(tContentType, nCurPos)
auxStr = ExtractField(tNewLine, nCurPos)
' NN on UNIX puts things like this in the streaa:
' ?? python py type=?? python application/x-python
oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxSt
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
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
nEndOfData = FindToken(vDataSep, nCurPos) - 2
If Not FormElements.Exists(LCase(
FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayB
else
FormElements.Item(LCase(sF
end if
End If
'Advance to next separator
nDataBoundPos = FindToken(vDataSep, nCurPos)
Loop
StreamRequest.Write(VarArr
End Sub
Private Function SkipToken(sToken, nStart)
SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
If SkipToken = 0 then
Response.write "Error in parsing uploaded binary request."
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 = String2Byte(MidB(VarArrayB
End Function
'String to byte string conversion
Private Function Byte2String(sString)
Dim i
For i = 1 to Len(sString)
Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)
Next
End Function
'Byte string to string conversion
Private Function String2Byte(bsString)
Dim i
String2Byte =""
For i = 1 to LenB(bsString)
String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1
Next
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
%>
************* END FREEASPUPLOAD.ASP *******************
Sorry for the long post, but I thought it would be better than linking to the files.
Ahhhh, I should have read your code closer...
Within the class, we see:
Public Sub Save(path)
Dim streamFile, fileItem
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB .Stream")
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fil eItem.Star t
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub
At that point, we have access to the filename: fileItem.FileName. So, that's our hook! Just before that, you will need to use FSO to check to see if the file exists. If so, call a function to rip parse the filename and create a valid unique similar name and return that.
Does that make sense? Which parts of that will you need help with?
Within the class, we see:
Public Sub Save(path)
Dim streamFile, fileItem
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fil
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub
At that point, we have access to the filename: fileItem.FileName. So, that's our hook! Just before that, you will need to use FSO to check to see if the file exists. If so, call a function to rip parse the filename and create a valid unique similar name and return that.
Does that make sense? Which parts of that will you need help with?
ASKER
well, to be completely honest; most of them. Here is what I am thinking I should do, but im shakey on the details
<%
Set fs=Server.CreateObject("Sc ripting.Fi leSystemOb ject")
If (fs.FileExists(<<path & filename vars: not sure where to get them at this point>>))=true Then
Public Sub Save(path)
Dim streamFile, fileItem
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB .Stream")
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fil eItem.Star t
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub
Else
<< function to " rip parse the filename and create a valid unique similar name and return that", as you say, but not sure where to start or what to look for>>
End If
set fs=nothing
%>
<%
Set fs=Server.CreateObject("Sc
If (fs.FileExists(<<path & filename vars: not sure where to get them at this point>>))=true Then
Public Sub Save(path)
Dim streamFile, fileItem
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fil
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub
Else
<< function to " rip parse the filename and create a valid unique similar name and return that", as you say, but not sure where to start or what to look for>>
End If
set fs=nothing
%>
ASKER
sorry, reversed the logic. if the file exists=true, run the rename function, else, run the existing public sub detailed above.
I have to run home soon, but I'll get the code up for you soon.
you could simply change this line:
SaveFiles = Upload.UploadedFiles(fileK ey).FileNa me
to:
SaveFiles = replace(replace(now,"/","" ),":","") & Upload.UploadedFiles(fileK ey).FileNa me
this will prefix the filename with a date time stamp
SaveFiles = Upload.UploadedFiles(fileK
to:
SaveFiles = replace(replace(now,"/",""
this will prefix the filename with a date time stamp
That would make his insert statement be incorrect don't you think?
I disagree kev. We have to hook it in the class so the physical filename matches the name in the database. At the point you mention, the file has already been overwritten, but you are storing the new filename in the database.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
kevp75,
the DB insert process was a tweak that I found online done by someone else and I am having a hard time discerning which functions happen "before" the others in this page. Like I said, I'm fairly new to this, so bear with me. The person that did the insert revision apparently didn't need the overwrite protection im looking for.
To use your suggestion, would I need to change the order of things for the insert process?
the DB insert process was a tweak that I found online done by someone else and I am having a hard time discerning which functions happen "before" the others in this page. Like I said, I'm fairly new to this, so bear with me. The person that did the insert revision apparently didn't need the overwrite protection im looking for.
To use your suggestion, would I need to change the order of things for the insert process?
nah....forgo my first suggestion, and try the one above your latest post
ASKER
kevp75,
the upload succeeded, but the filename and the filename entry in the db are different:
New file name: "7242007 50027 PM1.pdf"
entered in db: "1.pdf"
the upload succeeded, but the filename and the filename entry in the db are different:
New file name: "7242007 50027 PM1.pdf"
entered in db: "1.pdf"
ASKER
I don't know if this is the best solution, but I just added the same timestamp to the insert statement for the filename, and it does the job.
I changed the format of the timestamp a little so it is more conventional ("20070724170027" instead of "7242007 50027 PM"), but I am wondering how much more difficult it would be to add the stamp to the end of the filename instead of the beginning. In other words, I would like to end up with filename_20070724170027.pd f instead of 20070724170027_filename.pd f, which is preferable for filename sorting purposes.
Any ideas?
I changed the format of the timestamp a little so it is more conventional ("20070724170027" instead of "7242007 50027 PM"), but I am wondering how much more difficult it would be to add the stamp to the end of the filename instead of the beginning. In other words, I would like to end up with filename_20070724170027.pd
Any ideas?
As I said....
Ok, I'm writing the code now. Will post soon.
Ok, I'm writing the code now. Will post soon.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
in the case that they 2 files are uploaded at the same time...might I recommend another function, and appengin that to the file name:
Function rndID(byVal maxLen)
Dim strNewCode
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
If whatsNext = 0 Then
upper = 90
lower = 65
Else
upper = 57
lower = 48
End If
strNewCode = strNewCode & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
rndID = strNewCode
end function
and then:
streamFile.SaveToFile path & rndID(10) & fileItem.FileName, 2 'you can put whatever number you need in this function call
Function rndID(byVal maxLen)
Dim strNewCode
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
If whatsNext = 0 Then
upper = 90
lower = 65
Else
upper = 57
lower = 48
End If
strNewCode = strNewCode & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
rndID = strNewCode
end function
and then:
streamFile.SaveToFile path & rndID(10) & fileItem.FileName, 2 'you can put whatever number you need in this function call
ASKER
Here is what I ended up doing:
I added this code to uploadTester3.asp for a timestamp that I prefer over the one suggested (it does away with AM/PM issues)
<%
dim dte, yr, mth, dy, hr, min, sec, timestamp
dte = now()
yr = year(dte)
if len(month(dte)) = 1 then
mth= 0 & month(dte)
else
mth= month(dte)
End if
if len(day(dte)) = 1 then
dy= 0 & day(dte)
else
dy= day(dte)
End if
if len(hour(dte)) = 1 then
hr=0 & hour(dte)
else
hr= hour(dte)
End if
if len(minute(dte)) = 1 then
min= 0 & minute(dte)
else
min= minute(dte)
End if
if len(second(dte)) = 1 then
sec = 0 & second(dte)
else
sec= second(dte)
End if
timestamp = yr & mth & dy & hr & min & sec
%>
Then I modified L00M's last suggestion slightly to use the new timestamp var:
' Need to remove characters that are valid in UNIX, but not in Windows
Public Property Let FileName(fN)
nameOfFile = timestamp & "_" & fN
Which gives me an output of "20070725103847_2.pdf" for the filenames and DB entries.
Im not worried about duplicate entries with the same name because the likelihood of two people uploading the exact same file to the exact same folder at the exact same second in this environment is extremely unlikely.
Thanks for the help, guys.
I added this code to uploadTester3.asp for a timestamp that I prefer over the one suggested (it does away with AM/PM issues)
<%
dim dte, yr, mth, dy, hr, min, sec, timestamp
dte = now()
yr = year(dte)
if len(month(dte)) = 1 then
mth= 0 & month(dte)
else
mth= month(dte)
End if
if len(day(dte)) = 1 then
dy= 0 & day(dte)
else
dy= day(dte)
End if
if len(hour(dte)) = 1 then
hr=0 & hour(dte)
else
hr= hour(dte)
End if
if len(minute(dte)) = 1 then
min= 0 & minute(dte)
else
min= minute(dte)
End if
if len(second(dte)) = 1 then
sec = 0 & second(dte)
else
sec= second(dte)
End if
timestamp = yr & mth & dy & hr & min & sec
%>
Then I modified L00M's last suggestion slightly to use the new timestamp var:
' Need to remove characters that are valid in UNIX, but not in Windows
Public Property Let FileName(fN)
nameOfFile = timestamp & "_" & fN
Which gives me an output of "20070725103847_2.pdf" for the filenames and DB entries.
Im not worried about duplicate entries with the same name because the likelihood of two people uploading the exact same file to the exact same folder at the exact same second in this environment is extremely unlikely.
Thanks for the help, guys.
Glad to help!
Thanks for the points!
Thanks for the points!
Glad we could help.
If file does not exist in DESTBOX, move it from INBOX to DESTBOX.
If file DOES exist in DESTBOX, change the filename and try again until a valid file name has been found.
I'm not sure of your skill level, so if you choose to implement this approach, let me know if you require assistance.