Como limitar o tamanho em KB de uma imagem

[Fácil Buscar 0]

O sistema é desenvolvido em pure asp load ao que percebo.

 

Está funcionando perfeitamente, envia multiplos arquivos, mas eu quero limitar o tamanho de uma imagem por exemplo e não estou conseguindo. Gostaria muito de poder contar com a ajuda de vcs.

 

Vou colocar um pouco do código para análise!

 

<%

'*** File Upload to: images, Extensions: "GIF,JPG,JPEG,BMP,PNG", Form: NEWAD, Redirect: ""

'*** Pure ASP File Upload -----------------------------------------------------

 

 

Sub BuildUploadRequest(RequestBin)

'Get the boundary

PosBeg = 1

PosEnd = InstrB(PosBeg,RequestBin,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 the form attributes and try again."

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 & 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,getByteString("Content-Disposition"))

Pos = InstrB(Pos,RequestBin,getByteString("name="))

PosBeg = Pos+6

PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))

Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))

PosFile = InstrB(BoundaryPos,RequestBin,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,getByteString(chr(34)))

FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))

FileName = Mid(FileName,InStrRev(FileName,"\")+1)

'Add filename to dictionary object

UploadControl.Add "FileName", FileName

Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))

PosBeg = Pos+14

PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))

'Add content-type to dictionary object

ContentType = 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,getByteString(chr(13)))

PosBeg = Pos+4

PosEnd = InstrB(PosBeg,RequestBin,boundary)-2

Value = 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

UploadRequest.Add name, UploadControl

'Loop to next object

BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)

Loop

End Sub

 

'String to byte string conversion

Function getByteString(StringStr)

For i = 1 to Len(StringStr)

char = Mid(StringStr,i,1)

getByteString = getByteString & chrB(AscB(char))

Next

End Function

 

'Byte string to string conversion

Function getString(StringBin)

getString =""

For intCount = 1 to LenB(StringBin)

getString = getString & chr(AscB(MidB(StringBin,intCount,1)))

Next

End Function

 

Function UploadFormRequest(name)

on error resume next

if UploadRequest.Item(name) then

UploadFormRequest = UploadRequest.Item(name).Item("Value")

end if

End Function

 

'Process the upload

 

UploadQueryString = Replace(Request.QueryString,"GP_upload=true","")

if mid(UploadQueryString,1,1) = "&" then

UploadQueryString = Mid(UploadQueryString,2)

end if

 

GP_uploadAction = CStr(Request.ServerVariables("URL")) & "?GP_upload=true"

If (Request.QueryString <> "") Then

if UploadQueryString <> "" then

GP_uploadAction = GP_uploadAction & "&" & UploadQueryString

end if

End If

 

If (CStr(Request.QueryString("GP_upload")) <> "") Then

GP_redirectPage = ""

If (GP_redirectPage = "") Then

GP_redirectPage = CStr(Request.ServerVariables("URL"))

end if

 

RequestBin = Request.BinaryRead(Request.TotalBytes)

Dim UploadRequest

Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest RequestBin

 

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")

 

if GP_valueLen = 0 then

Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"

Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br>"

Response.Write "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_curPath = Request.ServerVariables("PATH_INFO")

GP_curPath = Trim(Mid(GP_curPath,1,InStrRev(GP_curPath,"/")) & "images")

if Mid(GP_curPath,Len(GP_curPath),1) <> "/" then

GP_curPath = GP_curPath & "/"

end if

on error resume next

GP_strm2.SaveToFile Trim(Server.mappath(GP_curPath))& "\" & UploadRequest.Item(GP_curKey).Item("FileName"),2

if err then

Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"

Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br>"

Response.Write "Maybe the destination directory does not exist, or you don't have write permission.<br>"

Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"

err.clear

response.End

end if

end if

next

 

'*** GP NO REDIRECT

end if

if UploadQueryString <> "" then

UploadQueryString = UploadQueryString & "&GP_upload=true"

else

UploadQueryString = "GP_upload=true"

end if

 

%>

<%

' *** Edit Operations: (Modified for File Upload) declare variables

 

MM_editAction = CStr(Request.ServerVariables("URL")) 'MM_editAction = CStr(Request("URL"))

If (UploadQueryString <> "") Then

MM_editAction = MM_editAction & "?" & UploadQueryString

End If

 

' boolean to abort record edit

MM_abortEdit = false

 

' query string to execute

MM_editQuery = ""

%>

[xanburzum 169]

existe um exemplo no lab. de script que postei, onde nele você pode especificar o tamanho dos arquivos, inclusive limitar o tipo de arquivo, se irá aceitar apenas jpg,gif,png etc