Enviar Arquivos Sem Componentes

[DELPHI-Man32]

TEM COMO ENVIAR ARQUIVOS PARA UMA PASTA NO SERVIDOR SEM O USO SE COMPONENTE DE UPLOAD?

[ViniciusJau]

upload.asp

<%

Sub BuildUploadRequest(RequestBin)

'Limite inferior

PosBeg = 1

'procura pela posição dentro de uma variável contendo bytes

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

'o mesmo que MID, mas para bytes

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

boundaryPos = InstrB(1,RequestBin,boundary)

'Obtém todos os dados dentro do limite

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

 

  'Variáveis objeto são colocado em um  objeto dicionário

  Dim UploadControl

  Set UploadControl = CreateObject("Scripting.Dictionary") 'cria um dicionário

  'Pega o nome de cada objeto do form anteriro

  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)

  'Verifica se o item é um arquivo

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

  

   'Pega o nome,content-type e o conteúdo do arquivo

   PosBeg = PosFile + 10

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

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

  

   'adiciona o nome do arquivo ao dicionário

   UploadControl.Add "FileName", FileName

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

   PosBeg = Pos+14

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

  

   'adiciona o content-type ao dicionário

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

   UploadControl.Add "ContentType",ContentType

  

   'Pega o conteúdo do arquivo

   PosBeg = PosEnd+4

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

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

  Else

  

   'conteúdo do objeto

   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

 

  'adiciona o conteúdo ao objeto dicionário

  UploadControl.Add "Value" , Value

 

  'adiciona o objeto dicionário ao dicionário principa;

  UploadRequest.Add name, UploadControl

 

  'próximo objeto

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

Loop

End Sub

'Converte de string para byte

Function getByteString(StringStr)

For i = 1 to Len(StringStr)

  char = Mid(StringStr,i,1)

getByteString = getByteString & chrB(AscB(char))

Next

End Function

'converte de byte para string

Function getString(StringBin)

getString =""

For intCount = 1 to LenB(StringBin)

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

Next

End Function

%>

binaryOutputClient.asp

<%

Response.Buffer = TRUE

Response.Clear

byteCount = Request.TotalBytes

RequestBin = Request.BinaryRead(byteCount)

Dim UploadRequest

Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest  RequestBin

email = UploadRequest.Item("email").Item("Value")

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

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

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

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

Response.ContentType = contentType

Response.binaryWrite picture

%>

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

outputClient.asp

<%

Response.Buffer = TRUE

Response.Clear

byteCount = Request.TotalBytes

RequestBin = Request.BinaryRead(byteCount)

Dim UploadRequest

Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest  RequestBin

email = UploadRequest.Item("email").Item("Value")

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

%>

Your email is : <%= email %><BR>

File name of you picture is <%=filepathname%><BR>

File type of your picture is <%=contentType%><BR>

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

outputFile.asp

<%

Response.Expires=0

Response.Buffer = TRUE

Response.Clear

'Response.BinaryWrite(Request.BinaryRead(Request.TotalBytes))

byteCount = Request.TotalBytes

'Response.BinaryWrite(Request.BinaryRead(varByteCount))

RequestBin = Request.BinaryRead(byteCount)

Dim UploadRequest

Set UploadRequest = CreateObject("Scripting.Dictionary")

'chama a função para baixar o arquivo

BuildUploadRequest  RequestBin

email = UploadRequest.Item("email").Item("Value")

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

'AQUI É O SERVEROBJECT PARA TRATAR ARQUIVOS TEXTO!!!!!

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

'Cria e preenche o arquivo com os dados enviados

pathEnd = Len(Server.mappath(Request.ServerVariables("PATH_INFO")))-14

dim strLogPath

dim pos

pos = instrRev(Request.ServerVariables("PATH_INFO"),"/",-1)

strLogPath = left(Request.ServerVariables("PATH_INFO"),pos)

dim strpath

strPath = Request.ServerVariables("SERVER_NAME")  & strLogpath

Set MyFile = ScriptObject.CreateTextFile(Left(Server.mappath(Request.ServerVariables("PATH_INFO")),pathEnd)&"uploaded"&filename)

For i = 1 to LenB(value)

  MyFile.Write chr(AscB(MidB(value,i,1)))

Next

MyFile.Close

%>

<b>Uploaded file : </b><%="uploaded"&filename%><BR>

<!--img src="<%="uploaded"&filename%>"-->

<a href="file://<%=strPath&"uploaded"&filename%>"><%=filename%></a>

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

uploadedcsv.asp

<%

strFile = "tete"

Set fs = CreateObject("Scripting.FileSystemObject")

Set a = fs.CreateTextFile(server.MapPath(".") & "\" & strFile & ".csv",True)

strtext = chr(34) &"Year" &  chr(34) & ","

strtext = strtext & chr(34) & "Region" & chr(34) & ","

strtext = strtext & chr(34) & "Sales" & chr(34) & ","

a.WriteLine(strtext)

for j = 0 to 5

  For i = 0 To j

  strtext = chr(34) & i & chr(34) &  ","

  a.Write(strtext)

  Next

  a.Writeline()

 

next

a.Close

Set fs=Nothing   

Response.Write("Click <A HREF=" & strFile & ".csv>Here<A> to get CSV file") %>

upload.form

<HTML>

<HEAD>

<TITLE>Upload Form</TITLE>

</HEAD>

<BODY>

<B>Output to client</b>

<FORM METHOD="Post" ENCTYPE="multipart/form-data" ACTION="outputClient.asp">

Email : <INPUT TYPE="Text" NAME="email" VALUE="vinicius@garagem69.com.br"><BR>

  foto :

  <INPUT TYPE="file" NAME="blob"><BR>

<INPUT TYPE="submit" NAME="Enter">

</FORM>

<B>Binary output to client</b>

<FORM METHOD="Post" ENCTYPE="multipart/form-data" ACTION="binaryOutputClient.asp">

Email : <INPUT TYPE="Text" NAME="email" VALUE="vinicius@garagem69.com.br"><BR>

  foto :

  <INPUT TYPE="file" NAME="blob"><BR>

<INPUT TYPE="submit" NAME="Enter">

</FORM>

<B>Output to file system</b>

<FORM METHOD="Post" ENCTYPE="multipart/form-data" ACTION="outputFile.asp">

Email : <INPUT TYPE="Text" NAME="email" VALUE="vinicius@garagem69.com.br"><BR>

  Pfotoe :

  <INPUT TYPE="file" NAME="blob"><BR>

<INPUT TYPE="submit" NAME="Enter">

</FORM>

</BODY>

</HTML>

[bareta]

putz... no tópico de funções tem um mais simples.... que faz isso....

http://scriptbrasil.com.br/forum/index.php...indpost&p=99768

[dark0]

é.. no tópico de funcoes tem um exemplo..