Upload De Imagens

Março 25, 2004

Trabalho com dreamweaver utilizando ASP. Eu preciso de fazer uma página que faça upload de imagens p/ um banco de dados(Access) ou p/ uma pasta. como devo proceder?

Obrigado e aguardo ociosamente.

diraol · Março 25, 2004

fernando.....

primeiro... você aguarda ociosamente (parado) ou anciosamente?? hehehe

você vai fazer + ou - assim...

você faz o upload pra uma pasta do seu server e dpois você grava o caminho da imagem no banco de dados..............

Só mudar a extenção dos arquivos este esta aceitando só .zip e txt

upload.asp

<html>
<head>
<title>Transferencia de Arquivos</title>
</head>
<body>
<script type="text/javascript">
function ChecaExtensaoArquivo( formulario ){
var extensoesOk = ",.zip,.txt,";
var extensao = "," + formulario.arquivo.value.substr( formulario.arquivo.value.length - 4 ).toLowerCase() + ",";
if( extensoesOk.indexOf( extensao ) == -1 ){
alert( formulario.arquivo.value + "\nnão possui uma extensão válida,\nACEITOS SOMENTE .zip OU .txt " );
return false;
}
return true;
}
</script>
<form name="form" method="post" ENCTYPE="multipart/form-data" onsubmit="return ChecaExtensaoArquivo( this )">
File : <input type="file" name="arquivo" size="20"><br>
<input type="submit" Name="Action" value=" * Iniciar Transferencia * ">
</form>
</body></HTML>

<%
'O path pode ser modificado, da forma que esta o arquivo vai para o diretorio que esta o Sistema
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
Set Fields = GetUpload()
FilePath = Server.MapPath(".") & "\" & Fields("arquivo").FileName
Fields("arquivo").Value.SaveAs FilePath
End If
%>

upload.inc

<script RUNAT=SERVER LANGUAGE=VBSCRIPT>
Const IncludeType = 2
Dim UploadSizeLimit
Function GetUpload()
Dim Result
Set Result = Nothing
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
Dim CT, PosB, Boundary, Length, PosE
CT = Request.ServerVariables("HTTP_Content_Type")
If LCase(Left(CT, 19)) = "multipart/form-data" Then

PosB = InStr(LCase(CT), "boundary=")
If PosB > 0 Then Boundary = Mid(CT, PosB + 9)
PosB = InStr(LCase(CT), "boundary=")
If PosB > 0 then 'Patch pour l'erreur IE
PosB = InStr(Boundary, ",")
If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)
end if
Length = CLng(Request.ServerVariables("HTTP_Content_Length"))
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
Boundary = "--" & Boundary
Dim Head, Binary
Binary = Request.BinaryRead(Length)

Set Result = SeparateFields(Binary, Boundary)
Binary = Empty
Else
Err.Raise 10, "GetUpload", "Erro null ."
End If
Else
Err.Raise 11, "GetUpload", "Erro Joint."
End If
Else
Err.Raise 1, "GetUpload", "Erro Request."
End If
Set GetUpload = Result
End Function
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)
Dim HeaderContent, FieldContent, bFieldContent
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
Dim Field, TwoCharsAfterEndBoundary
PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)
bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type
Set Field = CreateUploadField()'See the JS function bellow
Set FieldContent = CreateBinaryData(bFieldContent,LenB(bFieldContent))
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Field.Length = FieldContent.Length
Set Field.Value = FieldContent
Fields.Add FormFieldName, Field
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary Then
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary)
End If
Loop
Set SeparateFields = Fields
End Function
'Separacao de campos...
Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Name = (SeparateField(Head, "name=", ";")) 'ltrim
If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function
'Separacao de campos entre sStart et sEnd
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
'Separacao do nome
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
Function BinaryToStringSimple(Binary)
Dim I, S
For I = 1 To LenB(Binary)
S = S & Chr(AscB(MidB(Binary, I, 1)))
Next
BinaryToStringSimple = S
End Function
Function BinaryToString(Binary)
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
BinaryToString = pl1 & pl2 & pl3
End Function
Function RSBinaryToString(xBinary)
Dim Binary
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
Function MultiByteToBinary(MultiByte)
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
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
Function vbsSaveAs(FileName, ByteArray)
Dim FS, TextStream
Set FS = CreateObject("Scripting.FileSystemObject")
Set TextStream = FS.CreateTextFile(FileName)
TextStream.Write BinaryToString(ByteArray) ' BinaryToString is in upload.inc.
TextStream.Close
End Function
</SCRIPT>
<script RUNAT=SERVER LANGUAGE=JSCRIPT>
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
this.Name = null
this.ContentDisposition = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
function CreateBinaryData(Binary, mLength){ return new bin_Init(Binary, mLength) }
function bin_Init(Binary, mLength){
this.ByteArray = Binary
this.Length = mLength
this.String = BinaryToString(Binary)
this.SaveAs = jsSaveAs
}
//function jsBinaryToString(){
// return BinaryToString(this.ByteArray)
//};
function jsSaveAs(FileName){
return vbsSaveAs(FileName, this.ByteArray)
}
//Simulate ByteArray class by JS/VBS - end
</SCRIPT>

Entrar

Upload De Imagens

Pergunta

Guest - Fernando -

Link para o comentário

Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

diraol

Link para o comentário

Compartilhar em outros sites

Participe da discussão

Estatísticas dos Fóruns

Navegação

Atividades