Thanks for looking at my posting here.
I am using an asp upload script (code below).
Logged-in users Browse for the file they want to Upload and select the Upload button, and it is uploaded to the designated directory.

I'd like to change this file so that the logged-in users email address is added to the file name before it arrives at the designated directory.

Presently the logged-in users' name appears on the Upload page,
where this code is shown on the page: <%=Trim(Session("PMMS_EMAIL"))%> (which is located about line 222)

Is it possible that you can capture the email address and add it to the file name (keeping the same extension) and separating the email address from the file name with ~~. Such as this example:

myLifestory.txt is changed to usersemail@hottmail.com~~myLifestory.txt
then it is sent to the designated directory?

Thanks.

<%@ Language=VBScript %>
<%
'option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
Dim MMS_GROUP_NUMBER
    MMS_GROUP_NUMBER = "2,3"
Call OPEN_DB()
    set PPLRS = MyConn.Execute( "SELECT * from mms_tbl_user_cate where fldUSER_ID = " & session( "PMMS_ID" ) &_
           " AND fldCATE_ID = 3" )
    IF NOT PPLRS.EOF THEN
    PPL_GROUP_MEMBER = "Y"
 END IF
 set PPLRS = nothing
 MyConn.close
    Set MyConn = Nothing
%>
<!--#include virtual="/MMS/aspUpload.asp" -->
<!--#include VIRTUAL="/MMS/app_config.asp"-->
<!--#include VIRTUAL="/MMS/inc_enforce.asp"-->
<!--#include file="inc_header.asp"-->
<%

' ****************************************************
  Dim uploadsDirVar
  uploadsDirVar = "C:/Documents and Settings/TAinput/"
' ****************************************************
function OutputForm()
%>
    <form name="frmSend" method="POST" enctype="multipart/form-data" action="uploadTester.asp" onSubmit="return onSubmitForm();">
 <B></B><br><input name="attach1" type="file" size=35><br>
    <!--File 2: <input name="attach2" type="file" size=35><br>-->
    <!--File 3: <input name="attach3" type="file" size=35><br>-->
    <!--File 4: <input name="attach4" type="file" size=35><br>-->
    <br>
 <!-- These input elements are obviously optional and just included here for demonstration purposes -->
 <!--<B>Additional fields (demo):</B><br>-->
 <!--Enter a number: <input type="text" name="enter_a_number" size="20"><br>-->
    <!--Checkbox values: <input type="checkbox" value="1" name="checkbox_values">-1 <input type="checkbox" value="2" name="checkbox_values">-2<br>-->
 <!-- End of additional elements -->
    <input style="margin-top:4" type=submit value="Upload">
    </form>
<%
end function
function TestEnvironment()
    Dim fso, fileName, testFile, streamTest
    TestEnvironment = ""
    Set fso = Server.CreateObject("Scripting.FileSystemObject")
    if not fso.FolderExists(uploadsDirVar) then
        TestEnvironment = "<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."
        exit function
    end if
    fileName = uploadsDirVar & "\test.txt"
    on error resume next
    Set testFile = fso.CreateTextFile(fileName, 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.setMaxFileSize 0.5, "m"
    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
            SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
        next
    else
        SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
    end if
 SaveFiles = SaveFiles & "" & Upload.Form("enter_a_number") & "<br>"
 SaveFiles = SaveFiles & "" & Upload.Form("checkbox_values") & "<br>"
end function
SUB updateDB_Logout
 Call OPEN_DB()
 MyConn.Execute( "UPDATE mms_tbl_user SET fldSTATUS = '" & drpSTATUS(5) & "' WHERE ID = " & Session("PMMS_ID") )
 IF Session("PMMS_IN") = "True" THEN
            Call APPEND_LOG(False, Session("PMMS_ID"), "Logs out.", Trim(sysVAL(7)))
        END IF
  MyConn.close
        Set MyConn = Nothing
  Session.Abandon
        Response.Redirect( "PPL_Logout.asp" )
        Response.end
END SUB
%>
 
<HTML>
<HEAD>
<Title>TEST</Title>
<style type="text/css">
body {margin: 1px 100px; padding: 1px; 0px}
</style>
</HEAD>
<BODY leftMargin=0 topMargin=0 marginheight="0" marginwidth="0"  body {border-left: 1px solid #000; }>
<SCRIPT LANGUAGE="JavaScript">errorcolor = '#eeeeee';</Script>
<table cellspacing=0 border=0 cellpadding=40 width=100% align=left>
 <tr>
  <td align=left valign=middle>
<script language="JAVASCRIPT">
 var errfound = false;
  function ValidLength(item, len) {
     return (item.length >= len);
  }
  function error(elem, text) {
     if (errfound) return;
     window.alert(text);
     elem.select();
     elem.focus();
     elem.style.backgroundColor=errorcolor;
     errfound = true;
  }
  function Validate() {
     errfound = false;
     d=document.login
     if (!ValidLength(d.members_username.value,1))error(d.members_username,"Username should not be blank.");
     if (!ValidLength(d.members_password.value,1))error(d.members_password,"Password should not be blank.");
     return !errfound;
  }
</script>
<TR valign=top>
<div style="border:0px solid #000000; width: 705px; padding-left: 75px; text-align:top;">

<style>
BODY {background-color: white;font-family:arial; font-size:12}
</style>
<script>
function onSubmitForm() {
    var formDOMObj = document.frmSend;
    if (formDOMObj.attach1.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>
<br><br>
<div style="border-bottom: #A91905 2px solid;font-size:16">1. Select(Click) the Browse Button<br>
2. Choose Your File For Uploading<br>
3. Select(Click) the Upload Button<br><br></div>
<%
Dim diagnostics
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
    diagnostics = TestEnvironment()
    if diagnostics<>"" then
        response.write "<div style=""margin-left:20; margin-top:30; margin-right:30; margin-bottom:30;"">"
        response.write diagnostics
        response.write "<p>After you correct this problem, reload the page."
        response.write "</div>"
    else
        response.write "<div style=""margin-left:5"">"
        OutputForm()
        response.write "</div>"
    end if
else
    response.write "<div style=""margin-left:5"">"
    OutputForm()
    response.write SaveFiles()
    response.write "<br><br></div>"
    IF PPL_GROUP_MEMBER = "Y" THEN
     updateDB_Logout
 end if
end if
%>
<%=Trim(Session("PMMS_EMAIL"))%>
<br><br>
</p></div></tr></td></tr>
</table></TD></TR></TABLE>
  </TD>
 </TR>
</TABLE>
<TABLE cellSpacing=0 valign=bottom cellPadding=0 width=100% border=0>
 <TR valign=top height=4>
  <TD colspan=2 class=gray><IMG src="/smusermanager/images/clear.gif" height=4 width=25 border=0></TD>
 </TR>
 <TR valign=middle height=25>
  <TD class=headera2>&nbsp;<FONT class=linksmall><font face="Arial" color="#ffffff" size="2">Copyright © 2007 <a href="" target="_blank"></a>. All Rights Reserved.</FONT></TD>
  <TD align=right class=headera2><font class=linksmall><font face="Arial" color="#ffffff" size="2">Email : <A href=""></A> &nbsp;&nbsp;&nbsp; </font></TD>
 </TR>
</TABLE>
</Body>
</BODY>
</HTML>

You can but not in the code you posted

find this line

			streamFile.SaveToFile m_sUploadFolder & fileItem.FileName, 2

in the class file

and concatenate the email address to the filename

Hi Chris,

Thanks so much for your reply. You are brilliant! and very kind to reply to my posting. I have found a line (line 134) in the aspupload file, that looks similar to the line you suggested, but it isn't the exact line. it is:
streamFile.SaveToFile path & fileItem.FileName, 2

You said find that line in the class file. As far as i know there are only two files for this upload script, the one in the previous thread, that you said "not in" there, so i assumed it was in the other file which I posted below. But I don't see the line:

streamFile.SaveToFile m_sUploadFolder & fileItem.FileName, 2

What am I missing?

I really don't know how to "concatenate the email address to the filename". Would you be interested in helping me with that? I would greatly, greatly appreciate any assistance.

<%
'  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
' November 2007 added file size limitations and file extension checking
Class FreeASPUpload
 Public UploadedFiles
 Public FormElements
 Private VarArrayBinRequest
 Private StreamRequest
 Private uploadedYet
' added by Chris Hirst www.candsdesign.co.uk November 2007
 private m_lMaxFileSize
 private m_sByteMultiplier
 private m_sFileError
 private m_bFileError
' **********************************************
 Private Sub Class_Initialize()
  Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")
  Set FormElements = Server.CreateObject("Scripting.Dictionary")
  Set StreamRequest = Server.CreateObject("ADODB.Stream")
  StreamRequest.Type = 1 'adTypeBinary
  StreamRequest.Open
  uploadedYet = false
'  m_lMaxFileSize = 10000
 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
' ***************** new properties and methods
' added by Chris Hirst www.candsdesign.co.uk  November 2007
 public function  setMaxFileSize(ByVal Val, Mult)
  m_sByteMultiplier = Mult
  select case lcase(m_sByteMultiplier)
   case ""
    m_lMaxFileSize = Val
   case "k"
    m_lMaxFileSize = Val * 1024
   case "m"
    m_lMaxFileSize = Val * (1024 * 1024)
  end select
 end function
 public property get MaxFileSize()
  MaxFileSize = m_lMaxFileSize
 end property
 public property get Error()
  Error = m_bFileError
 end property
 public property get ErrorStatus()
  ErrorStatus = m_sFileError
 end property
 private function CheckExtension(strIn)
 ' function to validate numeric input
  dim objRE
  set objRE = New RegExp
  objRE.Pattern = "^.+\.((txt)|(pdf)|(html)|(htm)|(doc)|(rtf))$"
  objRE.Global = True
  CheckExtension = objRE.test(strIn)
  set objRE = nothing
 end function
 public function getMult()
  select case lcase(m_sByteMultiplier)
   case ""
    getMult = "Bytes"
   case "k"
    getMult = "Kilobytes"
   case "m"
    getMult = "Megabytes"
  end select
 end function
' *************** end new property
 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
 'Calls Upload to extract the data from the binary request and then saves the uploaded files
 ' Save method recoded November 2007 to add checks for files size and extensions
 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
  m_bFileError = false
  if fileItem.Length > m_lMaxFileSize then
   m_sFileError = "Exceeds maximum filesize"
   m_bFileError = true
  end if
  if not CheckExtension(fileItem.FileName)  then
   m_sFileError = "Invalid filetype"
   m_bFileError = true
  end if
  if not m_bFileError then
   Set streamFile = Server.CreateObject("ADODB.Stream")
   streamFile.Type = 1
   streamFile.Open
   StreamRequest.Position=fileItem.Start
   StreamRequest.CopyTo streamFile, fileItem.Length
   streamFile.SaveToFile path & fileItem.FileName, 2
   streamFile.close
   Set streamFile = Nothing
   fileItem.Path = path & fileItem.FileName
  else
   fileItem.FileName = fileItem.FileName & " Discarded - " & m_sFileError
  end if
   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-Disposition")
  tContentType = Byte2String("Content-Type:")
  uploadedYet = true
  on error resume next
  VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)
  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 streaa:
                    '    ?? 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
    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(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
    else
                    FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
                end if
   End If
   'Advance to next separator
   nDataBoundPos = FindToken(vDataSep, nCurPos)
  Loop
  StreamRequest.Write(VarArrayBinRequest)
 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(VarArrayBinRequest, 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
%>

Worked it. Got it. Thanks for heading me in the right direction.