Tamanho da foto

[Robson Martins 1]

Ola bom dia

Gostaria de uma ajuda com este codigo de uplond de imagens eu gostaria de poder mandar as fotos com varios tamanho e ai na hora do uplond o tamanho em 800 por 600 este aqui e os codigos que eu estou usando.

 

Eu não sei como fazer isto

 

 

<%

id = Request("imob_Referencia")

Sub BuildUploadRequest(RequestBin)

	PosBeg = 1

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

	boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)

	boundaryPos = InstrB(1,RequestBin,boundary)

	Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))

		Dim UploadControl

		Set UploadControl = CreateObject("Scripting.Dictionary")

		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)

		If  PosFile<>0 AND (PosFile<PosBound) Then

			PosBeg = PosFile + 10

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

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

			UploadControl.Add "FileName", FileName

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

			PosBeg = Pos+14

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

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

			UploadControl.Add "ContentType",ContentType

			PosBeg = PosEnd+4

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

			Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)

		Else

			Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))

			PosBeg = Pos+4

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

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

		End If

	UploadControl.Add "Value" , Value	

	UploadRequest.Add name, UploadControl	

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

	Loop



End Sub



Function getByteString(StringStr)

 For i = 1 to Len(StringStr)

 	char = Mid(StringStr,i,1)

	getByteString = getByteString & chrB(AscB(char))

 Next

End Function



Function getString(StringBin)

 getString =""

 For intCount = 1 to LenB(StringBin)

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

 Next

End Function



strFolder = endereco_fisico & "imagens/produtos/" & Request("id") & "/"



Set objFS = Server.CreateObject("Scripting.FileSystemObject")

If Not objFS.FolderExists(strFolder) Then

  objFS.CreateFolder(strFolder)

End if



If Request("enviar") <> "" Then

  Set objFS = Nothing

  byteCount = Request.TotalBytes

  RequestBin = Request.BinaryRead(byteCount)

  Dim UploadRequest

  Set UploadRequest = CreateObject("Scripting.Dictionary")

  BuildUploadRequest  RequestBin

  contentType = UploadRequest.Item("blob").Item("ContentType")

  filepathname = UploadRequest.Item("blob").Item("FileName")

  filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))

  value = UploadRequest.Item("blob").Item("Value")

  If Lcase(Right(filename,3)) = "jpg" Or Lcase(Right(filename,3)) = "gif" Or Lcase(Right(filename,3)) = "png" then

    Set objFS = Server.CreateObject("Scripting.FileSystemObject")

	If objFS.FileExists( strFolder & filename) Then

	

%>

[Vinicius Ianni 189]

Você quer que as imagens após o upload sejam exibidas em 800x600?

se for isso, acho mais fácil no seu caso usar o attributo width e heigth da tag img no html

Pelo que olhei por alto nesse código é um script classico de upload com restrição para formato de arquivo.

Talvez para fazer o que você deseja, uma saida seja usar o fso.

O problema é que ao redimensionar imagens de tamanho menor para um maior, a qualidade da imagen é degradada.

[Mário Monteiro 179]

o seu código já faz algum tipo de redimensionamento?

[xanburzum 169]

você pode fazer isso aterarndo dinamicamente os atributos width e heigth da tag img , ou usar componentes que fazem isso.