<!-- #include file="gallery_app.asp" -->
<!-- #include file="freeaspupload.asp" -->
<%
' ****************************************************
' Change the value of the variable below to the pathname
' of a directory with write permissions, for example "C:\Inetpub\wwwroot"
Dim uploadsDirVar
uploadsDirVar = server.mappath(".") & "\images\" & request.querystring("gallery_id") & "\" ' "c:\inetpub\temp"
' ****************************************************
' 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/
'
' Handles upload requests, auto generates thumbnail versions of each uploaded file.
'
' Requires:
' Upload Component: http://www.freeaspupload.net/
' Image Manipulation: http://www.codeproject.com/KB/graphics/cximage.aspx
'
function ProcessUpload
Dim Upload, fileName, fileSize, ks, i, fileKey
dim SaveFiles
dim file
dim fsize
dim Q
dim s
Q = chr(34)
dim strFileName
dim lLength
dim strFile
dim strErr
dim strSucc
dim fso
dim sOldFile
dim sStamp
sStamp = year(now()) & "." & datepart( "y", now() ) & "." & CLng( Timer ) & "."
set fso = createobject("scripting.filesystemobject")
Set Upload = New FreeASPUpload
on error resume next
Upload.Save(uploadsDirVar)
if err.description <> "" then
strErr = strErr & err.description & "<br/>"
err.clear
end if
on error goto 0
SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
strFile = Upload.UploadedFiles(fileKey).FileName
sOldFile = uploadsDirVar & "\" & strFile
strFile = sStamp & strFile
strFileName = uploadsDirVar & "\" & strFile
call fso.MoveFile( sOldFile, strFileName )
lLength = Upload.UploadedFiles(fileKey).Length
SaveFiles = SaveFiles & strFileName & " (" & lLength & "B) "
if file <>"" then file = file & ","
if fsize <>"" then fsize=fsize & ","
'uploadsDirVar
AddGalleryImage( strFile )
file = file & strFile
fsize = fsize & round( lLength / 1024.0, 2 )
'' Generate Thumbnail Images
'Call ThumbNail(strFileName, 32, 32,1,80)
'Call ThumbNail(strFileName, 64, 64,1,80)
'Call Thumbnail(strFileName, 96, 96,1,80)
'Call ThumbNail(strFileName,120,120,1,80)
'Call ThumbNail(strFileName,240,240,1,80)
'Call ThumbNail(strFileName,480,480,1,80)
'Call ThumbNail(strFileName,640,640,1,80)
'Call ThumbNail(strFileName,800,800,1,80)
'Call ThumbNail(strFileName,960,960,1,80)
next
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
SaveFiles = SaveFiles & "<br>Enter a number = " & Upload.Form("Title") & "<br>"
SaveFiles = SaveFiles & "Checkbox values = " & Upload.Form("Description") & "<br>"
SaveFiles = SaveFiles & "List values = " & Upload.Form("FileName") & "<br>"
if strErr = "" then
strSuccess = "Image Uploaded Successfully"
else
strSuccess = ""
end if
s = "{ "
if strErr = "" then
s = s & Q & "message" & Q & ":" & Q & strSuccess & Q & ","
s = s & Q & "failure" & Q & ": false, "
else
s = s & Q & "message" & Q & ":" & Q & strErr & Q & ","
s = s & Q & "failure" & Q & ": true, "
end if
s = s & Q & "file_name" & Q & ":" & Q & file & Q & ","
s = s & Q & "size" & Q & ":" & Q & fsize & Q & ", "
s = s & Q & "title" & Q & ":" & Q & Upload.Form("Title") & Q & ", "
s = s & Q & "description" & Q & ":" & Q & Upload.Form("Description") & Q & ", "
'' use line below to add more variables
's = s & Q & "" & Q & ":" & Q & "" & Q & ", "
''
s = s & Q & "complete" & Q & ":" & Q & "yes" & Q & " "
s = s & " } "
ProcessUpload = s
end function
'' {"success":"Image uploaded successfully","failure":false,"file_name":"d78c4_Slide31small.jpg","size":1.9}
%>
<html>
<head>
<% if request.servervariables("request_method")="POST" then %>
<script type='text/javascript'>
function init() {
//alert( document.getElementsByTagName("body")[0].innerHTML );
if ( top.uploadDone2 ) top.uploadDone2( document.getElementsByTagName("body")[0].innerHTML );
}
window.onload=init;
</script>
<% end if %>
</head>
<body id="body">
<%
if request.servervariables("request_method")="POST" then
response.write ProcessUpload
end if
%>
</body>
</html>
<%
dim IMAGE_TOOLS_VERSION: IMAGE_TOOLS_VERSION="V1.0 (c) 2009 Aditus Business Solutions"
function ThumbNail(strFileName,lWidth,lHeight,lKeepRatio,lCompression)
' response.Write "Call to Thumbnail"
dim fso: set fso = createobject("scripting.filesystemobject")
dim lH: lH=lHeight
dim lW: lW=lWidth
dim lRatio: lRatio = lKeepRatio
dim strSitePath
''response.write strFileName
strSitePath = fso.GetFile(strFileName).ParentFolder
dim strHTML
dim strSRC
dim strOnC ' OnClick
dim strImgPath
dim strThumbPath
dim strURL
dim bExists
dim strThumbName
strImgPath = strFileName
rem convert to cx image
dim pWidth
dim pHeight
dim FileName
dim sRoot
dim sFile
dim bStretch
dim widthTh
dim heightTh
dim widthOrig
dim heightOrig
dim objCxImage
dim Quality
dim strResult
rem use cximage
bStretch = (lKeepRatio = 0)
Quality = lCompression
sRoot = strSitePath
sFile = fso.getFile( strFileName ).name
FileName = strFileName
pWidth = lW
pHeight = lH
ThumbName = uploadsDirVar & "thumb\" & sFile & "." & pWidth & "x" & pHeight & ".jpg"
' Create COM CxImage wrapper object
Set objCxImage = CreateObject("CxImageATL.CxImage")
Call objCxImage.Load(FileName,GetFileType(FileName))
Call objCxImage.IncreaseBpp(24)
' determine thumbnail size and resample original image data
If bStretch Then ' stretch to fit
widthTh = Width
heightTh = Height
Else ' retain aspect ratio
widthOrig = CDbl(objCxImage.GetWidth())
heightOrig = CDbl(objCxImage.GetHeight())
fx = widthOrig/pWidth
fy = heightOrig/pHeight 'subsample factors
' must fit in thumbnail size
If fx>fy Then f=fx Else f=fy ' Max(fx,fy)
If f<1 Then f=1
widthTh = Int(widthOrig/f)
heightTh = Int(heightOrig/f)
End If
objCxImage.SetJpegQuality( Quality )
Call objCxImage.Resample(widthTh,heightTh,2)
call objCxImage.Save(thumbname,GetFileType("jpg"))
Call objCxImage.Destroy()
set objCxImage = nothing
rem end convert to cx image
Thumbnail = ThumbName
end function
Function GetFileType(sFile)
dot = InStrRev(sFile, ".")
filetype=2
If dot > 0 Then sExt = LCase(Mid(sFile, dot + 1, 3))
If sExt = "bmp" Then filetype = 0
If sExt = "gif" Then filetype = 1
If sExt = "jpg" Then filetype = 2
If sExt = "png" Then filetype = 3
If sExt = "ico" Then filetype = 4
If sExt = "tif" Then filetype = 5
If sExt = "tga" Then filetype = 6
If sExt = "pcx" Then filetype = 7
GetFileType=filetype
End Function
%>
Submit an article or tip