Upload s/ componte

[thiagocs 0]

Alguém tem um código de upload de vários arquivos sem componentes e que de preferência dê para alterar o nome dos arquivos.

 

É URGENTE !!!

[WebASP 0]

Isso ira te ajudar

 

http://www.freeaspupload.net/

[Maximum2003 0]

Isso ira te ajudarhttp://www.freeaspupload.net/

Tem algum modo, utilizando o FreeaspUpload, de recuperar dados de outros campos do mesmo formulário em que é feito o upload.Como vocês devem saber o Request.BinaryRead não suporta outros request.form após sua execução... Estou desesperado!!! Por favor alguém ae....

[Mário Monteiro 179]

tenta pegar com o nome do objetoUpload.form em vez de request.form

[Maximum2003 0]

tenta pegar com o nome do objetoUpload.form em vez de request.form

Não deu... e agora cara?? Meu Deus, me ajudem...

[Mário Monteiro 179]

o nome é esse mesmo??? objetoUpload???

[Maximum2003 0]

o nome é esse mesmo??? objetoUpload???

Não tentei com todos os objetos que são abertos... Segue cópia do código:

Class FreeASPUpload	Public UploadedFiles	Public FormElements	Private VarArrayBinRequest	Private StreamRequest	Private uploadedYet	Private Sub Class_Initialize()  Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")  Set FormElements = Server.CreateObject("Scripting.Dictionary")  Set StreamRequest = Server.CreateObject("ADODB.Stream")  StreamRequest.Type = 1 'adTypeBinary  StreamRequest.Open  uploadedYet = false	End Sub		Private Sub Class_Terminate()  If IsObject(UploadedFiles) Then 	 UploadedFiles.RemoveAll() 	 Set UploadedFiles = Nothing  End If  If IsObject(FormElements) Then 	 FormElements.RemoveAll() 	 Set FormElements = Nothing  End If  StreamRequest.Close  Set StreamRequest = Nothing	End Sub	Public Property Get Form(sIndex)  Form = ""  If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))	End Property	Public Property Get Files()  Files = UploadedFiles.Items	End Property	'Calls Upload to extract the data from the binary request and then saves the uploaded files	Public Sub Save(path)  Dim streamFile, fileItem  if Right(path, 1) <> "\" then path = path & "\"  if not uploadedYet then Upload  vnXX = 0  vnContadorRegistros = 0  For Each fileItem In UploadedFiles.Items 	 Set streamFile = Server.CreateObject("ADODB.Stream") 	 streamFile.Type = 1 	 streamFile.Open 	 StreamRequest.Position=fileItem.Start 	 fsTela(StreamRequest.Position) 	 StreamRequest.CopyTo streamFile, fileItem.Length 	 vsNomeArquivo = fileItem.FileName 	 vsNomeArquivo = fsRemoverIlegais(vsNomeArquivo) 	 vsNomeArquivo = fsRemoverAcentos(vsNomeArquivo) 	 streamFile.SaveToFile path & vsNomeArquivo, 2 	 streamFile.close 	 Set streamFile = Nothing 	 fileItem.Path = path & vsNomeArquivo 	 'If vnContadorRegistros Mod 2 = 1 Then 	 '	vsURLFoto = fileItem.Path 	 'Else 	 '	vsURLThumbNail = fileItem.Path 	 '	If vsCortaEspacos(vsURLFoto) <> "" And vsCortaEspacos(vsURLThumbNail) <> "" Then 	 '  ' Coloque o insert aqui. 	 '	Else 	 '  If vsCortaEspacos(vsURLFoto) <> "" And vsCortaEspacos(vsURLThumbNail) <> "" Then 	 '	End If 	 'End If 	 vnContadorRegistros = vnContadorRegistros + 1 	 'fsTela(vnContadorRegistros)   Next	End Sub	Public Function SaveBinRequest(path) ' For debugging purposes  StreamRequest.SaveToFile path & "\debugStream.bin", 2	End Function	Public Sub DumpData() 'only works if files are plain text  Dim i, aKeys, f  response.write "Form Items:<br>"  aKeys = FormElements.Keys  For i = 0 To FormElements.Count -1 ' Iterate the array 	 response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"  Next  response.write "Uploaded Files:<br>"  For Each f In UploadedFiles.Items 	 response.write "Name: " & f.FileName & "<br>" 	 response.write "Type: " & f.ContentType & "<br>" 	 response.write "Start: " & f.Start & "<br>" 	 response.write "Size: " & f.Length & "<br>"   Next    End Sub	Private Sub Upload()  Dim nCurPos, nDataBoundPos, nLastSepPos  Dim nPosFile, nPosBound  Dim sFieldName, osPathSep, auxStr  'RFC1867 Tokens  Dim vDataSep  Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType  tNewLine = Byte2String(Chr(13))  tDoubleQuotes = Byte2String(Chr(34))  tTerm = Byte2String("--")  tFilename = Byte2String("filename=""")  tName = Byte2String("name=""")  tContentDisp = Byte2String("Content-Disposition")  tContentType = Byte2String("Content-Type:")  uploadedYet = true  on error resume next  VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)  if Err.Number <> 0 then  	 response.write "<br><br><B>System reported this error:</B><p>" 	 response.write Err.Description & "<p>" 	 Exit Sub  end if  on error goto 0 'reset error handling  nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)  If nCurPos <= 1  Then Exit Sub     'vDataSep is a separator like -----------------------------21763138716045  vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)  'Start of current separator  nDataBoundPos = 1  'Beginning of last line  nLastSepPos = FindToken(vDataSep & tTerm, 1)  Do Until nDataBoundPos = nLastSepPos 	  	 nCurPos = SkipToken(tContentDisp, nDataBoundPos) 	 nCurPos = SkipToken(tName, nCurPos) 	 sFieldName = ExtractField(tDoubleQuotes, nCurPos) 	 nPosFile = FindToken(tFilename, nCurPos) 	 nPosBound = FindToken(vDataSep, nCurPos) 	  	 If nPosFile <> 0 And  nPosFile < nPosBound Then    Dim oUploadFile    Set oUploadFile = New UploadedFile        nCurPos = SkipToken(tFilename, nCurPos)    auxStr = ExtractField(tDoubleQuotes, nCurPos)                ' We are interested only in the name of the file, not the whole path                ' Path separator is \ in windows, / in UNIX                ' While IE seems to put the whole pathname in the stream, Mozilla seem to                 ' only put the actual file name, so UNIX paths may be rare. But not impossible.                osPathSep = "\"                if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"    oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))    if (Len(oUploadFile.FileName) > 0) then 'File field not left empty   	 nCurPos = SkipToken(tContentType, nCurPos)   	                     auxStr = ExtractField(tNewLine, nCurPos)                    ' NN on UNIX puts things like this in the streaa:                    '    ?? python py type=?? python application/x-python   	 oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))   	 nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line   	    	 oUploadFile.Start = nCurPos-1   	 oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos   	    	 If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile    End If 	 Else    Dim nEndOfData    nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line    nEndOfData = FindToken(vDataSep, nCurPos) - 2    If Not FormElements.Exists(LCase(sFieldName)) Then FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) 	 End If 	 'Advance to next separator 	 nDataBoundPos = FindToken(vDataSep, nCurPos)  Loop  StreamRequest.Write(VarArrayBinRequest)	End Sub	Private Function SkipToken(sToken, nStart)  SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)  If SkipToken = 0 then 	 Response.write "Error in parsing uploaded binary request." 	 Response.End  end if  SkipToken = SkipToken + LenB(sToken)	End Function	Private Function FindToken(sToken, nStart)  FindToken = InstrB(nStart, VarArrayBinRequest, sToken)	End Function	Private Function ExtractField(sToken, nStart)  Dim nEnd  nEnd = InstrB(nStart, VarArrayBinRequest, sToken)  If nEnd = 0 then 	 Response.write "Error in parsing uploaded binary request." 	 Response.End  end if  ExtractField = String2Byte(MidB(VarArrayBinRequest, nStart, nEnd-nStart))	End Function	'String to byte string conversion	Private Function Byte2String(sString)  Dim i  For i = 1 to Len(sString)     Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)))  Next	End Function	'Byte string to string conversion	Private Function String2Byte(bsString)  Dim i  String2Byte =""  For i = 1 to LenB(bsString)     String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1)))   Next	End FunctionEnd ClassClass UploadedFile	Public ContentType	Public Start	Public Length	Public Path	Private nameOfFile    ' Need to remove characters that are valid in UNIX, but not in Windows    Public Property Let FileName(fN)        nameOfFile = fN        nameOfFile = SubstNoReg(nameOfFile, "\", "_")        nameOfFile = SubstNoReg(nameOfFile, "/", "_")        nameOfFile = SubstNoReg(nameOfFile, ":", "_")        nameOfFile = SubstNoReg(nameOfFile, "*", "_")        nameOfFile = SubstNoReg(nameOfFile, "?", "_")        nameOfFile = SubstNoReg(nameOfFile, """", "_")        nameOfFile = SubstNoReg(nameOfFile, "<", "_")        nameOfFile = SubstNoReg(nameOfFile, ">", "_")        nameOfFile = SubstNoReg(nameOfFile, "|", "_")    End Property    Public Property Get FileName()        FileName = nameOfFile    End Property    'Public Property Get FileN()ameEnd Class' Does not depend on RegEx, which is not available on older VBScript' Is not recursive, which means it will not run out of stack spaceFunction SubstNoReg(initialStr, oldStr, newStr)    Dim currentPos, oldStrPos, skip    If IsNull(initialStr) Or Len(initialStr) = 0 Then        SubstNoReg = ""    ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then        SubstNoReg = initialStr    Else        If IsNull(newStr) Then newStr = ""        currentPos = 1        oldStrPos = 0        SubstNoReg = ""        skip = Len(oldStr)        Do While currentPos <= Len(initialStr)            oldStrPos = InStr(currentPos, initialStr, oldStr)            If oldStrPos = 0 Then                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)                currentPos = Len(initialStr) + 1            Else                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr                currentPos = oldStrPos + skip            End If        Loop    End IfEnd Function

[Mário Monteiro 179]

não cara... esta é a classe que você tem que incluir na pagina de upload...Qual o codigo da page que esta fazendo upload???

[Mário Monteiro 179]

já respondi no outro topico que criou, usa mesmo o nome do objeto.form("campo") funciona...//Não usa o botão reportar sem necessidade...