UpLoad Sem Componente

[SerraVentura 0]

Seguinte, navegando pela net acabei achando uma script em um site americano naum lembro

qual...

esse script é pra fazer upload de arquivos, sem componente, até hj ele tem sido muito

util pra mim... porém cheguei em uma situação q estou tendo problemas com ele, e não

consigo resolver...

seguinte...

tenho uma pagina com checkbox onde no script ASP tento recuperar o valor desse

checkbox. O problema é q quando eu tento recuperar um checkbox e o mesmo não esta

marcado, da o seguinte erro...

 

Object required: 'Fields(...)'

/clicksom/Forms/teste.asp, line 348

 

o certo seria me retornar vazio ou NULL...

quando eu recupero o valor do checkbox marcado, eu consigo recuperar o valor

normalmente...

o problema é q dessa maneira não consigo tratar o valor vazio.

acredito q vou precisar mexer no script q achei na NET, fazer algum tratamento nele,

porém já tentei entender, já tentei debugar, já tentei de tudo e naum consigo nada...

então vim aqui pedir uma ajuda mais SENIOR da galera, pois pra mim num ta dando...rs

preparei um script simulando o problema...

 

o erro tbm pode ser por outro motivo, mas acredito q é o script mesmo...

 

se alguem puder me ajudar...

 

 

 

[color=#0000FF]<%dim oUploadset oUpload = new Upload_Classclass Upload_Class	Dim UploadSizeLimit	public Function GetUpload()	  Dim Result	  Set Result = Nothing	  If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST"		Dim CT, PosB, Boundary, Length, PosE		CT = Request.ServerVariables("HTTP_Content_Type") 'reads Content-Type header		If LCase(Left(CT, 19)) = "multipart/form-data" Then 'Content-Type header must be "multipart/form-data"		  'This is upload request.		  'Get the boundary and length from Content-Type header		  PosB = InStr(LCase(CT), "boundary=") 'Finds boundary		  If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary		  '****** Error of IE5.01 - doubbles http header		  PosB = InStr(LCase(CT), "boundary=")		  If PosB > 0 then 'Patch for the IE error			PosB = InStr(Boundary, ",")			If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)		  end if		  '****** Error of IE5.01 - doubbles http header		  Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header		  If "" & UploadSizeLimit <> "" Then			UploadSizeLimit = CLng(UploadSizeLimit)			If Length > UploadSizeLimit Then			  Request.BinaryRead (Length)			  Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length, 0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit, 0) & "B"			  Exit Function			End If		  End If		  If Length > 0 And Boundary <> "" Then 'Are there required informations about upload ?			Boundary = "--" & Boundary			Dim Head, Binary			Binary = Request.BinaryRead(Length) 'Reads binary data from client			'Retrieves the upload fields from binary data			Set Result = SeparateFields(Binary, Boundary)			Binary = Empty 'Clear variables		  Else			Err.Raise 10, "GetUpload", "Zero length request ."		  End If		Else		  Err.Raise 11, "GetUpload", "No file sent."		End If	  Else		Err.Raise 1, "GetUpload", "Bad request method."	  End If	  Set GetUpload = Result	End Function	private Function SeparateFields(Binary, Boundary)	  Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary	  Dim Fields	  Boundary = StringToBinary(Boundary)	  PosOpenBoundary = InStrB(Binary, Boundary)	  PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)	  Set Fields = CreateObject("Scripting.Dictionary")	  Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)		'Header and file/source field data		Dim HeaderContent, bFieldContent		'Header fields		Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type		'Helping variables		Dim TwoCharsAfterEndBoundary		'Get end of header		PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))		'Separates field header		HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)		'Separates field content		bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)		'Separates header fields from header		GetHeadFields BinaryToString(HeaderContent), FormFieldName, SourceFileName, Content_Disposition, Content_Type		'Create one field and assign parameters		Dim FieldContent 'Binary data of the field contents		Dim Field		'All field values.		Set Field = New clField		Set FieldContent = New clByteArray		FieldContent.ByteArray = bFieldContent		Set Field.Value = FieldContent		Field.Name = FormFieldName		Field.ContentDisposition = Content_Disposition		Field.FilePath = SourceFileName		Field.FileName = GetFileName(SourceFileName)		Field.ContentType = Content_Type		Field.Length = FieldContent.Length		Dim dField		dField = Fields(FormFieldName)		if isempty (dField) then'This is a first occurence of a source field name.		  Set Fields(FormFieldName) = Field		else'Second occurence of a source field name. This is multiselect or something similar.		  if isarray(dField) then ' There is an array of values in the dictionary field under this key. Add a new value to the array			ReDim Preserve dField(ubound(dField)+1)			Set dField(ubound(dField) - 1) = Field		  else'There is one value in the dictionary field under this key. Create an array from the old and new value.			dField = Array(dField, Field)		  end if		  Fields(FormFieldName) = dField		end if		'Is this last boundary ?		TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))		isLastBoundary = TwoCharsAfterEndBoundary = "--"		If Not isLastBoundary Then 'This is not last boundary - go to next form field.		  PosOpenBoundary = PosCloseBoundary		  PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary)		End If	  Loop	  Set SeparateFields = Fields	End Function	private Function GetHeadFields(ByVal Head, Name, FileName, Content_Disposition, Content_Type)	  'Get name of the field. Name is separated by name= and;	  Name = (SeparateField(Head, "name=", ";")) 'ltrim	  'Remove quotes (if the field name is quoted)	  If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)	  'Same for source filename	  FileName = (SeparateField(Head, "filename=", ";")) 'ltrim	  If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)	  'Separate content-disposition and content-type header fields	  Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))	  Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))	End Function	private Function SeparateField(From, ByVal sStart, ByVal sEnd)	  Dim PosB, PosE, sFrom	  sFrom = LCase(From)	  PosB = InStr(sFrom, sStart)	  If PosB > 0 Then		PosB = PosB + Len(sStart)		PosE = InStr(PosB, sFrom, sEnd)		If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)		If PosE = 0 Then PosE = Len(sFrom) + 1		SeparateField = Mid(From, PosB, PosE - PosB)	  Else		SeparateField = Empty	  End If	End Function	Private Function GetFileName(FullPath)	  Dim Pos, PosF	  PosF = 0	  For Pos = Len(FullPath) To 1 Step -1		Select Case Mid(FullPath, Pos, 1)		  Case ":", "/", "\": PosF = Pos + 1: Pos = 0		End Select	  Next	  If PosF = 0 Then PosF = 1	  GetFileName = Mid(FullPath, PosF)	End Function	Public Function BinaryToString(Binary)	  '2001 Antonin Foller, PSTRUH Software	  'Optimized version of PureASP conversion function	  'Selects the best algorithm to convert binary data to String data	  Dim TempString   	  On Error Resume Next	  'Recordset conversion has a best functionality	  TempString = RSBinaryToString(Binary)	  If Len(TempString) <> LenB(Binary) then'Conversion error		'We have to use multibyte version of BinaryToString		TempString = MBBinaryToString(Binary)	  end if	  BinaryToString = TempString	End Function	Public Function MBBinaryToString(Binary)	  '1999 Antonin Foller, PSTRUH Software	  'MultiByte version of BinaryToString function		'Optimized version of simple BinaryToString algorithm.	  dim cl1, cl2, cl3, pl1, pl2, pl3	  Dim L', nullchar	  cl1 = 1	  cl2 = 1	  cl3 = 1	  L = LenB(Binary)	  Do While cl1<=L		pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))		cl1 = cl1 + 1		cl3 = cl3 + 1		if cl3>300 then		  pl2 = pl2 & pl3		  pl3 = ""		  cl3 = 1		  cl2 = cl2 + 1		  if cl2>200 then			pl1 = pl1 & pl2			pl2 = ""			cl2 = 1		  End If		End If	  Loop	  MBBinaryToString = pl1 & pl2 & pl3	End Function	Public Function RSBinaryToString(xBinary)	  '1999 Antonin Foller, PSTRUH Software	  'This function converts binary data (VT_UI1 | VT_ARRAY or MultiByte string)		'to string (BSTR) using ADO recordset		'The fastest way - requires ADODB.Recordset		'Use this function instead of MBBinaryToString if you have ADODB.Recordset installed		'to eliminate problem with PureASP performance		Dim Binary		'MultiByte data must be converted to VT_UI1 | VT_ARRAY first.		if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary	  Dim RS, LBinary	  Const adLongVarChar = 201	  Set RS = CreateObject("ADODB.Recordset")	  LBinary = LenB(Binary)		if LBinary>0 then			RS.Fields.Append "mBinary", adLongVarChar, LBinary			RS.Open			RS.AddNew				RS("mBinary").AppendChunk Binary			RS.Update			RSBinaryToString = RS("mBinary")		Else			RSBinaryToString = ""		End If	End Function	Public Function MultiByteToBinary(MultiByte)	  ' This function converts multibyte string to real binary data (VT_UI1 | VT_ARRAY)	  ' Using recordset	  Dim RS, LMultiByte, Binary	  Const adLongVarBinary = 205	  Set RS = CreateObject("ADODB.Recordset")	  LMultiByte = LenB(MultiByte)		if LMultiByte>0 then			RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte			RS.Open			RS.AddNew				RS("mBinary").AppendChunk MultiByte & ChrB(0)			RS.Update			Binary = RS("mBinary").GetChunk(LMultiByte)		End If	  MultiByteToBinary = Binary	End Function	Public Function StringToBinary(String)	  Dim I, B	  For I=1 to len(String)		B = B & ChrB(Asc(Mid(String,I,1)))	  Next	  StringToBinary = B	End Function	Public Function BinaryToStringSimple(Binary)	  'Multibyte conversion idea.	  'not used.	  Dim I, S	  For I = 1 To LenB(Binary)		S = S & Chr(AscB(MidB(Binary, I, 1)))	  Next	  BinaryToStringSimple = S	End Function	Public Function SaveBinaryData(FileName, ByteArray)	  Dim FS : Set FS = CreateObject("Scripting.FileSystemObject")	  Dim TextStream : Set TextStream = FS.CreateTextFile(FileName)		TextStream.Write BinaryToString(ByteArray) 'BinaryToString is in upload.inc.	  TextStream.Close	End Function	Public Function CheckRequirements()	  Dim Msg	  Msg = "<br><b>This script requires some default VBS objects installed to run properly.</b><br>" & vbCrLf	  Msg = Msg & CheckOneObject("ADODB.Recordset")	  Msg = Msg & CheckOneObject("Scripting.FileSystemObject")	  Msg = Msg & CheckOneObject("Scripting.Dictionary")	  CheckRequirements = Msg	'  MsgBox Msg	End Function	Public Function CheckOneObject(oClass)	  Dim Msg	  On Error Resume Next	  CreateObject oClass	  If Err = 0 Then Msg = "OK" Else Msg = "Error:" & Err.Description	  CheckOneObject = oClass & " - " & Msg & "<br>" & vbCrLf	End Functionend classClass clByteArray  'Stored bytearray.  public ByteArray  Public Default Property Get ba	ba = ByteArray  End Property     'Returns length of source binary data  public Property Get Length	Length = LenB(ByteArray)  End Property     'Returns length of source binary data  public Property Get String	String = oUpload.BinaryToString(ByteArray)  End Property     'Stores the binary data to a file.  Public Function SaveAs(FileName)	oUpload.SaveBinaryData FileName, ByteArray  End FunctionEnd ClassClass clField  Public Name, ContentDisposition, FileName, FilePath, ContentType, Value, Length  Public Default Property Get n	n = Name  End PropertyEnd Class%><%Set Fields = oUpload.GetUploadif Fields("ispostback").Value.String = "s" then	response.Write(Fields("xxx0").Value.String)	response.End()end if%><form action="" method="post" enctype="multipart/form-data" name="frm"><input type="text" value="s" name="ispostback" id="ispostback">	<table border="0" width="100%">			<tr>					<td><input name="xxx0"  type="checkbox" value="xxx0" />xxx0</td>					<td><input name="xxx1"  type="checkbox" value="xxx1" />xxx1</td>					<td><input name="xxx2"  type="checkbox" value="xxx2" />xxx2</td>			</tr>		</table>		<input type="submit" value="Enviar"></form>[/color]

[SerraVentura 0]

alguém tem idéia do q pode ser ???