Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Results 1 to 7 of 7
  1. #1
    New Coder
    Join Date
    Mar 2011
    Posts
    41
    Thanks
    16
    Thanked 0 Times in 0 Posts

    Insert data to DB, Upload file to server at the same timw

    I encounter a problem, I have a form for sending message with usual things like send to, title and body text but this message form need to have an attachment ability (just like those in regular mail services) which means user browse and select a file and write his subject and body text and when he/she submits the send bottom, subject, body text and etc submit to a DB and its attachments save in the server with its file name in DB (both have to happen add the same time in one form with one submit button) Btw there is something about changing files names to prevent file replacement (maybe by automatically adding something to a file name if there was a file with similar name) and I really need to restrict file types (like user would allow to upload zip doc and pdf files).
    Attached Thumbnails Attached Thumbnails Insert data to DB, Upload file to server at the same timw-attach.png  
    Last edited by Datis; 01-16-2012 at 02:24 PM.

  • #2
    New Coder
    Join Date
    Mar 2011
    Posts
    41
    Thanks
    16
    Thanked 0 Times in 0 Posts
    Any Suggestion?

  • #3
    Supreme Master coder! Old Pedant's Avatar
    Join Date
    Feb 2009
    Posts
    27,650
    Thanks
    80
    Thanked 4,638 Times in 4,600 Posts
    Well, just for starters, you need an upload component. And then you have to change all of your code that is using Request("name") to instead use the methods provided by the upload component.

    Since you show no code, I don't know how much of this you are doing now.
    An optimist sees the glass as half full.
    A pessimist sees the glass as half empty.
    A realist drinks it no matter how much there is.

  • #4
    New Coder
    Join Date
    Mar 2011
    Posts
    41
    Thanks
    16
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by Old Pedant View Post
    Well, just for starters, you need an upload component. And then you have to change all of your code that is using Request("name") to instead use the methods provided by the upload component.

    Since you show no code, I don't know how much of this you are doing now.

    You see Free ASP Upload already done it but the only problem it has is saving form values to sql server I mean please setup this files on your machine and test it after choose a file to upload and enter some values to a text box check box ad etc and you see after that it shows the value in the bottom of the page but I need to insert them in db:


    here is my page:

    Code:
    <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
    <!--#include virtual="/Board%20Of%20Trustees/Connections/admin_trustees.asp" -->
    <%
    Dim MM_editAction
    MM_editAction = CStr(Request.ServerVariables("SCRIPT_NAME"))
    If (Request.QueryString <> "") Then
      MM_editAction = MM_editAction & "?" & Server.HTMLEncode(Request.QueryString)
    End If
    
    ' boolean to abort record edit
    Dim MM_abortEdit
    MM_abortEdit = false
    %>
    <%
    If (CStr(Request("MM_insert")) = "form1") Then
      If (Not MM_abortEdit) Then
        ' execute the insert
        Dim MM_editCmd
    
        Set MM_editCmd = Server.CreateObject ("ADODB.Command")
        MM_editCmd.ActiveConnection = MM_admin_trustees_STRING
        MM_editCmd.CommandText = "INSERT INTO dbo.SingleLetter (Title, Upload, Body) VALUES (?, ?, ?)" 
        MM_editCmd.Prepared = true
        MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param1", 202, 1, 100, Request.Form("Title")) ' adVarWChar
        MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param2", 202, 1, 300, Request.Form("Upload")) ' adVarWChar
        MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param3", 203, 1, 1073741823, Request.Form("Body")) ' adLongVarWChar
        MM_editCmd.Execute
        MM_editCmd.ActiveConnection.Close
    
        ' append the query string to the redirect URL
        Dim MM_editRedirectUrl
        MM_editRedirectUrl = "sent.asp"
        If (Request.QueryString <> "") Then
          If (InStr(1, MM_editRedirectUrl, "?", vbTextCompare) = 0) Then
            MM_editRedirectUrl = MM_editRedirectUrl & "?" & Request.QueryString
          Else
            MM_editRedirectUrl = MM_editRedirectUrl & "&" & Request.QueryString
          End If
        End If
        Response.Redirect(MM_editRedirectUrl)
      End If
    End If
    %>
    <!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>Untitled Document</title>
    </head>
    
    <body>
    <form action="<%=MM_editAction%>" method="post" name="form1" id="form1">
      <table align="center">
        <tr valign="baseline">
          <td nowrap="nowrap" align="right">Title:</td>
          <td><input type="text" name="Title" value="" size="32" /></td>
        </tr>
        <tr valign="baseline">
          <td nowrap="nowrap" align="right">Upload:</td>
          <td><input type="text" name="Upload" value="" size="32" /></td>
        </tr>
        <tr valign="baseline">
          <td nowrap="nowrap" align="right">Body:</td>
          <td><input type="text" name="Body" value="" size="32" /></td>
        </tr>
        <tr valign="baseline">
          <td nowrap="nowrap" align="right">&nbsp;</td>
          <td><input type="submit" value="Insert record" /></td>
        </tr>
      </table>
      <input type="hidden" name="MM_insert" value="form1" />
    </form>
    </body>
    </html>

  • #5
    New Coder
    Join Date
    Mar 2011
    Posts
    41
    Thanks
    16
    Thanked 0 Times in 0 Posts
    Here is uploader component:

    (Part1)

    UploadTester.asp
    Code:
    <%@ Language=VBScript %>
    <% 
    option explicit 
    Response.Expires = -1
    Server.ScriptTimeout = 600
    ' All communication must be in UTF-8, including the response back from the request
    Session.CodePage  = 65001
    %>
    <!-- #include file="freeaspupload.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 = Server.MapPath("/uploader/uploads")
      
    
      ' 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" accept-charset="utf-8" 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 &nbsp;&nbsp;<input type="checkbox" value="2" name="checkbox_values"> 2<br>
        Drop-down list (with multiple selection): <br>	   
        <select name="list_values" class="TextBox" MULTIPLE>
            <option value='frist' > First</option>
            <option value='second' > Second</option>
            <option value='third' > Third</option>
        </select><br>
        <textarea rows="2" cols="20" name="t_area">Test text area</textarea><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 = "No file selected for upload or 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>"
    	SaveFiles = SaveFiles & "List values = " & Upload.Form("list_values") & "<br>"
    	SaveFiles = SaveFiles & "Text area = " & Upload.Form("t_area") & "<br>"
    end function
    %>
    
    <HTML>
    <HEAD>
    <TITLE>Test Free ASP Upload 2.0</TITLE>
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
    <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>
    
    <!--- START OF HTML TO REMOVE - contains the script ratings submission -->
    
    <table cellspacing=10>
    <tr><td>
    <table width="140" border="1" cellpadding="0" cellspacing="0" bordercolor="#840300" bgcolor="#D70500">
      <form action="http://www.hotscripts.com/cgi-bin/rate.cgi" method="POST">
        <tr> 
          <td><table width="100%" border="0" cellspacing="0" cellpadding="2" style="font-size:8pt">
              <tr align="center" bgcolor="#AA0400"> 
                <td colspan="2"><b><font color="#FFFFFF">Rate Our Program<br>at Hotscripts.com
                  <input type="hidden" name="ID" value="21966">
                  <input type="hidden" name="external2" value="1">
                  </font></b></td>
              </tr>
              <tr> 
                <td align="right"><input type="radio" value="5" name="rate"></td>
                <td><font color="#FFFFFF">Excellent!</font></td>
              </tr>
              <tr> 
                <td align="right"><input type="radio" value="4" name="rate"></td>
                <td><font color="#FFFFFF">Very Good</font></td>
              </tr>
              <tr> 
                <td align="right"><input type="radio" value="3" name="rate"></td>
                <td><font color="#FFFFFF">Good</font></td>
              </tr>
              <tr> 
                <td align="right"><input type="radio" value="2" name="rate"></td>
                <td><font color="#FFFFFF">Fair</font></td>
              </tr>
              <tr> 
                <td align="right"><input type="radio" value="1" name="rate"></td>
                <td><font color="#FFFFFF">Poor</font></td>
              </tr>
              <tr align="center"> 
                <td colspan="2"><input name="submit2" type="submit" value="Cast My Vote!"></td>
              </tr>
            </table></td>
        </tr>
      </form>
    </table>
    
    <td valign=top>
    
    <table border=0 cellpadding=1 cellspacing=0 bgcolor=000000>
    <tr><td align=center>
    	<table border=0 cellpadding=3 cellspacing=0 bgcolor=eeeedd>
    	<tr><td align=center nowrap>
    		<font style="font-size:10pt;font-family:Arial;"><b>Rated:</b> <a href="http://www.Aspin.com/func/review?id=5380510"><img src=http://ratings.Aspin.com/getstars?id=5380510 border=0></a>
    		<font style="font-size:8pt;"><br>by <a href="http://www.Aspin.com">Aspin.com</a> users<br></font></font>
    	</td></tr><tr nowrap><form action="http://www.Aspin.com/func/review/write?id=5380510" method=post><td align=center>
    		<font style="font-size:10pt;font-family:Arial;">What do you think?</font><br>
    		<select name="VoteStars"><option>5 Stars<option>4 Stars<option>3 Stars<option>2 Stars<option>1 Star</select><input type=submit value="Vote">
    	</td></form></tr></table>
    </td></tr></table>
    
    <td valign=top style="font-size:10pt" width=300>
    
    Please support this free script by rating it with the boxes on the left.<p>
    To remove these boxes from this page please follow the instructions in the source HTML. The code to remove is clearly indicated and very easy to find.<p>
    Thank you.
    </table>
    <!-- end of html to remove ------------------------->
    
    </BODY>
    </HTML>

  • #6
    New Coder
    Join Date
    Mar 2011
    Posts
    41
    Thanks
    16
    Thanked 0 Times in 0 Posts
    (part2)


    freeaspupload.asp

    Code:
    <%
    '  For examples, documentation, and your own free copy, go to:
    '  http://www.freeaspupload.net
    '  Note: You can copy and use this script for free and you can make changes
    '  to the code, but you cannot remove the above comment.
    
    'Changes:
    'Aug 2, 2005: Add support for checkboxes and other input elements with multiple values
    'Jan 6, 2009: Lars added ASP_CHUNK_SIZE
    'Sep 3, 2010: Enforce UTF-8 everywhere; new function to convert byte array to unicode string
    
    const DEFAULT_ASP_CHUNK_SIZE = 200000
    
    const adModeReadWrite = 3
    const adTypeBinary = 1
    const adTypeText = 2
    const adSaveCreateOverWrite = 2
    
    Class FreeASPUpload
    	Public UploadedFiles
    	Public FormElements
    
    	Private VarArrayBinRequest
    	Private StreamRequest
    	Private uploadedYet
    	Private internalChunkSize
    
    	Private Sub Class_Initialize()
    		Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")
    		Set FormElements = Server.CreateObject("Scripting.Dictionary")
    		Set StreamRequest = Server.CreateObject("ADODB.Stream")
    		StreamRequest.Type = adTypeText
    		StreamRequest.Open
    		uploadedYet = false
    		internalChunkSize = DEFAULT_ASP_CHUNK_SIZE
    	End Sub
    	
    	Private Sub Class_Terminate()
    		If IsObject(UploadedFiles) Then
    			UploadedFiles.RemoveAll()
    			Set UploadedFiles = Nothing
    		End If
    		If IsObject(FormElements) Then
    			FormElements.RemoveAll()
    			Set FormElements = Nothing
    		End If
    		StreamRequest.Close
    		Set StreamRequest = Nothing
    	End Sub
    
    	Public Property Get Form(sIndex)
    		Form = ""
    		If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))
    	End Property
    
    	Public Property Get Files()
    		Files = UploadedFiles.Items
    	End Property
    	
        Public Property Get Exists(sIndex)
                Exists = false
                If FormElements.Exists(LCase(sIndex)) Then Exists = true
        End Property
            
        Public Property Get FileExists(sIndex)
            FileExists = false
                if UploadedFiles.Exists(LCase(sIndex)) then FileExists = true
        End Property
            
        Public Property Get chunkSize()
    		chunkSize = internalChunkSize
    	End Property
    
    	Public Property Let chunkSize(sz)
    		internalChunkSize = sz
    	End Property
    
    	'Calls Upload to extract the data from the binary request and then saves the uploaded files
    	Public Sub Save(path)
    		Dim streamFile, fileItem, filePath
    
    		if Right(path, 1) <> "\" then path = path & "\"
    
    		if not uploadedYet then Upload
    
    		For Each fileItem In UploadedFiles.Items
    			filePath = path & fileItem.FileName
    			Set streamFile = Server.CreateObject("ADODB.Stream")
    			streamFile.Type = adTypeBinary
    			streamFile.Open
    			StreamRequest.Position=fileItem.Start
    			StreamRequest.CopyTo streamFile, fileItem.Length
    			streamFile.SaveToFile filePath, adSaveCreateOverWrite
    			streamFile.close
    			Set streamFile = Nothing
    			fileItem.Path = filePath
    		 Next
    	End Sub
    	
    	public sub SaveOne(path, num, byref outFileName, byref outLocalFileName)
    		Dim streamFile, fileItems, fileItem, fs
    
            set fs = Server.CreateObject("Scripting.FileSystemObject")
    		if Right(path, 1) <> "\" then path = path & "\"
    
    		if not uploadedYet then Upload
    		if UploadedFiles.Count > 0 then
    			fileItems = UploadedFiles.Items
    			set fileItem = fileItems(num)
    		
    			outFileName = fileItem.FileName
    			outLocalFileName = GetFileName(path, outFileName)
    		
    			Set streamFile = Server.CreateObject("ADODB.Stream")
    			streamFile.Type = adTypeBinary
    			streamFile.Open
    			StreamRequest.Position = fileItem.Start
    			StreamRequest.CopyTo streamFile, fileItem.Length
    			streamFile.SaveToFile path & outLocalFileName, adSaveCreateOverWrite
    			streamFile.close
    			Set streamFile = Nothing
    			fileItem.Path = path & filename
    		end if
    	end sub
    
    	Public Function SaveBinRequest(path) ' For debugging purposes
    		StreamRequest.SaveToFile path & "\debugStream.bin", 2
    	End Function
    
    	Public Sub DumpData() 'only works if files are plain text
    		Dim i, aKeys, f
    		response.write "Form Items:<br>"
    		aKeys = FormElements.Keys
    		For i = 0 To FormElements.Count -1 ' Iterate the array
    			response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"
    		Next
    		response.write "Uploaded Files:<br>"
    		For Each f In UploadedFiles.Items
    			response.write "Name: " & f.FileName & "<br>"
    			response.write "Type: " & f.ContentType & "<br>"
    			response.write "Start: " & f.Start & "<br>"
    			response.write "Size: " & f.Length & "<br>"
    		 Next
       	End Sub
    
    	Public Sub Upload()
    		Dim nCurPos, nDataBoundPos, nLastSepPos
    		Dim nPosFile, nPosBound
    		Dim sFieldName, osPathSep, auxStr
    		Dim readBytes, readLoop, tmpBinRequest
    		
    		'RFC1867 Tokens
    		Dim vDataSep
    		Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
    		tNewLine = String2Byte(Chr(13))
    		tDoubleQuotes = String2Byte(Chr(34))
    		tTerm = String2Byte("--")
    		tFilename = String2Byte("filename=""")
    		tName = String2Byte("name=""")
    		tContentDisp = String2Byte("Content-Disposition")
    		tContentType = String2Byte("Content-Type:")
    
    		uploadedYet = true
    
    		on error resume next
    			' Copy binary request to a byte array, on which functions like InstrB and others can be used to search for separation tokens
    			readBytes = internalChunkSize
    			VarArrayBinRequest = Request.BinaryRead(readBytes)
    			VarArrayBinRequest = midb(VarArrayBinRequest, 1, lenb(VarArrayBinRequest))
    			Do Until readBytes < 1
    				tmpBinRequest = Request.BinaryRead(readBytes)
    				if readBytes > 0 then
    					VarArrayBinRequest = VarArrayBinRequest & midb(tmpBinRequest, 1, lenb(tmpBinRequest))
    				end if
    			Loop
    			StreamRequest.WriteText(VarArrayBinRequest)
    			StreamRequest.Flush()
    			if Err.Number <> 0 then 
    				response.write "<br><br><B>System reported this error:</B><p>"
    				response.write Err.Description & "<p>"
    				response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
    				Exit Sub
    			end if
    		on error goto 0 'reset error handling
    
    		nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)
    
    		If nCurPos <= 1  Then Exit Sub
    		 
    		'vDataSep is a separator like -----------------------------21763138716045
    		vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)
    
    		'Start of current separator
    		nDataBoundPos = 1
    
    		'Beginning of last line
    		nLastSepPos = FindToken(vDataSep & tTerm, 1)
    
    		Do Until nDataBoundPos = nLastSepPos
    			
    			nCurPos = SkipToken(tContentDisp, nDataBoundPos)
    			nCurPos = SkipToken(tName, nCurPos)
    			sFieldName = ExtractField(tDoubleQuotes, nCurPos)
    
    			nPosFile = FindToken(tFilename, nCurPos)
    			nPosBound = FindToken(vDataSep, nCurPos)
    			
    			If nPosFile <> 0 And  nPosFile < nPosBound Then
    				Dim oUploadFile
    				Set oUploadFile = New UploadedFile
    				
    				nCurPos = SkipToken(tFilename, nCurPos)
    				auxStr = ExtractField(tDoubleQuotes, nCurPos)
                    ' We are interested only in the name of the file, not the whole path
                    ' Path separator is \ in windows, / in UNIX
                    ' While IE seems to put the whole pathname in the stream, Mozilla seem to 
                    ' only put the actual file name, so UNIX paths may be rare. But not impossible.
                    osPathSep = "\"
                    if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
    				oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))
    
    				if (Len(oUploadFile.FileName) > 0) then 'File field not left empty
    					nCurPos = SkipToken(tContentType, nCurPos)
    					
                        auxStr = ExtractField(tNewLine, nCurPos)
                        ' NN on UNIX puts things like this in the stream:
                        '    ?? python py type=?? python application/x-python
    					oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
    					nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
    					
    					oUploadFile.Start = nCurPos+1
    					oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos
    					
    					If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile
    				End If
    			Else
    				Dim nEndOfData, fieldValueUniStr
    				nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
    				nEndOfData = FindToken(vDataSep, nCurPos) - 2
    				fieldValueuniStr = ConvertUtf8BytesToString(nCurPos, nEndOfData-nCurPos)
    				If Not FormElements.Exists(LCase(sFieldName)) Then 
    					FormElements.Add LCase(sFieldName), fieldValueuniStr
    				else
                        FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & fieldValueuniStr
                    end if 
    
    			End If
    
    			'Advance to next separator
    			nDataBoundPos = FindToken(vDataSep, nCurPos)
    		Loop
    	End Sub
    
    	Private Function SkipToken(sToken, nStart)
    		SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
    		If SkipToken = 0 then
    			Response.write "Error in parsing uploaded binary request. The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
    			Response.End
    		end if
    		SkipToken = SkipToken + LenB(sToken)
    	End Function
    
    	Private Function FindToken(sToken, nStart)
    		FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
    	End Function
    
    	Private Function ExtractField(sToken, nStart)
    		Dim nEnd
    		nEnd = InstrB(nStart, VarArrayBinRequest, sToken)
    		If nEnd = 0 then
    			Response.write "Error in parsing uploaded binary request."
    			Response.End
    		end if
    		ExtractField = ConvertUtf8BytesToString(nStart, nEnd-nStart)
    	End Function
    
    	'String to byte string conversion
    	Private Function String2Byte(sString)
    		Dim i
    		For i = 1 to Len(sString)
    		   String2Byte = String2Byte & ChrB(AscB(Mid(sString,i,1)))
    		Next
    	End Function
    
    	Private Function ConvertUtf8BytesToString(start, length)	
    		StreamRequest.Position = 0
    	
    	    Dim objStream
    	    Dim strTmp
    	    
    	    ' init stream
    	    Set objStream = Server.CreateObject("ADODB.Stream")
    	    objStream.Charset = "utf-8"
    	    objStream.Mode = adModeReadWrite
    	    objStream.Type = adTypeBinary
    	    objStream.Open
    	    
    	    ' write bytes into stream
    	    StreamRequest.Position = start+1
    	    StreamRequest.CopyTo objStream, length
    	    objStream.Flush
    	    
    	    ' rewind stream and read text
    	    objStream.Position = 0
    	    objStream.Type = adTypeText
    	    strTmp = objStream.ReadText
    	    
    	    ' close up and return
    	    objStream.Close
    	    Set objStream = Nothing
    	    ConvertUtf8BytesToString = strTmp	
    	End Function
    End Class
    
    Class UploadedFile
    	Public ContentType
    	Public Start
    	Public Length
    	Public Path
    	Private nameOfFile
    
        ' Need to remove characters that are valid in UNIX, but not in Windows
        Public Property Let FileName(fN)
            nameOfFile = fN
            nameOfFile = SubstNoReg(nameOfFile, "\", "_")
            nameOfFile = SubstNoReg(nameOfFile, "/", "_")
            nameOfFile = SubstNoReg(nameOfFile, ":", "_")
            nameOfFile = SubstNoReg(nameOfFile, "*", "_")
            nameOfFile = SubstNoReg(nameOfFile, "?", "_")
            nameOfFile = SubstNoReg(nameOfFile, """", "_")
            nameOfFile = SubstNoReg(nameOfFile, "<", "_")
            nameOfFile = SubstNoReg(nameOfFile, ">", "_")
            nameOfFile = SubstNoReg(nameOfFile, "|", "_")
        End Property
    
        Public Property Get FileName()
            FileName = nameOfFile
        End Property
    
        'Public Property Get FileN()ame
    End Class
    
    
    ' Does not depend on RegEx, which is not available on older VBScript
    ' Is not recursive, which means it will not run out of stack space
    Function SubstNoReg(initialStr, oldStr, newStr)
        Dim currentPos, oldStrPos, skip
        If IsNull(initialStr) Or Len(initialStr) = 0 Then
            SubstNoReg = ""
        ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
            SubstNoReg = initialStr
        Else
            If IsNull(newStr) Then newStr = ""
            currentPos = 1
            oldStrPos = 0
            SubstNoReg = ""
            skip = Len(oldStr)
            Do While currentPos <= Len(initialStr)
                oldStrPos = InStr(currentPos, initialStr, oldStr)
                If oldStrPos = 0 Then
                    SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
                    currentPos = Len(initialStr) + 1
                Else
                    SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
                    currentPos = oldStrPos + skip
                End If
            Loop
        End If
    End Function
    
    Function GetFileName(strSaveToPath, FileName)
    'This function is used when saving a file to check there is not already a file with the same name so that you don't overwrite it.
    'It adds numbers to the filename e.g. file.gif becomes file1.gif becomes file2.gif and so on.
    'It keeps going until it returns a filename that does not exist.
    'You could just create a filename from the ID field but that means writing the record - and it still might exist!
    'N.B. Requires strSaveToPath variable to be available - and containing the path to save to
        Dim Counter
        Dim Flag
        Dim strTempFileName
        Dim FileExt
        Dim NewFullPath
        dim objFSO, p
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Counter = 0
        p = instrrev(FileName, ".")
        FileExt = mid(FileName, p+1)
        strTempFileName = left(FileName, p-1)
        NewFullPath = strSaveToPath & "\" & FileName
        Flag = False
        
        Do Until Flag = True
            If objFSO.FileExists(NewFullPath) = False Then
                Flag = True
                GetFileName = Mid(NewFullPath, InstrRev(NewFullPath, "\") + 1)
            Else
                Counter = Counter + 1
                NewFullPath = strSaveToPath & "\" & strTempFileName & Counter & "." & FileExt
            End If
        Loop
    End Function 
     
    %>

  • #7
    Supreme Master coder! Old Pedant's Avatar
    Join Date
    Feb 2009
    Posts
    27,650
    Thanks
    80
    Thanked 4,638 Times in 4,600 Posts
    One more time:
    Code:
        MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param1", 202, 1, 100, Request.Form("Title")) ' adVarWChar
        MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param2", 202, 1, 300, Request.Form("Upload")) ' adVarWChar
        MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param3", 203, 1, 1073741823, Request.Form("Body")) ' adLongVarWChar
    You can *NOT* use Request.Form with *ANY* file uploader. ASP Free Upload or ANY other uploader.

    You *MUST* use the uploader's REPLACEMENT for Request.Form.

    *READ* the example!!!

    Code:
    Set Upload = New FreeASPUpload
    ...
    SaveFiles = SaveFiles & "<br>Enter a number = " & Upload.Form("enter_a_number") & "<br>"
    SaveFiles = SaveFiles & "Checkbox values = " & Upload.Form("checkbox_values") & "<br>"
    SaveFiles = SaveFiles & "List values = " & Upload.Form("list_values") & "<br>"
    An optimist sees the glass as half full.
    A pessimist sees the glass as half empty.
    A realist drinks it no matter how much there is.


  •  

    Posting Permissions

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