SitePoint Sponsor

User Tag List

Results 1 to 3 of 3
  1. #1
    SitePoint Member
    Join Date
    Oct 2004
    Location
    mUMBAI
    Posts
    4
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Multiple file Upload

    Hi

    I am in need to upload multiple files.I am Using following asp code :

    SCompanyCode = Request.QueryString("SCompanyCode")

    Set upl = Server.CreateObject("SoftArtisans.FileUp")
    upl.Path = Server.Mappath("Clients\"&SCompanyCode)

    arrFile1 = split(upl.Form("file1"),"\")
    filename1 = trim(arrFile1(ubound(arrFile1)))

    arrFile2 = split(upl.Form("file2"),"\")
    filename2 = trim(arrFile2(ubound(arrFile2)))

    Response.write filename1
    Response.write filename2

    if upl.Form("file1").TotalBytes > 0 then
    upl.SaveAs filename1
    end if
    if upl.Form("file2").TotalBytes > 0 then
    upl.SaveAs filename2
    end if

    The error is it shows file names with .temp extension and it doesn't save the file.

    Can't guess what's the problem.

    Can any body master in multiple file upload help me :'(

  2. #2
    Guru Bullschmidt's Avatar
    Join Date
    Apr 2002
    Location
    USA
    Posts
    524
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Hi, and welcome to the board!

    Here is a pure ASP (i.e. no components) resource for letting the user upload one or more files which is something that was unfortunately not built into ASP:

    ASP File Upload Using VBScript by John R. Lewis - 7/10/2000
    http://aspzone.com/articles/160.aspx
    J. Paul Schmidt
    www.Bullschmidt.com - Freelance Web and Database Developer
    www.Bullschmidt.com/DevTip.asp - Classic ASP Design Tips

  3. #3
    SitePoint Member
    Join Date
    Aug 2005
    Location
    Port Harcourt, Nigeria
    Posts
    10
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    I got this code from one site like that.I think it can help. Just do some simple modifications by looking more carefully and using more of your brains.






    <%@ Language=VBScript %>
    <%
    option explicit
    Response.Expires = -1
    Server.ScriptTimeout = 600
    %>
    <!-- #include file="aspupload.asp" -->
    <%


    ' ****************************************************
    ' Change the value of the variable below to the pathname
    ' of a directory with write permissions, for example "C:\Inetpub\wwwroot"
    Dim uploadsDirVar
    uploadsDirVar = "c:\inetpub\wwwroot\upload\"
    ' ****************************************************

    ' 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()
    %>
    <form name="frmSend" method="POST" enctype="multipart/form-data" action="uploadTester.asp" onSubmit="return onSubmitForm();">
    <B>File names/B><br>
    File 1: <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"><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.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 & "<br>Enter a number = " & Upload.Form("enter_a_number") & "<br>"
    SaveFiles = SaveFiles & "Checkbox values = " & Upload.Form("checkbox_values") & "<br>"
    end function
    %>

    <HTML>
    <HEAD>
    <TITLE>Test Free ASP Upload</TITLE>
    <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">Upload files to your server</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:150"">"
    OutputForm()
    response.write "</div>"
    end if
    else
    response.write "<div style=""margin-left:150"">"
    OutputForm()
    response.write SaveFiles()
    response.write "<br><br></div>"
    end if

    %>

    <!-- Please support this free script by having a link to freeaspupload.net either in this page or somewhere else in your site. -->
    <div style="border-bottom: #A91905 2px solid;font-size:10">Powered by <A HREF="http://www.freeaspupload.net/" style="color:black">Free ASP Upload</A></div>

    <br><br>



    </BODY>
    </HTML>




    And then save this file as "aspupload.asp" or just anything that will suite you. But make sure to change the include file path also in the previous section




    <%

    Class FreeASPUpload
    Public UploadedFiles
    Public FormElements

    Private VarArrayBinRequest
    Private StreamRequest
    Private uploadedYet

    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
    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

    '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=fileItem.Start
    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 Itemsbr>"
    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 Filesbr>"
    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. <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
    %>


Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •