Modificação upload com criação de thumb para fundo transparente

[biakelly 0]

Olá meninos, como voces estão? Espero que bem.

 

 

Utilizo o "Pure ASP File Upload 2.1.3" para realizar upload de imagens, bem como criar automaticamente um thumb com o "Smart Image Processor"

 

Ambos funcionam bem, mas ao inserir imagens com fundo transparente e em formato PNG a imagem final do thumb fica com fundo preto, creio que seja alguma alteraçao no JS que possa corrigir, vou colocar abaixo o código quem sabe vocês me ajudam resolver isso

Utilizo este trecho para salvar as imagens em uma pasta especifica, no meu caso "pictures"

<%
'*** Pure ASP File Upload 2.1.3
Dim GP_uploadAction,UploadQueryString
PureUploadSetup
If (CStr(Request.QueryString("GP_upload")) <> "") Then
  Dim pau_thePath,pau_Extensions,pau_Form,pau_Redirect,pau_storeType,pau_sizeLimit,pau_nameConflict,pau_requireUpload,pau_minWidth,pau_minHeight,pau_maxWidth,pau_maxHeight,pau_saveWidth,pau_saveHeight,pau_timeout,pau_progressBar,pau_progressWidth,pau_progressHeight
  pau_thePath = """../pictures"""
  pau_Extensions = "GIF,JPG,JPEG,BMP,PNG"
  pau_Form = "add_data"
  pau_Redirect = ""
  pau_storeType = "file"
  pau_sizeLimit = ""
  pau_nameConflict = "uniq"
  pau_requireUpload = "false"
  pau_minWidth = ""
  pau_minHeight = "" 
  pau_maxWidth = ""
  pau_maxHeight = ""
  pau_saveWidth = ""
  pau_saveHeight = ""
  pau_timeout = "600"
  pau_progressBar = ""
  pau_progressWidth = "800"
  pau_progressHeight = "596"
  
  Dim RequestBin, UploadRequest
  CheckPureUploadVersion 2.13
  ProcessUpload pau_thePath,pau_Extensions,pau_Redirect,pau_storeType,pau_sizeLimit,pau_nameConflict,pau_requireUpload,pau_minWidth,pau_minHeight,pau_maxWidth,pau_maxHeight,pau_saveWidth,pau_saveHeight,pau_timeout
end if
%>

Para criar o thumb uso o smart processor que vai criar o thumb e inserir um nome a mais na imagem, neste caso: "_small"

<%
' *** Smart Image Processor 1.1.2
If (CStr(Request.QueryString("GP_upload")) <> "") Then
  Dim RUF_Component, RUF_DotNetResize, RUF_ResizeImages, RUF_AspectImages, RUF_maxWidth, RUF_maxHeight, RUF_Quality, RUF_MakeThumb, RUF_AspectThumb, RUF_Suffix, RUF_maxWidthThumb, RUF_maxHeightThumb, RUF_QualityThumb, RUF_RedirectURL
  RUF_Component = "AUTO"
  RUF_DotNetResize = "../ScriptLibrary/ResizeImage.aspx"
  RUF_ResizeImages = true
  RUF_AspectImages = true
  RUF_maxWidth = "800"
  RUF_maxHeight = "596"  
  RUF_Quality = "90"
  RUF_MakeThumb = true
  RUF_AspectThumb = true
  RUF_Suffix = "_small"
  RUF_maxWidthThumb = "130"
  RUF_maxHeightThumb = "130"
  RUF_QualityThumb = "100"
  RUF_RedirectURL = ""
  if RUF_ResizeImages then
    ResizeUploadedFiles RUF_Component, RUF_DotNetResize, pau_thePath, "", RUF_maxWidth, RUF_maxHeight, RUF_Quality, true, pau_saveWidth, pau_saveHeight, RUF_AspectImages, pau_nameConflict, ""
  end if
  if RUF_MakeThumb then
    ResizeUploadedFiles RUF_Component, RUF_DotNetResize, pau_thePath, RUF_Suffix, RUF_maxWidthThumb, RUF_maxHeightThumb, RUF_QualityThumb, false, pau_saveWidth, pau_saveHeight, RUF_AspectThumb, pau_nameConflict, ""
  end if
  if RUF_RedirectURL <> "" then
    Response.Redirect RUF_RedirectURL
  end if
end if
%>

 

 

O arquivo "Resizeimagem.aspx" é este:

<%@ Page Language="C#"%>
<%@ Import Namespace="System.Drawing" %>
<%@ Import Namespace="System.Drawing.Imaging" %>
<script runat="server">
// Smart Image Processor 1.1
// Version: 1.1.2

	void Page_Load(Object s, EventArgs e) {
		
		int intNewWidth,intNewHeight, maxWidth = 10000, maxHeight = 10000, qQuality = 80;
    if ( Request["w"] != null) maxWidth = int.Parse(Request["w"]);
    if ( Request["h"] != null) maxHeight = int.Parse(Request["h"]);
    if ( Request["q"] != null) qQuality = int.Parse(Request["q"]);
		
		//get image from parameter
		string pictureFileName = Request["f"];
    string newFileName = Request["nf"];
    if (pictureFileName == null || pictureFileName == "" || !System.IO.File.Exists(pictureFileName)) {
      Response.Write("Error: File (" + pictureFileName + ") not found or empty");  
      return;
    }
		System.Drawing.Image inputImage = System.Drawing.Image.FromFile(pictureFileName);
        
    //define size for new image
		string aspect = Request["a"];
		if (aspect == "true") {
			if (maxWidth < inputImage.Width || maxHeight < inputImage.Height) {
				if (maxWidth >= maxHeight) {
					intNewWidth = (int)((double)maxHeight*((double)inputImage.Width/(double)inputImage.Height));
					intNewHeight = maxHeight;
				} else {
					intNewWidth = maxWidth;
					intNewHeight = (int)((double)maxWidth*((double)inputImage.Height/(double)inputImage.Width));
				}
				if (intNewWidth > maxWidth) {
					intNewWidth = maxWidth;
					intNewHeight = (int)((double)maxWidth*((double)inputImage.Height/(double)inputImage.Width));
				}
				if (intNewHeight > maxHeight) {
					intNewWidth = (int)((double)maxHeight*((double)inputImage.Width/(double)inputImage.Height));
					intNewHeight = maxHeight;
				}
			} else {
				intNewWidth = inputImage.Width;
				intNewHeight = inputImage.Height;
			}
		} else {
				intNewWidth = maxWidth;
				intNewHeight = maxHeight;
		}

    try {        
      //output new image with different size
  		Bitmap outputBitMap = new Bitmap(inputImage,intNewWidth,intNewHeight);
      inputImage.Dispose();
     	EncoderParameters eps = new System.Drawing.Imaging.EncoderParameters(1);
     	eps.Param[0] = new System.Drawing.Imaging.EncoderParameter( System.Drawing.Imaging.Encoder.Quality, qQuality );
     	ImageCodecInfo ici = GetEncoderInfo("image/jpeg");
      if (pictureFileName.ToLower() == newFileName.ToLower())
        System.IO.File.Delete(pictureFileName);
     	outputBitMap.Save( newFileName, ici, eps );
      outputBitMap.Dispose();      
    }		
    catch (Exception ex) {
    	Response.Write("Error: " + ex);
			return;
    }  
    
    Response.Write(intNewWidth + ";" + intNewHeight + ";" + "DONE");
  }
    
  private static ImageCodecInfo GetEncoderInfo(String mimeType) {
    int j;
    ImageCodecInfo[] encoders;
    encoders = ImageCodecInfo.GetImageEncoders();
    for(j = 0; j < encoders.Length; ++j) {
      if(encoders[j].MimeType == mimeType)
        return encoders[j];
    }
    return null;
  }
    
</script>

Uso o include incPureUpload.asp para subir a imagem:

<SCRIPT LANGUAGE="VBSCRIPT" RUNAT="SERVER">
'*** Pure ASP File Upload -----------------------------------------------------
' Copyright 2001-2003 (c) George Petrov, www.DMXzone.com
' Version: 2.17
'------------------------------------------------------------------------------


'Current version
Function getPureUploadVersion()
  getPureUploadVersion = 2.17
End Function


'Set the querystring correctly
Sub PureUploadSetup()
	If (CStr(Request.QueryString("GP_upload")) <> "") Then
		UploadQueryString = Replace(Request.QueryString,"GP_upload=true","")
		if left(UploadQueryString,1) = "&" or left(UploadQueryString,1) = "?" then
			UploadQueryString = Mid(UploadQueryString,2)
		end if
		if right(UploadQueryString,1) = "&" then
			UploadQueryString = Mid(UploadQueryString,1,len(UploadQueryString)-1)
		end if	
	else  
		UploadQueryString = Request.QueryString
		If (UploadQueryString <> "") Then  
			UploadQueryString = UploadQueryString & "&GP_upload=true"
		else
			UploadQueryString = "GP_upload=true"
		end if	
		GP_uploadAction = CStr(Request.ServerVariables("URL")) & "?" & UploadQueryString
	end if  
End Sub


'Read the form(actual upload)
Sub ProcessUpload(pau_thePath,pau_Extensions,pau_Redirect,pau_storeType,pau_sizeLimit,pau_nameConflict,pau_requireUpload,pau_minWidth,pau_minHeight,pau_maxWidth,pau_maxHeight,pau_saveWidth,pau_saveHeight,pau_timeout)
	Server.ScriptTimeout = pau_timeout
	pau_doPreUploadChecks pau_sizeLimit
	RequestBin = Request.BinaryRead(Request.TotalBytes)
	Set UploadRequest = CreateObject("Scripting.Dictionary")  
	pau_BuildUploadRequest RequestBin, pau_thePath, pau_storeType, pau_sizeLimit, pau_nameConflict, pau_Extensions
	If pau_Redirect <> "" Then
		If UploadQueryString <> "" Then
			pau_Redirect = pau_Redirect & "?" & UploadQueryString
		End If
		Response.Redirect(pau_Redirect)  
	end if  
End Sub


'Some checks before actual upload
Sub pau_doPreUploadChecks(sizeLimit)
	Dim checkADOConn, AdoVersion, Length
	'Check ADO Version
	set checkADOConn = Server.CreateObject("ADODB.Connection")
	on error resume next
	adoVersion = CSng(checkADOConn.Version)
	if err then 
		adoVersion = Replace(checkADOConn.Version,".",",")  
		adoVersion = CSng(adoVersion)
	end if	
	err.clear
	on error goto 0	
	set checkADOConn = Nothing
	if adoVersion < 2.5 then
		Response.Write "<b>You don't have ADO 2.5 installed on the server.</b><br/>"
		Response.Write "The File Upload extension needs ADO 2.5 or greater to run properly.<br/>"
		Response.Write "You can download the latest MDAC (ADO is included) from <a href=""www.microsoft.com/data"">www.microsoft.com/data</a><br/>"
		Response.End
	end if
	'Check content length if needed
	Length = CLng(Request.ServerVariables("Content_Length")) 'Get Content-Length header
	If sizeLimit <> "" Then
		sizeLimit = CLng(sizeLimit) * 1024
		If Length > sizeLimit Then
			Response.Write "Upload size " & FormatNumber(Length, 0) & "B exceeds limit of " & FormatNumber(sizeLimit, 0) & "B<br/>"
			Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"      
			Response.End
		End If
	End If
End Sub


'Check if version is uptodate
Sub CheckPureUploadVersion(pau_version)
	Dim foundPureUploadVersion
	foundPureUploadVersion = getPureUploadVersion()
	if err or pau_version > foundPureUploadVersion then
		Response.Write "<b>You don't have latest version of ScriptLibrary/incPureUpload.asp uploaded on the server.</b><br/>"
		Response.Write "This library is required for the current page. It is fully backwards compatible so old pages will work as well.<br/>"
		Response.End    
	end if
End Sub


'Get fieldname
function pau_Name(FormInfo)
	Dim PosBeg, PosLen
	PosBeg = InStr(FormInfo, "name=")+6
	PosLen = InStr(PosBeg, FormInfo, Chr(34))-PosBeg
	pau_Name = Mid(FormInfo, PosBeg, PosLen)
end function


'Get filename
function pau_FileName(FormInfo)
	Dim PosBeg, PosLen
	PosBeg = InStr(FormInfo, "filename=")+10
	PosLen = InStr(PosBeg, FormInfo, Chr(34))-PosBeg
	pau_FileName = Mid(FormInfo, PosBeg, PosLen)
end function


'Get contentType
function pau_ContentType(FormInfo)
	Dim PosBeg
	PosBeg = InStr(FormInfo, "Content-Type: ")+14
	pau_ContentType = Mid(FormInfo, PosBeg)
end function


'Compatibility with older versions
Sub BuildUploadRequest(RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict)
	pau_BuildUploadRequest RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict,""
End Sub


Sub pau_BuildUploadRequest(RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict,Extensions)
	Dim Boundary, FormInfo, TypeArr, BoundaryArr, BoundaryPos, PosBeg, PosEnd, Pos, PosLen, Extension, ExtArr, i
	Dim PosFile, Name, PosBound, FileName, ContentType, Value, ValueBeg, ValueEnd, ValueLen, ExtChk
	'Check content type
	TypeArr = Split(Request.ServerVariables("Content_Type"), ";")
	if Trim(TypeArr(0)) <> "multipart/form-data" then
		Response.Write "<b>Form was submitted with no ENCTYPE=""multipart/form-data""</b><br/>"
		Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"      
		Response.End
	end if
	'Get the boundary
	  PosBeg = 1
	  PosEnd = InstrB(PosBeg,RequestBin,pau_getByteString(chr(13)))
	  if PosEnd = 0 then
		Response.Write "<b>Form was submitted with no ENCTYPE=""multipart/form-data""</b><br>"
		Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"    
		Response.End
	  end if
	  boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
	  boundaryPos = InstrB(1,RequestBin,boundary)
	  'Get all data inside the boundaries
	  Do until (boundaryPos=InstrB(RequestBin,boundary & pau_getByteString("--")))
		'Members variable of objects are put in a dictionary object
		Dim UploadControl
		Set UploadControl = CreateObject("Scripting.Dictionary")
		'Get an object name
		Pos = InstrB(BoundaryPos,RequestBin,pau_getByteString("Content-Disposition"))
		Pos = InstrB(Pos,RequestBin,pau_getByteString("name="))
		PosBeg = Pos+6
		PosEnd = InstrB(PosBeg,RequestBin,pau_getByteString(chr(34)))
		Name = LCase(pau_getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg)))
		PosFile = InstrB(BoundaryPos,RequestBin,pau_getByteString("filename="))
		PosBound = InstrB(PosEnd,RequestBin,boundary)
		'Test if object is of file type
		If  PosFile<>0 AND (PosFile<PosBound) Then
		  'Get Filename, content-type and content of file
		  PosBeg = PosFile + 10
		  PosEnd =  InstrB(PosBeg,RequestBin,pau_getByteString(chr(34)))
		  FileName = pau_getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
		  FileName = pau_RemoveInvalidChars(Mid(FileName,InStrRev(FileName,"\")+1))
		  'Check extension
		  Extension = Mid(FileName,InStrRev(FileName,".")+1)
		  If Extensions <> "" And FileName <> "" Then
		  	ExtChk = true
		  	ExtArr = Split(Extensions, ",")
		  	For i = 0 to UBound(ExtArr)
		  		If LCase(ExtArr(i)) = LCase(Extension) Then
		  			ExtChk = false
					End If
		  	Next
		  	If ExtChk Then
					Response.Write "Filename: " & FileName & "<br/>"
					Response.Write "Filetype is not allowed, only " & Extensions & " are allowed<br/>"
					Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"
					Response.End
				End If
		  End If
		  'Add filename to dictionary object
		  UploadControl.Add "FileName", FileName
		  Pos = InstrB(PosEnd,RequestBin,pau_getByteString("Content-Type:"))
		  PosBeg = Pos+14
		  PosEnd = InstrB(PosBeg,RequestBin,pau_getByteString(chr(13)))
		  'Add content-type to dictionary object
		  ContentType = pau_getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
		  UploadControl.Add "ContentType",ContentType
		  'Get content of object
		  PosBeg = PosEnd+4
		  PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
		  Value = FileName
		  ValueBeg = PosBeg-1
		  ValueLen = PosEnd-Posbeg
		Else
		  'Get content of object
		  Pos = InstrB(Pos,RequestBin,pau_getByteString(chr(13)))
		  PosBeg = Pos+4
		  PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
		  Value = pau_getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
		  ValueBeg = 0
		  ValueEnd = 0
		End If
		'Add content to dictionary object
		UploadControl.Add "Value" , Value	
		UploadControl.Add "ValueBeg" , ValueBeg
		UploadControl.Add "ValueLen" , ValueLen	
		'Add dictionary object to main dictionary
		if UploadRequest.Exists(name) then
		  UploadRequest(name).Item("Value") = UploadRequest(name).Item("Value") & "," & Value
		else
		  UploadRequest.Add name, UploadControl 
		end if    
		'Loop to next object
		BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
	  Loop
	Dim GP_keys, GP_i, GP_curKey, GP_value, GP_valueBeg, GP_valueLen, GP_curPath, GP_FullPath
	Dim GP_CurFileName, GP_FullFileName, fso, GP_BegFolder, GP_RelFolder, GP_FileExist, Begin_Name_Num
	Dim orgUploadDirectory
	if InStr(UploadDirectory,"""") > 0 then 
		on error resume next
		orgUploadDirectory = UploadDirectory
		UploadDirectory = eval(UploadDirectory)  
		if err then
			Response.Write "<b>Upload folder is invalid</b><br/><br/>"      
			Response.Write "Upload Folder: " & Trim(orgUploadDirectory) & "<br/>"
			Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"
			err.clear
			response.End
		end if    
		on error goto 0
	end if  
	GP_keys = UploadRequest.Keys
	for GP_i = 0 to UploadRequest.Count - 1
		GP_curKey = GP_keys(GP_i)
		'Save all uploaded files
		if UploadRequest.Item(GP_curKey).Item("FileName") <> "" then
			GP_value = UploadRequest.Item(GP_curKey).Item("Value")
			GP_valueBeg = UploadRequest.Item(GP_curKey).Item("ValueBeg")
			GP_valueLen = UploadRequest.Item(GP_curKey).Item("ValueLen")
			'Get the path
			if InStr(UploadDirectory,"\") > 0 then
				GP_curPath = UploadDirectory
				if Mid(GP_curPath,Len(GP_curPath),1) <> "\" then
					GP_curPath = GP_curPath & "\"
				end if         
				GP_FullPath = GP_curPath
			else
				if Left(UploadDirectory,1) = "/" then
					GP_curPath = UploadDirectory
				else
					GP_curPath = Request.ServerVariables("PATH_INFO")
					GP_curPath = Trim(Mid(GP_curPath,1,InStrRev(GP_curPath,"/")) & UploadDirectory)
					if Mid(GP_curPath,Len(GP_curPath),1)  <> "/" then
						GP_curPath = GP_curPath & "/"
					end if 
				end if
				GP_FullPath = Trim(Server.mappath(GP_curPath))				
			end if
			if GP_valueLen = 0 then
				Response.Write "<b>An error has occurred while saving the uploaded file!</b><br/><br/>"
				Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br/>"
				Response.Write "The file does not exists or is empty.<br/>"
				Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"
				response.End
			end if
			'Create a Stream instance
			Dim GP_strm1, GP_strm2
			Set GP_strm1 = Server.CreateObject("ADODB.Stream")
			Set GP_strm2 = Server.CreateObject("ADODB.Stream")
			'Open the stream
			GP_strm1.Open
			GP_strm1.Type = 1 'Binary
			GP_strm2.Open
			GP_strm2.Type = 1 'Binary
			GP_strm1.Write RequestBin
			GP_strm1.Position = GP_ValueBeg
			GP_strm1.CopyTo GP_strm2,GP_ValueLen
			'Create and Write to a File
			GP_CurFileName = UploadRequest.Item(GP_curKey).Item("FileName")      
			GP_FullFileName = GP_FullPath & "\" & GP_CurFileName
			Set fso = CreateObject("Scripting.FileSystemObject")
			pau_AutoCreatePath GP_FullPath
			'Check if the file already exist
			GP_FileExist = false
			If fso.FileExists(GP_FullFileName) Then
				GP_FileExist = true
			End If      
			if nameConflict = "error" and GP_FileExist then
				Response.Write "<b>The file already exists on the server!</b><br/><br/>"
				Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"
				GP_strm1.Close
				GP_strm2.Close
				response.End
			end if
			if ((nameConflict = "over" or nameConflict = "uniq") and GP_FileExist) or (NOT GP_FileExist) then
				if nameConflict = "uniq" and GP_FileExist then
					Begin_Name_Num = 0
					while GP_FileExist    
						Begin_Name_Num = Begin_Name_Num + 1
						GP_FullFileName = Trim(GP_FullPath)& "\" & fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
						GP_FileExist = fso.FileExists(GP_FullFileName)
					wend  
					UploadRequest.Item(GP_curKey).Item("FileName") = fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
					UploadRequest.Item(GP_curKey).Item("Value") = UploadRequest.Item(GP_curKey).Item("FileName")
				end if
				on error resume next
				GP_strm2.SaveToFile GP_FullFileName,2
				if err then
					err.clear
					Dim txt_stream, file_bin
					Set txt_stream = fso.CreateTextFile(GP_FullFileName, True)
					file_bin = pau_getString(MidB(RequestBin, GP_ValueBeg+1, GP_ValueLen))
					txt_stream.Write file_bin
					txt_stream.Close
					if err then
						GP_strm1.Close
						GP_strm2.Close
						Response.Write "<b>An error has occurred while saving uploaded file!</b><br/><br/>"
						Response.Write "Filename: " & GP_FullFileName & "<br/><br/>"
						if fso.FileExists(GP_FullFileName) then
							Dim f
							Response.Write "The file already exists on the server!<br/>"
							Set f = fso.GetFile(GP_FullFileName)
							Response.Write "Attributes(" & f.attributes & "|" & f.parentfolder.attributes & "): "
							if f.attributes and 1 then
								Response.Write "ReadOnly "
							end if
							if f.attributes and 2 then
								Response.Write "Hidden "
							end if
							if f.attributes and 4 then
								Response.Write "System "
							end if
							if f.attributes and 16 then
								Response.Write "Directory "
							end if
							Response.Write "<br/><br/>"
						end if
						response.End
					end if
				end if
				GP_strm1.Close
				GP_strm2.Close
				if storeType = "path" then
					UploadRequest.Item(GP_curKey).Item("Value") = GP_curPath & UploadRequest.Item(GP_curKey).Item("Value")
				end if
				on error goto 0
			end if
		end if
	next
End Sub


'Create folders if they do not exist
Sub pau_AutoCreatePath(PAU_FullPath)
	Dim FL_fso, FL_EndPos, PAU_NewPath
	Set FL_fso = CreateObject("Scripting.FileSystemObject")  
	if not FL_fso.FolderExists(PAU_FullPath) then
	FL_EndPos = InStrRev(PAU_FullPath,"\")
	if FL_EndPos > 0 then
		PAU_NewPath = Left(PAU_FullPath,FL_EndPos-1)
		pau_AutoCreatePath PAU_NewPath
		on error resume next
		FL_fso.CreateFolder PAU_FullPath
		if err.number <> 0 then
			Response.Write "<b>Can not create upload folder path: " & PAU_FullPath & "!</b><br/>"
			Response.Write "Maybe you don't have the proper permissions<br/><br/>"        
			Response.Write "Error # " & CStr(Err.Number) & " " & Err.Description & "<br/><br/>"
			Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"
			Response.End        
		end if
		on error goto 0
		end if  
	end if
	Set FL_fso = nothing
End Sub


'String to byte string conversion
Function pau_getByteString(StringStr)
	Dim i, char
	For i = 1 to Len(StringStr)
		char = Mid(StringStr,i,1)
		pau_getByteString = pau_getByteString & chrB(AscB(char))
	Next
End Function


'Byte string to string conversion (with double-byte support now)
Function pau_getString(StringBin)
	Dim intCount,get1Byte
	pau_getString = ""
	For intCount = 1 to LenB(StringBin)
		get1Byte = MidB(StringBin,intCount,1)
		pau_getString = pau_getString & chr(AscB(get1Byte)) 
	Next
End Function


'Replacement for the requests
Function UploadFormRequest(name)
	Dim keyName
	keyName = LCase(name)
	if IsObject(UploadRequest) then
		if UploadRequest.Exists(keyName) then
			if UploadRequest.Item(keyName).Exists("Value") then
				UploadFormRequest = UploadRequest.Item(keyName).Item("Value")
			end if  
		end if  
	end if  
End Function


'Invalid characters
'Dollar sign ($) 
'At sign (@) 
'Angle brackets (< >), brackets ([ ]), braces ({ }), and parentheses (( )) 
'Colon (:) and semicolon (;) 
'Equal sign (=) 
'Caret sign (^) 
'Pipe (vertical bar) (|) 
'Asterisk (*) 
'Exclamation point (!) 
'Forward (/) and backward slash (\) 
'Percent sign (%) 
'Question mark (?) 
'Comma (,) 
'Quotation mark (single or double) (' ") 
'Tab 
Function pau_RemoveInvalidChars(str)
	Dim newStr, ci, curChar, Invalid
	Invalid = "$@<>[]{}():;=^|*!/\%?,'""	"
	for ci = 1 to Len(str)
		curChar = Mid(str,ci,1)
		if InStr(Invalid, curChar) = 0 then
			newStr = newStr & curChar
		end if
	next
	pau_RemoveInvalidChars = Trim(newStr)
End Function


'Fix for the update record
Function FixFieldsForUpload(GP_fieldsStr, GP_columnsStr)
	Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_FieldValue, GP_CurFileName, GP_CurContentType
	GP_Fields = Split(GP_fieldsStr, "|")
	GP_Columns = Split(GP_columnsStr, "|") 
	GP_fieldsStr = ""
	' Get the form values
	For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
		GP_FieldName = LCase(GP_Fields(GP_counter))
		GP_FieldValue = GP_Fields(GP_counter+1)
		if UploadRequest.Exists(GP_FieldName) then
			GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
			GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")
		else  
			GP_CurFileName = ""
			GP_CurContentType = ""
		end if	
		if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
			GP_fieldsStr = GP_fieldsStr & GP_FieldName & "|" & GP_FieldValue & "|"
		end if 
	Next
	if GP_fieldsStr <> "" then
		GP_fieldsStr = Mid(GP_fieldsStr,1,Len(GP_fieldsStr)-1)
	else  
		Response.Write "<b>An error has occured during record update!</b><br/><br/>"
		Response.Write "There are no fields to update ...<br/>"
		Response.Write "If the file upload field is the only field on your form, you should make it required.<br/>"
		Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"
		Response.End
	end if
	FixFieldsForUpload = GP_fieldsStr    
End Function


'Fix for the update record
Function FixColumnsForUpload(GP_fieldsStr, GP_columnsStr)
	Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_ColumnName, GP_ColumnValue,GP_CurFileName, GP_CurContentType
	GP_Fields = Split(GP_fieldsStr, "|")
	GP_Columns = Split(GP_columnsStr, "|") 
	GP_columnsStr = "" 
	' Get the form values
	For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
		GP_FieldName = LCase(GP_Fields(GP_counter))  
		GP_ColumnName = GP_Columns(GP_counter)  
		GP_ColumnValue = GP_Columns(GP_counter+1)
		if UploadRequest.Exists(GP_FieldName) then
			GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
			GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")	  
		else  
			GP_CurFileName = ""
			GP_CurContentType = ""
		end if  
		if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
			GP_columnsStr = GP_columnsStr & GP_ColumnName & "|" & GP_ColumnValue & "|"
		end if 
	Next
	if GP_columnsStr <> "" then
		GP_columnsStr = Mid(GP_columnsStr,1,Len(GP_columnsStr)-1)    
	end if
	FixColumnsForUpload = GP_columnsStr
End Function

</SCRIPT>

E uso tambem o incResizeAddOn.asp

<SCRIPT LANGUAGE="VBSCRIPT" RUNAT="SERVER">
'*** Resize Files After Upload -----------------------------------------------
' Copyright 2001-2003 (c) George Petrov, www.DMXzone.com
'
' Version: 1.1.2
'------------------------------------------------------------------------------

sub FitImage_Comp(compType,DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  select case compType
  case "AUTO"
    FitImage_Comp DetectImageComponent(DotNetResize),DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "PICPROC"
    FitImage_PicProc imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "SHOTGRAPH"
    FitImage_ShotGraph imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "ASPJPEG"
    FitImage_AspJpeg imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "ASPIMAGE"
    FitImage_AspImage imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "ASPSMART"
    FitImage_AspSmart imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "IMGWRITER"
    FitImage_ImgWriter imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "ASPTHUMB"
    FitImage_AspThumb imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
  case "ASP.NET"
    select case DetectDotNetComponent(DotNetResize)
    case "DOTNET1"
      FitImage_DotNet "Msxml2.ServerXMLHTTP.3.0",DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
    case "DOTNET2"
      FitImage_DotNet "Msxml2.ServerXMLHTTP",DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
    case "DOTNET3"
      FitImage_DotNet "Microsoft.XMLHTTP",DotNetResize,imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect
    end select
  end select
end sub

function DetectImageComponent(DotNetResize)
  Dim objPictureProcessor, objASPjpeg, AspImage, AspSmart, objImgWriter, objAspThumb, ImageComponent
  ImageComponent = ""
  if Application("ResizeAutoComponent112") = "" then
    on error resume next
   'Check for our own Picture Processor
    err.clear
    Set objPictureProcessor = Server.CreateObject("COMobjects.NET.PictureProcessor")
    if err.number = 0 then
      Set objPictureProcessor = nothing
      ImageComponent = "PICPROC"
    else
     'Check for ShotGraph
      err.clear
      Set objShotGraph = Server.CreateObject("shotgraph.image")
      'Response.Write err & " - " & err.number & ":" & err.description & "<br/>"
      if err.number = 0 then
        Set objShotGraph = nothing
        ImageComponent = "SHOTGRAPH"
      else
     'Check for AspJpeg
      err.clear
      Set objASPjpeg = Server.CreateObject("Persits.Jpeg")
      'Response.Write err & " - " & err.number & ":" & err.description & "<br/>"
      if err.number = 0 then
        Set objASPjpeg = nothing
        ImageComponent = "ASPJPEG"
      else
        'Check for AspImage
        err.clear
        Set AspImage = Server.CreateObject("AspImage.Image")
        if err.number = 0 then
          Set AspImage = nothing
          ImageComponent = "ASPIMAGE"
        else
          'Check for AspSmart
          err.clear
          Set AspSmart = Server.CreateObject("aspSmartImage.SmartImage")
          if err.number = 0 then
            Set AspSmartImage = nothing
            ImageComponent = "ASPSMART"
          else
            'Check for ImgWriter
            err.clear
            Set objImgWriter = Server.CreateObject("softartisans.ImageGen")
            if err.number = 0 then
              Set objImgWriter = nothing
              ImageComponent = "IMGWRITER"
            else
              'Check for AspThumb
              err.clear
              Set objAspThumb = Server.CreateObject("briz.AspThumb")
              if err.number = 0 then
                Set objAspThumb = nothing
                ImageComponent = "ASPTHUMB"
              else
              	if DetectDotNetComponent(DotNetResize) <> "" then
                	ImageComponent = "ASP.NET"
                end if
              end if
            end if
          end if
        end if
      end if
			end if
    end if
    on error goto 0
    Application("ResizeAutoComponent112") = ImageComponent
  else
	'use application var
    ImageComponent = Application("ResizeAutoComponent112")
  end if
  if ImageComponent = "" then
  	Response.Write "SMART IMAGE PROCESSOR ERROR: Can not detect any Resize Server Components!<br/>Please install at least the supplied server component. Read the online docs for more info."
  	Response.End
  end if 
  
  DetectImageComponent = ImageComponent
end function

function DetectDotNetComponent(DotNetResize)
  Dim DotNetImageComponent, ResizeComUrl, LastPath
  if Application("ResizeDotNetComponent112") = "" then
    DotNetImageComponent = ""
    ResizeComUrl = "http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("PATH_INFO")
    LastPath = InStrRev(ResizeComUrl,"/")
    if LastPath > 0 then
      ResizeComUrl = left(ResizeComUrl,Lastpath)
    end if
    ResizeComUrl = ResizeComUrl & DotNetResize
    'Response.Write ResizeComUrl & "<br/>"
    
    'Check for ASP.NET 1
    if DotNetCheckComponent("Msxml2.ServerXMLHTTP.3.0", ResizeComUrl) = true then 
		  DotNetImageComponent = "DOTNET1"
    else
		  if DotNetCheckComponent("Msxml2.ServerXMLHTTP", ResizeComUrl) = true then
        DotNetImageComponent = "DOTNET2"
			else
        if DotNetCheckComponent("Microsoft.XMLHTTP", ResizeComUrl) = true then
          DotNetImageComponent = "DOTNET3"
				else
				end if
			end if
    end if
    on error goto 0
    Application("ResizeDotNetComponent112") = DotNetImageComponent
  else 'use application var
    DotNetImageComponent = Application("ResizeDotNetComponent112")
  end if
  DetectDotNetComponent = DotNetImageComponent
end function

function DotNetCheckComponent(DotNetObj, ResizeComUrl)
  dim objHttp, Detection
	Detection = false
  on error resume next
  err.clear
	'response.write("Checking "&DotNetObj&"<br/>")
  Set objHttp = Server.CreateObject(DotNetObj)
  if err.number = 0 then
  	'response.write("Object "&DotNetObj&" created<br/>")
    objHttp.open "GET", ResizeComUrl, false
		if err.number = 0 then
      objHttp.Send ""
      if trim(objHttp.responseText) <> "" and instr(objHttp.responseText,"@ Page Language=""C#""") = 0 then
        Detection = true
      end if
		end if
    Set objHttp = nothing
  End if
  on error goto 0
 	'response.write("Detection is "&Detection&"<br/>")
  DotNetCheckComponent = Detection
end function


sub FitImage_PicProc(imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objPictureProcessor, intNewWidth, intNewHeight
  on error resume next
  Set objPictureProcessor = Server.CreateObject("COMobjects.NET.PictureProcessor")
  if err.number <> 0 then
    Response.Write "ERROR: Picture Processor Server Component is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objPictureProcessor.LoadFromFile imgFile
  objPictureProcessor.Quality = Quality
	if aspect = true then
  	calculateNewImageSize objPictureProcessor.Width, objPictureProcessor.Height, maxWidth, maxHeight, intNewWidth, intNewHeight, saveWidth, saveHeight, isNoThumb
	else
		intNewWidth = maxWidth
		intNewHeight = maxHeight
	end if
  objPictureProcessor.Resize intNewWidth, intNewHeight
  objPictureProcessor.SaveToFileAsJpeg newImgFile
  Set objPictureProcessor = nothing
end sub

sub FitImage_ShotGraph(imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objShotGraph, intNewWidth, intNewHeight, xsize, ysize
  on error resume next
  Set objShotGraph = Server.CreateObject("shotgraph.image")
  if err.number <> 0 then
    Response.Write "ERROR: ShotGraph Server Component is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objShotGraph.GetFileDimensions imgFile, xsize, ysize
	if aspect = true then
  	calculateNewImageSize xsize, ysize, maxWidth, maxHeight, intNewWidth, intNewHeight, saveWidth, saveHeight, isNoThumb
	else
		intNewWidth = maxWidth
		intNewHeight = maxHeight
	end if
	objShotGraph.CreateImage intNewWidth, intNewHeight, 8
	objShotGraph.InitClipboard xsize, ysize
	objShotGraph.SelectClipboard True
	objShotGraph.ReadImage imgFile, pal, 0, 0
	objShotGraph.Resize 0, 0, intNewWidth, intNewHeight, 0, 0, xsize, ysize, 3
	objShotGraph.SelectClipboard False
	objShotGraph.Sharpen
	objShotGraph.JpegImage quality, 0, newImgFile
  Set objShotGraph = nothing
end sub

sub FitImage_AspJpeg(imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objAspJpeg, intNewWidth, intNewHeight
  on error resume next
  Set objAspJpeg = Server.CreateObject("Persits.Jpeg")
  if err.number <> 0 then
    Response.Write "ERROR: AspJpeg Server Component is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspJpeg.Open imgFile
  objAspJpeg.Quality = Quality
	if aspect = true then
  	calculateNewImageSize objAspJpeg.OriginalWidth, objAspJpeg.OriginalHeight, maxWidth, maxHeight, intNewWidth, intNewHeight, saveWidth, saveHeight, isNoThumb
	else
		intNewWidth = maxWidth
		intNewHeight = maxHeight
	end if
  objAspJpeg.Width = intNewWidth
  objAspJpeg.Height = intNewHeight
  objAspJpeg.Save newImgFile
  Set objAspJpeg = nothing
end sub

sub FitImage_AspImage(imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objAspImage, intNewWidth, intNewHeight
  on error resume next
  Set objAspImage = Server.CreateObject("AspImage.Image")
  if err.number <> 0 then
    Response.Write "ERROR: AspImage Server Component is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspImage.LoadImage imgFile
  objAspImage.JPEGQuality = Quality
	if aspect = true then
  	calculateNewImageSize objAspImage.MaxX, objAspImage.MaxY, maxWidth, maxHeight, intNewWidth, intNewHeight, saveWidth, saveHeight, isNoThumb
	else
		intNewWidth = maxWidth
		intNewHeight = maxHeight
	end if
  objAspImage.Resize intNewWidth, intNewHeight
  objAspImage.FileName = newImgFile
  objAspImage.SaveImage
  Set objAspImage = nothing
end sub

sub FitImage_AspSmart(imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objAspSmart, intNewWidth, intNewHeight
  on error resume next
  Set objAspSmart = Server.CreateObject("aspSmartImage.SmartImage")
  if err.number <> 0 then
    Response.Write "ERROR: AspSmart Server Component is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspSmart.OpenFile CStr(imgFile)
  objAspSmart.Quality = Quality
	if aspect = true then
  	calculateNewImageSize objAspSmart.OriginalWidth, objAspSmart.OriginalHeight, maxWidth, maxHeight, intNewWidth, intNewHeight, saveWidth, saveHeight, isNoThumb
	else
		intNewWidth = maxWidth
		intNewHeight = maxHeight
	end if
  objAspSmart.Resample CInt(intNewWidth), Cint(intNewHeight)
  objAspSmart.SaveFile newImgFile
  Set objAspSmart = nothing
end sub

sub FitImage_ImgWriter(imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objImgWriter, intNewWidth, intNewHeight
  on error resume next
  Set objImgWriter = Server.CreateObject("softartisans.ImageGen")
  if err.number <> 0 then
    Response.Write "ERROR: ImgWriter Server Component is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objImgWriter.LoadImage imgFile
  objImgWriter.ImageQuality = Quality
	if aspect = true then
  	calculateNewImageSize objImgWriter.Width, objImgWriter.Height, maxWidth, maxHeight, intNewWidth, intNewHeight, saveWidth, saveHeight, isNoThumb
	else
		intNewWidth = maxWidth
		intNewHeight = maxHeight
	end if
  objImgWriter.ResizeImage intNewWidth, intNewHeight
  objImgWriter.SaveImage 0,3,newImgFile
  Set objImgWriter = nothing
end sub

sub FitImage_AspThumb(imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objAspThumb, intNewWidth, intNewHeight
  on error resume next
  Set objAspThumb = Server.CreateObject("briz.AspThumb")
  if err.number <> 0 then
    Response.Write "ERROR: ImgWriter Server Component is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  objAspThumb.Load imgFile
  objAspThumb.EncodingQuality = Quality
	if aspect = true then
  	calculateNewImageSize objAspThumb.Width, objAspThumb.Height, maxWidth, maxHeight, intNewWidth, intNewHeight, saveWidth, saveHeight, isNoThumb
	else
		intNewWidth = maxWidth
		intNewHeight = maxHeight
	end if
  objAspThumb.Resize intNewWidth, intNewHeight
  objAspThumb.Save newImgFile
  Set objAspThumb = nothing
end sub


sub FitImage_DotNet(DotNetComp, DotNetResize, imgFile,newImgFile,maxWidth,maxHeight,Quality,saveWidth,saveHeight,isNoThumb,aspect)
  Dim objHttp, objText, ResizeComUrl, ResizeParams, LastPath, newSize
	if aspect = true then
		netaspect = "true"
	else
		netaspect = "false"
	end if
  ResizeParams = "?f=" & Server.UrlEncode(imgFile) & "&nf=" & Server.UrlEncode(newImgFile) & "&w=" & maxWidth & "&h=" & maxHeight & "&q=" & Quality & "&a=" & netaspect
  ResizeComUrl = "http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("PATH_INFO")
  LastPath = InStrRev(ResizeComUrl,"/")
  if LastPath > 0 then
    ResizeComUrl = left(ResizeComUrl,Lastpath)
  end if
  ResizeComUrl = ResizeComUrl & DotNetResize & ResizeParams

  on error resume next
  set objHttp = Server.CreateObject(DotNetComp)
  if err.number <> 0 then
    Response.Write "ERROR: ASP.NET (" & DotNetComp & ") is not installed!<br/>Please select a different Server Component and try again"
    Response.End
  end if
  on error goto 0
  
  objHttp.open "GET", ResizeComUrl, false
  objHttp.Send ""
	objText = objHttp.responseText
  ' Check notification validation
  if (objHttp.status <> 200 ) then
    ' HTTP error handling
    Response.Write "HTTP ERROR: " & objHttp.status & "<br/>"
    Response.Write "Returned:<br/>" & objHttp.responseText 
    Response.End
  elseif (left(objText, 6) = "Error:") then
  	Response.Write objHttp.responseText
  	Response.End
  elseif (right(objText, 4) = "DONE") then
    if (len(objText) > 4 and instr(objText, ";") > 0) then
			newSize = split(objText, ";")
 		  if saveWidth <> "" and isNoThumb then
			  saveWidth = LCase(saveWidth)
 	      if UploadRequest.Exists(saveWidth) then
 	        if UploadRequest.Item(saveWidth).Exists("Value") then
 	          UploadRequest.Item(saveWidth).Item("Value") = newSize(0)
 	        end if  
 	      end if  
		  end if
		  if saveHeight <> "" and isNoThumb then
			  saveHeight = LCase(saveHeight)
 	      if UploadRequest.Exists(saveHeight) then
 	        if UploadRequest.Item(saveHeight).Exists("Value") then
 	          UploadRequest.Item(saveHeight).Item("Value") = newSize(1)
 	        end if  
 	      end if  
 	 	  end if
		end if
  else
    if trim(objHttp.responseText) = "" or instr(objHttp.responseText,"@ Page Language=""C#""") > 0 then
      Response.Write "DOT NET Unsupported"
      Response.End
    end if
  end if
  Set objHttp = Nothing
end sub

sub calculateNewImageSize(curWidth, curHeight, maxWidth, maxHeight, newWidth, newHeight, saveWidth, saveHeight, isNoThumb)
  if maxWidth < curWidth or maxHeight < curHeight then
    if maxWidth >= maxHeight then
      newWidth = CInt(maxHeight*(curWidth/curHeight))
      newHeight = maxHeight
    else
      newWidth = maxWidth
      newHeight = CInt(maxWidth*(curHeight/curWidth))
    end if
    if newWidth > maxWidth then
      newWidth = maxWidth
      newHeight = CInt(maxWidth*(curHeight/curWidth))
    end if
    if newHeight > maxHeight then
      newWidth = CInt(maxHeight*(curWidth/curHeight))
      newHeight = maxHeight
    end if
  else
    newWidth = curWidth
    newHeight = curHeight
  end if
	if saveWidth <> "" and isNoThumb then
		saveWidth = LCase(saveWidth)
    if UploadRequest.Exists(saveWidth) then
      if UploadRequest.Item(saveWidth).Exists("Value") then
        UploadRequest.Item(saveWidth).Item("Value") = newWidth
      end if  
    end if  
	end if
	if saveHeight <> "" and isNoThumb then
		saveHeight = LCase(saveHeight)
    if UploadRequest.Exists(saveHeight) then
      if UploadRequest.Item(saveHeight).Exists("Value") then
        UploadRequest.Item(saveHeight).Item("Value") = newHeight
      end if  
    end if  
	end if
end sub

Sub ResizeUploadedFiles(RUF_Component, RUF_DotNetResize, RUF_path, RUF_Suffix, RUF_maxWidth, RUF_maxHeight, RUF_Quality, RUF_RemoveOrig, RUF_saveWidth, RUF_saveHeight, RUF_aspect, RUF_nameConflict, RUF_ResizeFields)
  Dim RUF_keys, RUF_KeysCount, RUF_i, RUF_curKey, RUF_fileName, RUF_fso, RUF_newFileName, RUF_curPath, RUF_curName, RUF_curExt, RUF_lastPos, RUF_orgCurPath
  if RUF_path <> "" and right(RUF_path,1) <> "/" then RUF_path = RUF_path & "/"
  Set RUF_fso = CreateObject("Scripting.FileSystemObject")  
  if RUF_maxWidth <> "" then
		RUF_maxWidth = Cint(RUF_maxWidth)
	else
		RUF_maxWidth = 100000
	end if
  if RUF_maxHeight <> "" then
  	RUF_maxHeight  = Cint(RUF_maxHeight)
	else
		RUF_maxHeight = 100000
	end if
	
	if RUF_ResizeFields <> "" then
  	RUF_keys = Split(RUF_ResizeFields, ",")
  	RUF_KeysCount = UBOUND(RUF_Keys)
  else
  	RUF_keys = UploadRequest.Keys
  	RUF_KeysCount = UploadRequest.Count - 1
  end if
  
  for RUF_i = 0 to RUF_KeysCount
    RUF_curKey = Trim(LCase(RUF_keys(RUF_i)))
    if UploadRequest.Exists(RUF_curKey) then
      if UploadRequest.Item(RUF_curKey).Exists("FileName") then    
  	    if UploadRequest.Item(RUF_curKey).Item("FileName") <> "" then    
          RUF_fileName = UploadRequest.Item(RUF_curKey).Item("Value")
          if RUF_fileName <> "" then
            RUF_curPath = "" : RUF_curName = "" : RUF_curExt = ""
            RUF_lastPos = InStrRev(RUF_fileName,"/")
            if RUF_lastPos > 0 then
              RUF_curPath = mid(RUF_fileName,1,RUF_lastPos)	
              RUF_curName = mid(RUF_fileName,RUF_lastPos+1,Len(RUF_fileName)-RUF_lastPos)	
              RUF_fileName = UploadRequest.Item(RUF_curKey).Item("FileName")            
            else
              RUF_curName = RUF_fileName	
            end if
            RUF_lastPos = InStrRev(RUF_curName,".")
            if RUF_lastPos > 0 then
              RUF_curExt = mid(RUF_curName,RUF_lastPos+1,Len(RUF_curName)-RUF_lastPos)	
              RUF_curName = mid(RUF_curName,1,RUF_lastPos-1)
            end if
            RUF_curExt = LCase(RUF_curExt)
      			RUF_orgCurPath = RUF_curPath
            if RUF_curPath = "" then RUF_curPath = RUF_path
            if RUF_fso.FileExists(Server.MapPath(RUF_curPath & RUF_fileName)) then
              if RUF_curExt = "jpg" or RUF_curExt = "jpeg" or RUF_curExt = "gif" or RUF_curExt = "bmp" or RUF_curExt = "png" or RUF_curExt = "pgm" or RUF_curExt = "tga" or RUF_curExt = "tiff" or RUF_curExt = "jfif" then
                RUF_newFileName = RUF_curName & RUF_Suffix & ".jpg"
								RUF_FileExist = false
								If RUF_fso.FileExists(Server.MapPath(RUF_curPath & RUF_newFileName)) Then
									RUF_FileExist = true
								End If    
								if RUF_nameConflict = "error" and RUF_FileExist and LCase(RUF_fileName) <> LCase(RUF_newFileName) then
									Response.Write "<b>File already exists!</b><br/><br/>"
									Response.Write "Please correct and <a href=""javascript:history.back(1)"">try again</a>"
									response.End
								end if
								if ((RUF_nameConflict = "over" or RUF_nameConflict = "uniq") and RUF_FileExist) or (NOT RUF_FileExist) then
									if RUF_nameConflict = "uniq" and RUF_FileExist and LCase(RUF_fileName) <> LCase(RUF_newFileName) then
										Begin_Name_Num = 0
										while RUF_FileExist
											Begin_Name_Num = Begin_Name_Num + 1
											RUF_newFileName = RUF_curName & "_" & Begin_Name_Num & RUF_Suffix & ".jpg"
											RUF_FileExist = RUF_fso.FileExists(Server.MapPath(RUF_curPath & RUF_newFileName))
										wend
										UploadRequest.Item(RUF_curKey).Item("Value") = RUF_curPath & RUF_newFileName
									end if
									FitImage_Comp RUF_Component, RUF_DotNetResize, Server.MapPath(RUF_CurPath & RUF_fileName), Server.MapPath(RUF_curPath & RUF_newFileName), RUF_maxWidth, RUF_maxHeight, RUF_Quality, RUF_saveWidth, RUF_saveHeight, RUF_RemoveOrig, RUF_aspect
									if RUF_RemoveOrig then
										if LCase(RUF_fileName) <> LCase(RUF_newFileName) then
											RUF_fso.DeleteFile Server.MapPath(RUF_curPath & RUF_fileName)
										end if  
										if RUF_orgCurPath <> "" then
											UploadRequest.Item(RUF_curKey).Item("Value") = RUF_orgCurPath & RUF_newFileName		
										else
											UploadRequest.Item(RUF_curKey).Item("Value") = RUF_newFileName
										end if
										UploadRequest.Item(RUF_curKey).Item("FileName") = RUF_newFileName
									end if
								end if
              end if  
            end if
          end if
        end if
      end if
    end if
  next
End Sub

</SCRIPT>

[xanburzum 169]

foi mudado alguma coisa no CSS

[biakelly 0]

Nenhuma mudança Xan, na verdade utilizo este modulo a muito tempo, mas nunca tive a necessidade de enviar imagens em PNG com fundo transparente.

 

O sistema acima, aceita todos formatos de imagem, mas converte todas para jpg, até modifiquei a forma de conversão para png mas mesmo assim o thumb fica com fundo escuro quando o arquivo é enviando com fundo transparente.