<%@ Language=VBScript %>
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
%>
<%
' ****************************************************
' Change the value of the variable below to the pathname
' of a directory with write permissions, for example "C:\Inetpub\wwwroot"
' ****************************************************
' 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/
Dim avatars
avatars=false
function OutputForm()
%>
<%
end function
function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(Server.MapPath(IMAGES_DIRECTORY)) then
TestEnvironment = "Folder " & Server.MapPath(IMAGES_DIRECTORY) & " does not exist. The value of your IMAGES_DIRECTORY is incorrect. Open asp_config.asp in an editor and change the value of IMAGES_DIRECTORY to the pathname of a directory with write permissions."
exit function
end if
fileName = Server.MapPath(IMAGES_DIRECTORY) & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileName, true)
If Err.Number<>0 then
TestEnvironment = "Folder " & Server.MapPath(IMAGES_DIRECTORY) & " does not have write permissions. The value of your IMAGES_DIRECTORY is incorrect. Open asp_config.asp in an editor and change the value of IMAGES_DIRECTORY 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 = "Folder " & Server.MapPath(IMAGES_DIRECTORY) & " does not have delete permissions, although it does have write permissions. Change the permissions for IUSR_computername on this folder."
exit function
end if
Err.Clear
Set streamTest = Server.CreateObject("ADODB.Stream")
If Err.Number<>0 then
TestEnvironment = "The ADODB object Stream is not available in your server. 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(Server.MapPath(IMAGES_DIRECTORY))
' 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
if errorstring = "" then
for each fileKey in Upload.UploadedFiles.keys
SaveFiles = " " & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "KB) Uploaded Successfully!
Step 2: In order to use this image in your chat messages, simply copy and paste the following...
"
next
else
SaveFiles = errorstring
end if
else
SaveFiles = " The file name specified in the upload form does not correspond to a valid file in the system."
errorstring="-1"
end if
end function
%>
Free ASP Upload
Share Images
<%
Dim diagnostics
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write "
"
response.write diagnostics
response.write "
After you correct this problem, reload the page."
response.write "
"
else
response.write "
"
OutputForm()
response.write "
"
end if
else
response.write "
"
response.write SaveFiles()
if errorstring<>"" Then
OutputForm()
end if
response.write "