* Me Ajudem ! Upload Sem Componente !

[lidiorj]

]

Alô Pessoal !!! Estou com uma dúvida e há 3 dias não consigo decifrar o Código Asp para fazer Upload de Arquivos.

Minha Intenção é utilizar o Código Asp sem Componentes, até porque trabalho em uma empresa onde determinados Softwares são proibidos para Instalação.

Já pesquisei em todos os Sites possíveis este Código, mas não consegui um que fizesse com que um arquivo fizesse upload sem utilizar componentes.

Desde já Agradeço a ajuda de todos!

Valeu!

Lidio

[dark0]

Amigo.. creio que não seja possivel fazer o que você quer: Upload sem componente!

Pelas informações que eu tenho, não deve ser possivel.

Mas vou fazer umas buscas aqui.. se encontrar algo.. postarei.

Abraços

[mariofdf]

já testei alguns códigos, mas não consegui fazer funcionar, te aconselho a usar um componente free.

[--Ludson--]

Ae galera, eu achei um sistema de upload sem componentes, e funcionou perfeitamente no meu PSW.

Sei que você são contra postar códigos prontos nos fóruns, mas achu q num da nada, porque não fui eu q fiz o código, eu baixei de algum lugar, mas não lembro de onde, mas no código tem o link do autor e os Direitos Reservados.

bom são duas páginas, uma com os formulários para fazer o upload e outra com o script para carregar o arquivo para a pasta desejada, aí vai:

página: formulario.asp

<%@ Language=VBScript %>

<%

option explicit

Response.Expires = -1

Server.ScriptTimeout = 600

%>

<!-- #include file="freeaspupload.asp" -->

<%

' ****************************************************

' Change the value of the variable below to the pathname

' of a directory with write permissions, for example "C:\Inetpub\wwwroot"

Dim uploadsDirVar

uploadsDirVar = "D:\pasta\codigos e tutoriais\Códigos\ASP\Sistema de Upload\"

' ****************************************************

' Note: this file uploadTester.asp is just an example to demonstrate

' the capabilities of the freeASPUpload.asp class. There are no plans

' to add any new features to uploadTester.asp itself. Feel free to add

' your own code. If you are building a content management system, you

' may also want to consider this script: http://www.webfilebrowser.com/

function OutputForm()

%>

<form name="frmSend" method="POST" enctype="multipart/form-data" action="uploadTester.asp" onSubmit="return onSubmitForm();">

File 1: <input name=attach1 type=file size=35><br>

File 2: <input name=attach2 type=file size=35><br>

File 3: <input name=attach3 type=file size=35><br>

File 4: <input name=attach4 type=file size=35><br>

<br>

<input style="margin-top:4" type=submit value="Upload">

</form>

<%

end function

function TestEnvironment()

Dim fso, fileName, testFile, streamTest

TestEnvironment = ""

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

if not fso.FolderExists(uploadsDirVar) then

TestEnvironment = "<B>Folder " & uploadsDirVar & " does not exist.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."

exit function

end if

fileName = uploadsDirVar & "\test.txt"

on error resume next

Set testFile = fso.CreateTextFile(fileName, true)

If Err.Number<>0 then

TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."

exit function

end if

Err.Clear

testFile.Close

fso.DeleteFile(fileName)

If Err.Number<>0 then

TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have delete permissions</B>, although it does have write permissions.<br>Change the permissions for IUSR_<I>computername</I> on this folder."

exit function

end if

Err.Clear

Set streamTest = Server.CreateObject("ADODB.Stream")

If Err.Number<>0 then

TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."

exit function

end if

Set streamTest = Nothing

end function

function SaveFiles

Dim Upload, fileName, fileSize, ks, i, fileKey

Set Upload = New FreeASPUpload

Upload.Save(uploadsDirVar)

SaveFiles = ""

ks = Upload.UploadedFiles.keys

if (UBound(ks) <> -1) then

SaveFiles = "<B>Files uploaded:</B> "

for each fileKey in Upload.UploadedFiles.keys

SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "

next

else

SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."

end if

end function

%>

<HTML>

<HEAD>

<TITLE>Test Free ASP Upload</TITLE>

<style>

BODY {background-color: white;font-family:arial; font-size:12}

</style>

<script>

function onSubmitForm() {

var formDOMObj = document.frmSend;

if (formDOMObj.attach1.value == "" && formDOMObj.attach2.value == "" && formDOMObj.attach3.value == "" && formDOMObj.attach4.value == "" )

alert("Please press the browse button and pick a file.")

else

return true;

return false;

}

</script>

</HEAD>

<BODY>

<br><br>

<div style="border-bottom: #A91905 2px solid;font-size:16">Upload files to your server</div>

<%

Dim diagnostics

if Request.ServerVariables("REQUEST_METHOD") <> "POST" then

diagnostics = TestEnvironment()

if diagnostics<>"" then

response.write "<div style=""margin-left:20; margin-top:30; margin-right:30; margin-bottom:30;"">"

response.write diagnostics

response.write "<p>After you correct this problem, reload the page."

response.write "</div>"

else

response.write "<div style=""margin-left:150"">"

OutputForm()

response.write "</div>"

end if

else

response.write "<div style=""margin-left:150"">"

OutputForm()

response.write SaveFiles()

response.write "<br><br></div>"

end if

%>

<div style="border-top: #A91905 2px solid;font-size:10">Powered by <A HREF="http://www.freeaspupload.net/" style="color:black">Free ASP Upload</A></div>

</BODY>

</HTML>

página: freeASPupload.asp

<%

' For examples, documentation, and your own free copy, go to:

' http://www.freeaspupload.net

' Note: You can copy and use this script for free and you can make changes

' to the code, but you cannot remove the above comment.

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

For Each fileItem In UploadedFiles.Items

Set streamFile = Server.CreateObject("ADODB.Stream")

streamFile.Type = 1

streamFile.Open

StreamRequest.Position=fileItem.Start

StreamRequest.CopyTo streamFile, fileItem.Length

streamFile.SaveToFile path & fileItem.FileName, 2

streamFile.close

Set streamFile = Nothing

fileItem.Path = path & fileItem.FileName

Next

End Sub

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

'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

VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)

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, sFileName

Set oUploadFile = New UploadedFile

nCurPos = SkipToken(tFilename, nCurPos)

sFileName = ExtractField(tDoubleQuotes, nCurPos)

oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))

if (Len(oUploadFile.FileName) > 0) then 'File field not left empy

nCurPos = SkipToken(tContentType, nCurPos)

oUploadFile.ContentType = ExtractField(tNewLine, nCurPos)

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

Public Function SaveBinRequest(path) ' For debugging purposes

StreamRequest.SaveToFile path & "debugStream.bin", 2

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 Function

End Class

Class UploadedFile

Public ContentType

Public FileName

Public Start

Public Length

Public Path

End Class

%>

Ta aí galera, tipo, no meu pc funciono muito bem, espero ter ajudado!!!!!!

Flows!

[--Ludson--]

tipo, coloquei o arquivo zipado pra download, se preferir vai ser mais fácil de usar e aprender:

http://www.otaw.cjb.net//sisupload.zip

Qualque coisa tamu aí.

[dark0]

Ludson, poste isso em funções..

Lá é a área do Códigos!

Assim, fica mais organizado!

Abraços

[--Ludson--]

Ludson, poste isso em funções..

Lá é a área do Códigos!

Assim, fica mais organizado!

Abraços

beleza vo posta lá