<%
'Option explicit
'Stores only files with size less than MaxFileSize
Const maxFileSize = 1500000 'limit of size per file
Const imageExts = ".gif,.jpg,.png,.jpeg,.bmp"
Dim DestinationPath
'DestinationPath = Server.mapPath("images")
if session("Module") = "Downloads" then
DestinationPath = Server.mapPath (session("vdownloads"))
else
DestinationPath = Server.mapPath (session("vimagedir"))
end if
dim errorMessage
'Create upload form
'Using Huge-ASP file upload
'Dim Form: Set Form = Server.CreateObject("ScriptUtils.ASPForm")
'Using Pure-ASP file upload
Dim Form: Set Form = New ASPForm %><%
Server.ScriptTimeout = 2000
Form.SizeLimit = 4*1000000 'limit of size per whole form
'{b}Set the upload ID for this form.
'Progress bar window will receive the same ID.
if len(Request.QueryString("UploadID"))>0 then
Form.UploadID = Request.QueryString("UploadID")'{/b}
end if
'was the Form successfully received?
Const fsCompletted = 0
if Session("Module") = "News" then
Dim NewsID
if Session("ID") = "" then
set rsNews = Server.CreateObject ("ADODB.RecordSet")
rsNews.Open "Select Max(NewsID) as MaxNewsID from News", conn
NewsID = rsNews.Fields ("MaxNewsID")
set rsNews=nothing
else
NewsID = Session("ID")
end if
elseif Session("Module") = "Press" then
Dim PressID
if Session("ID") = "" then
set rsPress = Server.CreateObject ("ADODB.RecordSet")
rsPress.Open "Select Max(PressID) as MaxPressID from Press", conn
PressID = rsPress.Fields ("MaxPressID")
set rsPress=nothing
else
PressID = Session("ID")
end if
elseif Session("Module") = "ChildProfile" then
Dim ChildProfileID
if Session("ID") = "" then
set rsChildProfile = Server.CreateObject ("ADODB.RecordSet")
rsChildProfile.Open "Select Max(ChildProfileID) as MaxProfileID from ChildProfile", conn
ChildProfileID = rsChildProfile.Fields ("MaxProfileID")
set rsChildProfile=nothing
else
ChildProfileID = Session("ID")
end if
elseif Session("Module") = "ConferenceVenue" then
Dim ConferenceID
if Session("ID") = "" then
set rsConferenceVenue = Server.CreateObject ("ADODB.RecordSet")
rsConferenceVenue.Open "Select Max(ConferenceVenueID) as MaxConferenceID from ConferenceVenue", conn
ConferenceID = rsConferenceVenue.Fields ("MaxConferenceID")
set rsConferenceVenue=nothing
else
ConferenceID = Session("ID")
end if
elseif Session("Module") = "Links" then
Dim LinksID
if Session("ID") = "" then
set rsLinks = Server.CreateObject ("ADODB.RecordSet")
rsLinks.Open "Select Max(LinksID) as MaxLinksID from Links", conn
LinksID = rsLinks.Fields ("MaxLinksID")
set rsLinks=nothing
else
LinksID = Session("ID")
end if
elseif Session("Module") = "Downloads" then
Dim DownloadsID
if Session("ID") = "" then
set rsDownloads = Server.CreateObject ("ADODB.RecordSet")
rsDownloads.Open "Select Max(DownloadsID) as MaxDownloadID from Downloads", conn
DownloadsID = rsDownloads.Fields ("MaxDownloadID")
set rsDownloads=nothing
else
DownloadsID = Session("ID")
end if
elseif Session("Module") = "CONFERENCEDETAILS" then
dim ConferenceDetailsID
ConferenceDetailsID = Session("ID")
end if
If Form.State = fsCompletted Then 'Completted
Dim CustomerID
CustomerID = Form("CustomerID")
'Do something with upload - save, enumerate, ...
'''response.write " Upload result: Form was accepted."
'''response.write " Number of file fields:" & Form.Files.Count
'''response.write " Request total bytes:" & Request.TotalBytes
'PRocess files and create HTML report
Dim OutHTML: OutHTML = do_Files (Form)
if Session("Module") = "News" and errorMessage = "" then
'Response.Redirect (session("vrootdir")& "/hiddenadmin/news/index.asp")
Response.Redirect ( "/pfc/hiddenadmin/news/index.asp")
elseif Session("Module") = "Press" and errorMessage = "" then
'Response.Redirect (session("vrootdir")& "/hiddenadmin/press/index.asp")
Response.Redirect ("/pfc/hiddenadmin/press/index.asp")
elseif Session("Module") = "ChildProfile" and errorMessage = "" then
' Response.Redirect (session("vrootdir")& "/hiddenadmin/childprofile/index.asp")
Response.Redirect ("/pfc/hiddenadmin/childprofile/index.asp")
elseif Session("Module") = "ConferenceVenue" and errorMessage = "" then
' Response.Redirect (session("vrootdir")& "/hiddenadmin/conferencevenue/index.asp")
Response.Redirect ( "/pfc/hiddenadmin/conferencevenue/index.asp")
elseif Session("Module") = "Links" and errorMessage = "" then
'Response.Redirect (session("vrootdir")& "/hiddenadmin/links/index.asp")
Response.Redirect ("/pfc/hiddenadmin/links/index.asp")
elseif Session("Module") = "Downloads" and errorMessage = "" then
'Response.Redirect (session("vrootdir")& "/hiddenadmin/downloads/index.asp")
Response.Redirect ("/pfc/hiddenadmin/downloads/index.asp")
elseif Session("Module") = "CONFERENCEDETAILS" and errorMessage = "" then
'Response.Redirect (session("vrootdir")& "/hiddenadmin/conferencedetails/index.asp")
Response.Redirect ( "/pfc/hiddenadmin/conferencedetails/index.asp")
end if
'Send the report by email
'''SendReport "to@yourdomain.com", OutHTML
'Write the report to a client
'''response.write OutHTML
ElseIf Form.State > 10 then
Const fsSizeLimit = &HD
Select case Form.State
case fsSizeLimit: response.write " Source form size (" & Form.TotalBytes & "B) exceeds form limit (" & Form.SizeLimit & "B) "
case else response.write " Some form error. "
end Select
End If'Form.State = 0 then
Function do_Files (Form)
Dim HTML
'1. Process main upload fields - CustomerID, Description
Dim UploadID, Uploads, CustomerID
CustomerID = Form("CustomerID")
if len(CustomerID)=0 then CustomerID = -1
'DB contains two tables:
' - Uploads with UploadID (primary key), Description, and CustomerID
' - UploadsFiles with UploadID (foreign key), Description, DestFileName, DataSize and SourceFileName
'Open table with list of uploads
'''Set Uploads = OpenUploadRS("Uploads")
'''Uploads.AddNew
'''Uploads("Description") = Form("Description")
'''Uploads("CustomerID") = CustomerID
'''Uploads.Update
'''UploadID = Uploads("UploadID")
HTML = HTML & " UploadID:" & UploadID
HTML = HTML & " CustomerID:" & Form("CustomerID")
'2. Process form files
Dim File
dim Counter
Counter = 1
For Each File In Form.Files.Items
If Len(File.FileName) > 0 Then
'Open recordset to store uploaded files
'Dim UploadsFiles: Set UploadsFiles = OpenUploadRS("UploadsFiles")
HTML = HTML & " File:" & File.FileName & ", size :" & (File.Length \ 1024 +1) & "kB"
HTML = HTML & ", Is image:" & IsImage(File)
if File.Length > maxFileSize then
HTML = HTML & " exceeds the size limit (" & maxFileSize & ")."
elseif not IsImage(File) Then
HTML = HTML & " is not an image type (" & imageExts & ")."
else
Dim WordFile
Dim PDFFile
Dim DestFileName
DestFileName = GetUniqueFileName(File.FileName, DestinationPath)
if Counter = 1 then
WordFile = DestFileName
Counter = Counter + 1
else
PDFFile = DestFileName
end if
if DestFileName <> "" then
File.SaveAs DestinationPath & "\" & DestFileName
if Session("Module") = "News" then
set rsNews = Server.CreateObject ("ADODB.RecordSet")
rsNews.LockType = adLockOptimistic
rsNews.open "Select * from NEWS where NewsID=" & NewsID, conn
rsNews("Image") = DestFileName
rsNews.Update
set rsNews=nothing
elseif Session("Module") = "Press" then
set rsPress = Server.CreateObject ("ADODB.RecordSet")
rsPress.LockType = adLockOptimistic
rsPress.open "Select * from Press where PressID=" & PressID, conn
rsPress("Image") = DestFileName
rsPress.Update
set rsPress=nothing
elseif Session("Module") = "ChildProfile" then
set rsChildProfile = Server.CreateObject ("ADODB.RecordSet")
rsChildProfile.LockType = adLockOptimistic
rsChildProfile.open "Select * from ChildProfile where ChildProfileID=" & ChildProfileID, conn
rsChildProfile("Image") = DestFileName
rsChildProfile.Update
set rsChildProfile=nothing
elseif Session("Module") = "ConferenceVenue" then
set rsConferenceVenue = Server.CreateObject ("ADODB.RecordSet")
rsConferenceVenue.LockType = adLockOptimistic
rsConferenceVenue.open "Select * from ConferenceVenue where ConferenceVenueID=" & ConferenceID, conn
rsConferenceVenue("Map") = DestFileName
rsConferenceVenue.Update
set rsConferenceVenue=nothing
elseif Session("Module") = "Links" then
set rsLinks = Server.CreateObject ("ADODB.RecordSet")
rsLinks.LockType = adLockOptimistic
rsLinks.open "Select * from Links where LinksID=" & LinksID, conn
rsLinks("Image") = DestFileName
rsLinks.Update
set rsLinks=nothing
elseif Session("Module") = "Downloads" then
set rsDownloads = Server.CreateObject ("ADODB.RecordSet")
rsDownloads.LockType = adLockOptimistic
rsDownloads.open "Select * from Downloads where DownloadsID=" & DownloadsID, conn
rsDownloads("WordDocument") = WordFile
rsDownloads("PDFDocument") = PDFFile
rsDownloads.Update
set rsDownloads=nothing
elseif Session("Module") = "CONFERENCEDETAILS" then
set rsConfDetails=Server.CreateObject ("ADODB.RecordSet")
rsConfDetails.LockType = adLockOptimistic
rsConfDetails.open "Select * from ConferenceDetails where ConferenceDetailsID=" & ConferenceDetailsID, conn
rsConfDetails("BookingForm") = WordFile
rsConfDetails.Update
set rsConfDetails=nothing
end if
end if
'Store extra info about upload to database
''' UploadsFiles.AddNew
''' UploadsFiles("UploadID") = UploadID
''' UploadsFiles("SourceFileName") = left(File.FilePath,255)
''' UploadsFiles("DestFileName") = left(DestFileName, 255)
''' UploadsFiles("DataSize") = File.Length
'...
''' UploadsFiles.Update
HTML = HTML & " was stored to a disk as '" & DestFileName & "'."
end if
end if'if len(File.FileName)=0 then
Next
' Form.Files.Save DestinationPath
HTML = HTML & " Files was saved to " & DestinationPath & " folder."
do_Files = HTML
End Function
Function Check_Files (Form)
Dim HTML
'1. Process main upload fields - CustomerID, Description
Dim UploadID, Uploads, CustomerID
CustomerID = Form("CustomerID")
if len(CustomerID)=0 then CustomerID = -1
HTML = HTML & " UploadID:" & UploadID
HTML = HTML & " CustomerID:" & Form("CustomerID")
'2. Process form files
Dim File
For Each File In Form.Files.Items
If Len(File.FileName) > 0 Then
'Open recordset to store uploaded files
'Dim UploadsFiles: Set UploadsFiles = OpenUploadRS("UploadsFiles")
HTML = HTML & " File:" & File.FileName & ", size :" & (File.Length \ 1024 +1) & "kB"
HTML = HTML & ", Is image:" & IsImage(File)
if File.Length > maxFileSize then
HTML = HTML & " exceeds the size limit (" & maxFileSize & ")."
return false
elseif not IsImage(File) Then
HTML = HTML & " is not an image type (" & imageExts & ")."
return false
end if
end if'if len(File.FileName)=0 then
Next
' Form.Files.Save DestinationPath
return true
Check_Files = HTML
End Function
'Send and upload report to administrator.
Sub SendReport(NotifyAddress, Message)
Dim objNewMail: Set objNewMail = CreateObject("CDONTS.NewMail")
Const CdoMailFormatMime = 0
objNewMail.MailFormat = CdoMailFormatMime
objNewMail.BodyFormat = 0 ' HTML
Dim Subject
Subject = "Upload of files - user '" & request.servervariables("REMOTE_USER") & "'"
'Send the new email
objNewMail.Send "from@yourdomain.com", NotifyAddress, Subject, Message
End Sub
'''Function OpenUploadRS(TableName)
'''Dim RS : Set RS = CreateObject("ADODB.Recordset")
'Open dynamic recordset
'RS.Open TableName, GetConnection, 2, 2
'Set OpenUploadRS = RS
'''end Function
'''Function GetConnection()
'''dim Conn: Set Conn = CreateObject("ADODB.Connection")
'''Conn.Provider = "Microsoft.Jet.OLEDB.4.0"
'''Conn.open "Data Source=" & Server.MapPath("upload.mdb")
'''set GetConnection = Conn
'''end function
'This function checks filename and CONTENTS of a field
'to recognize images
Function IsImage(Field)
IsImage = True 'I'm sorry, PureASP upload does not have HexString property.
Exit Function
if instr(1, imageExts & ",", Field.FileExt & ",", 1)>0 _
or Left(Field.ContentType, 5) = "image" Then
' FFD8FF = JFIF
' 49492A00 = TIF
if Field.HexString (0,3)="FFD8FF" or Field.HexString (0,4)="49492A00" _
or Field.String(,6,4)="JFIF" or Field.String(,0,3)="GIF" _
or Field.String(,1,3)="PNG" or Field.String(,0,2)="BM" then
IsImage = True
end if
end if
End Function
Dim gFS
'creates an unique filename
'in filename.ext, filename-1.ext, filename-2.ext, filename-3.ext, ... schema
Function GetUniqueFileName(FileName, DestPath)
if isempty(gFS) then Set gFS = CreateObject("Scripting.FileSystemObject")
Dim DotPos: DotPos = InStrRev(FileName,".")
if DotPos = 0 then DotPos = len(FileName)+1
Dim Counter, FullPath, NewFileName
Counter = 1
NewFileName = FileName
if gFS.FileExists(DestPath & "\" & NewFileName) then
errorMessage = "Selected image already exists. Please select another image"
Response.Write "
Selected image already exists. Please select another image
"
exit function
else
errorMessage = ""
'This part is for appending the counter and saving the file - Pavan
'Do
' Counter = Counter + 1
' NewFileName = Left(FileName, DotPos-1) & "-" & Counter _
' & Mid(FileName, DotPos)
'Loop while gFS.FileExists(DestPath & "\" & NewFileName)
end if
GetUniqueFileName = NewFileName
End Function
%>