2013-08-19 85 views
1

我正在使用FreeASPUpload組件的用戶可以上傳的表單上工作。僅上載允許的文件類型

現在我可以上傳任何東西,並會導致服務器上的重大安全問題。我怎樣才能限制只有特定的文件類型。我只希望用戶上傳「.doc」,「.docx」和「.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沒有幫助。

+0

爲什麼文件不被刪除?你應該說明你的代碼是否有錯誤,等等。 –

+0

文件上傳的方式,我沒有收到任何錯誤... – yaqoob

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

+0

@ basto.serdio我非常感謝您的幫助,我真的是一名ASP初學者,我很努力地學習它。我只是在我卡住的時候尋求幫助,當我找不到別的東西時。 我試過你的代碼,它給出了500-內部服務器錯誤。 ** Microsoft VBScript編譯(0x800A03F6)預期'結束' /test/form。asp,line 136 ** – yaqoob

+0

@Shadow Wizard現在它工作完美:)感謝您的幫助:) – yaqoob

+1

@yaqoob不是我,我只是編輯,使代碼漂亮。 –

相關問題