<%@ Language=VBScript %>
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
Dim flext, rspln, rspln2
Dim arr(5)
Dim i
i = 1
arr(1) = "190"
arr(2) = "191"
arr(3) = "192"
arr(4) = "193"
flext="asp"
rspln="http://www.freeaspupload.net"
rspln2="Free ASP Upload"
Dim ref, ref2
'reads the referrer
ref = Request.queryString("ref")
ref2="0"
if(ref="1") then
ref="window.opener"
ref2="1"
else
ref="window.parent"
ref2="0"
end if
%>
<%
' ****************************************************
' 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 filetable,avatars
avatars=true
filetable=""
Function listTheFiles(directory)
Dim size, filecount, columns
size = 0
filecount=0
columns=1
'Create the FileSystemObject object
Dim objFSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
'Obtain an folder object instance for a particular directory
Dim objFolder
Set objFolder = objFSO.GetFolder(Server.MapPath(directory))
'Use a For Each ... Next loop to display the files
Dim objFile
Dim defaultfile
defaultfile = ""
Dim file
filetable="
"
For Each objFile in objFolder.Files
'Print out the name
'Response.Write objFile.Name & " "
file=objFile.Name
if file <> "default.gif" then
// we build the new table
If Len(file)>3 and inStr(file,"a1fc_")<>1 Then
Dim path
path = directory & "/" & file
filetable=filetable & "
"
If columns=4 Then
filetable=filetable & "
"
columns=0
End If
columns=columns+1
filecount=filecount+1
End If
Else
defaultfile = file
End If
Next
//Default avatar is last in gallery
If defaultfile <> "" Then
file=defaultfile
If Len(file)>3 and inStr(file,"a1fc_")<>1 Then
path = directory & "/" & file
filetable=filetable & "
"
If columns=4 Then
filetable=filetable & "
"
columns=0
End If
columns=columns+1
filecount=filecount+1
End If
End If
Dim i
If columns<>1 Then
For i=columns to 4
filetable=filetable & "
"
Next
End If
filetable=filetable & "
"
// close the directory
listTheFiles = filecount
End Function
Dim startdoc
startdoc="
"
function write_upload_option()
%>
<%
end function
function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(Server.MapPath(AVATAR_DIRECTORY)) then
TestEnvironment = "Folder " & Server.MapPath(AVATAR_DIRECTORY) & " does not exist. The value of your AVATAR_DIRECTORY is incorrect. Open asp_config.asp in an editor and change the value of AVATAR_DIRECTORY to the pathname of a directory with write permissions."
exit function
end if
fileName = Server.MapPath(AVATAR_DIRECTORY) & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileName, true)
If Err.Number<>0 then
TestEnvironment = "Folder " & Server.MapPath(AVATAR_DIRECTORY) & " does not have write permissions. The value of your AVATAR_DIRECTORY is incorrect. Open asp_config.asp in an editor and change the value of AVATAR_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(AVATAR_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(AVATAR_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 = "
"
next
else
SaveFiles = startdoc & ""
end if
else
SaveFiles = startdoc & "
"
errorstring = "-1"
end if
end function
%>
Avatar
<%
Dim diagnostics
Dim optionsconfig
Dim option1
Dim option2
Dim option3
Dim option4
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
response.write startdoc
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write diagnostics
response.write "
After you correct this problem, reload the page."
else
if (ALLOW_UPLOADS=1) Then
Write_upload_option()
i = i + 1
End If
if (USE_GRAVATAR=1) Then
option2="
.
"
i = i + 1
End If
if (USE_BOARD_AVATARS=1) Then
option3="
.
.
"
i = i + 1
End If
if (USE_GALLERY=1) Then
option4="
.
"
i = i + 1
If listTheFiles(AVATAR_DIRECTORY)<>0 Then
option4 = option4 & " " & filetable
End If
End If
response.write option2 & option3 & option4
'optionsconfig="Option Two:"
'If USE_BOARD_AVATARS=1 Then
' optionsConfig="Option Two: Use your current forum avatar.
Use my current avatar.
Option Three:"
'End If
' OutputForm()
'response.write " " & optionsconfig & " Select an avatar from the gallery below."
'If listTheFiles(AVATAR_DIRECTORY)<>0 Then
' response.write " " & filetable
'End If
end if
else
response.write SaveFiles()
if errorstring<>"" then
if (ALLOW_UPLOADS=1) Then
Write_upload_option()
i = i + 1
End If
if (USE_GRAVATAR=1) Then
option2="
.
"
i = i + 1
End If
if (USE_BOARD_AVATARS=1) Then
option3="
.
.
"
i = i + 1
End If
if (USE_GALLERY=1) Then
option4="
.
"
i = i + 1
If listTheFiles(AVATAR_DIRECTORY)<>0 Then
option4 = option4 & " " & filetable
End If
End If
response.write option2 & option3 & option4
end if
response.write "