仅上载允许的文件类型

时间:2013-08-19 10:24:40

标签: file-upload asp-classic upload filesystems

我正在使用FreeASPUpload组件上传用户可以上传的表单。

现在我可以上传任何内容,这会在服务器上造成严重的安全问题。我如何只限制特定的文件类型。我只希望用户上传“.doc”,“。dococ”和“.pdf”文件。

以下是源代码。

<%@ Language=VBScript %>
<% 
option explicit 
Response.Expires = -1
Server.ScriptTimeout = 600
Session.CodePage  = 65001
%>

<!-- #include file="UploadClass.asp" -->
<!-- #include file="ADOVBS.inc" -->

<%
Dim uploadsDirVar
uploadsDirVar = server.MapPath("Resumes_Uploaded") 

function OutputForm()
%>
<form name="frmSend" id="appform" method="POST" enctype="multipart/form-data" accept-charset="utf-8" action="form.asp" onSubmit="return onSubmitForm();">
<input type="hidden" name="ApplicationForm" value="Insert" />
Name: <input type="text" name="name_insert" value="" size="30" />
<B>File names:</B><br>
File 1: <input name="attach1" type="file" size=35><br>
<br>
<input style="margin-top:4" type="submit" value="Submit">
</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, strFileName, strFileType, oFSO, DelFile, fso

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

<%
'=======================================================================================
' CONNECT DATABASE
'=======================================================================================
Dim objConn, objRs, InsCom, InsName
Set objConn = CreateObject("ADODB.Connection")
Set objRs = CreateObject("ADODB.Recordset")
objConn.open"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& server.MapPath("db/Job_database.mdb") &";Mode=ReadWrite|Share Deny None;Persist Security Info=False"

If Upload.Form("ApplicationForm") = "Insert" Then
Set InsCom=Server.CreateObject("ADODB.Command")
InsCom.ActiveConnection=objConn

InsName = Trim(Upload.Form("name_insert"))
InsName = replace(InsName,"'","''")

InsCom.CommandText = "Insert into applications(aname)Values(?)"
InsCom.Parameters.Append InsCom.CreateParameter("@name_insert", adVarChar, adParamInput, 255, InsName)

InsCom.Execute

End If  

Response.Redirect("success.asp")    
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 == "")
        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

%>

</BODY>
</HTML>

我搜索了很多,但发现只有一些解决方案,但它们并不适合我。 这是我所做的最新更改,但文件上传后文件不会从服务器中删除。

以下是代码

function SaveFiles
    Dim Upload, fileName, fileSize, ks, i, fileKey, strFileType, oFSO

    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
            strFileType = Left(Upload.UploadedFiles(fileKey).ContentType,5)
            if strFileType = ".doc" and ".docx" and ".pdf" Then
                SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
            else
                DelFile = DelFiles & Upload.UploadedFiles(fileKey).FileName & ","
            end if          
        next

        %>
<%

    else
        SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
    end if
    if DelFile <> "" Then
         DelFile = left(DelFile,len(DelFile)-1)
         set oFSO = CreateObject("Scripting.FileSystemObject")
         if inStr(DelFile,",") > 0  then
              arrDelete = split(DelFile,",")
              for i = 0 to UBound(arrDelete)
                   oFSO.DeleteFile uploadsDirVar & arrDelete(i)
              next
         else
             oFSO.DeleteFile uploadsDirVar & DelFile
         end if
         oFSO.close
         set oFSO = nothing
    end if

FreeASPUpload documentation无济于事。

1 个答案:

答案 0 :(得分:2)

我测试了这段代码,它按预期工作......

function SaveFiles
    ' You forgot to declare the DelFile Variable
    Dim Upload, fileName, fileSize, ks, i, fileKey, strFileType, oFSO, DelFile

    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

    ' Set DelFile Variable to empty string
    DelFile = ""
    SaveFiles = ""
    ks = Upload.UploadedFiles.keys
    if (UBound(ks) <> -1) then
        SaveFiles = "<B>Files uploaded:</B> "
        for each fileKey in Upload.UploadedFiles.keys
            ' This does not return the file extension of the file uploaded
            ' strFileType = Left(Upload.UploadedFiles(fileKey).ContentType,5)
            strFileType = Mid(Upload.UploadedFiles(fileKey).FileName, InstrRev(Upload.UploadedFiles(fileKey).FileName, ".") + 1)
            ' This is an invalid if statement
            ' if strFileType = ".doc" and ".docx" and ".pdf" Then
            if strFileType = "doc" or strFileType = "docx" or strFileType = "pdf" Then
                SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
            else
                ' The var DelFiles does not exist
                'DelFile = DelFiles & Upload.UploadedFiles(fileKey).FileName & ","
                DelFile = DelFile & Upload.UploadedFiles(fileKey).FileName & ","
            end if
        next
    else
        SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
if DelFile <> "" Then
     DelFile = left(DelFile,len(DelFile)-1)
     set oFSO = CreateObject("Scripting.FileSystemObject")
     if inStr(DelFile,",") > 0  then
          arrDelete = split(DelFile,",")
          for i = 0 to UBound(arrDelete)
               ' this is wrong, you're missing a backspace
               ' oFSO.DeleteFile uploadsDirVar & arrDelete(i)
               oFSO.DeleteFile uploadsDirVar & "\" & arrDelete(i)
          next
     else
         ' this is wrong, you're missing a backspace
         ' oFSO.DeleteFile uploadsDirVar & DelFile
         oFSO.DeleteFile(uploadsDirVar & "\" & DelFile)
     end if
         ' This is an invalid statement
         ' oFSO.close
         set oFSO = nothing
    end if
end function

注意:您的代码充满了错误......我尽力解释它们的位置和内容,但这并不能代替学习如何正确调试asp代码。在尝试将我的代码集成到解决方案中之前,您应该尝试掌握如何调试asp。