Inserir imagem binario

[khots 0]

Olá pessoal, eu tenho um banco de dados do MSDE com tipo image...

Campos imagem1,2 e 3

Tenho um formulario com 3 componentes pra envio de arquivos.

o código é o seguinte para enviar para o banco de dados:

<% idhardware = request.form("idhardware")nome = request.form("nome")descricao = request.form("descricao")preco = request.form("preco")especificacoes = request.form("especificacoes")imagem1 = request.form("imagem1")imagem2 = request.form("imagem2")imagem3 = request.form("imagem3")db_Conn = "DSN=suntec;UID=suntec;PWD=o2342m1;"set db = server.createobject("adodb.connection")set query = server.createobject("adodb.recordset")db.Open db_Conn set query = db.execute("INSERT INTO hardware (idhardware, nome, descricao, preco, especificacoes, imagem1, imagem2, imagem3) VALUES ('"& idhardware &"', '"& nome &"', '"& descricao &"', '"& preco &"', '"& especificacoes &"', '"& imagem1 &"', '"& imagem2 &"', '"& imagem3 &"')")Response.Redirect "index.asp"%>

Bom, ele insere as imagens com um códigos estranhos..

O q preciso creio eu é transformar os arquivos em binário ou n sei se é preciso pq o campo são do tipo imagem.

Gostaria de saber como eu faço pra dar o upload das imagens para o banco e vizualisar as imagens na página depois..

bom se alguém puder ajudar eu agradeço muito.

Eu pesquisei bastante sobre isso em todo o forum e por toda internet e realmente esta dificil, testei muitas coisas mas nenhuma deu certo.

Se alguém puder me ajudar feicarei muito grato.

abraçoss

[alfaleo 0]

cara, cria um componente tipo o ASPIMage, dai você converte a imagem pra binario antes de inserir !!

[Marcelo Barcellos 0]

cara, cria um componente tipo o ASPIMage, dai você converte a imagem pra binario antes de inserir !!

Não é necessário.Colega...Como eu disse no outro POST, você deve utilzar os métodos do recordset e um componente de UPLOAD.Na pior das hipóteses, vai utilizar o objeto "ADODB.Stream"

[khots 0]

Eu fiz assim :

<% idhardware = request.form("idhardware")nome = request.form("nome")descricao = request.form("descricao")preco = request.form("preco")especificacoes = request.form("especificacoes")imagem1 = request.form("imagem1")imagem2 = request.form("imagem2")imagem3 = request.form("imagem3")db_Conn = "DSN=suntec;UID=suntec;PWD=2342f4m1;"Set rs = Server.CreateObject("ADODB.Recordset")rs.Open "hardware", db_Conn, 2, 3rs.AddNewrs("idhardware").Value = idhardwarers("nome").Value = nomers("descricao").Value = descricaors("preco").Value = precors("especificacoes").Value = especificacoesrs("imagem1").Value = objFile.Binaryrs("imagem2").Value = objFile.Binaryrs("imagem3").Value = objFile.Binaryrs.UpdateResponse.Redirect "index.asp"%>

mas deu o seguinte erro :

Microsoft VBScript runtime error '800a01a8'

 

Object required: 'objFile'

 

/intranet/hardware/cad_hardware.asp, line 21

 

o q tá errado ?

flw

[Mário Monteiro 179]

onde voce criou o objeto??

[khots 0]

AquiSet objUpload = Server.CreateObject("Dundas.Upload.2")

[Mário Monteiro 179]

mas ele acusa erro no objeto 'objFile' ... onde esta esse???ou então o nome ta errado

[khots 0]

Meu código está assim:

<%idhardware = request.form("idhardware")nome = request.form("nome")descricao = request.form("descricao")preco = request.form("preco")especificacoes = request.form("especificacoes")imagem1 = request.form("imagem1")imagem2 = request.form("imagem2")imagem3 = request.form("imagem3")db_Conn = "DSN=suntec;UID=suntec;PWD=senha;"set db = server.createobject("adodb.connection")set ORs = server.createobject("adodb.recordset")ORs.Open "hardware",db_Conn,1,3,2ORs.AddnewORs("idhardware") = idhardwareORs("nome") = nomeORs("descricao") = descricaoORs("preco") = precoORs("especificacoes") = especificacoesORs("imagem1") = imagem1ORs("imagem2") = imagem2ORs("imagem3") = imagem3ORs.UpdateORs.CloseSet binario = NothingResponse.Redirect "index.asp"%>

O tipo de campo das imagens 1,2 e 3 são tipo imagem no sqlserver

preciso inserir as imagens nesses campos..

tenho 3 objetos input do tipo file em um form q envia pra esse codigo..

o q mais preciso fazer ??

vlw

abraçoss

[khots 0]

Eu tenho um form com a propriedade enctype="multipart/form-data" e um componente <input name="imagem1" type="file" id="imagem1" >... quero saber se ele envia a imagem já em binario para o scrip de cadastro em asp...se manda como eu armazeno ela ?Eu tentei armazenar fazendo assim : imagem1 = request.Form("imagem1")mas dou um : Response.Write imagem1 e não apareçe nada...Alguém pode me ajudar plz ??é meio urgente..vlw aew moçada.abraçoss

[explore 3]

Cara seu codigo ta estranho!Não vejo você criar o objeto nele!primeiro você abre o objeto e depois faz o upload e grava o caminho do arquivo no BD!

[khots 0]

Eu preciso gravar o arquivo no BD, e não o caminho

[Marcelo Barcellos 0]

Khosts...você não está sabendo fazer UPLOAD de arquivos.Aprenda o Upload (Pesquise pelo Fórum) e depois a gente te ensina a gravar no banco.

[fcorrea 0]

A questão é a seguinte.

 

você tem que ter um form com a propriedade enctype setada para multipart/form-data:

<form enctype="multipart/form-data" method="post" name="a">

 

Para pegar o valor dos campos destes nao funcipna simplesmente com request, você precisa utilizar classes do asp ou algum componente, pois estes pegar os valores e dai você cria um objeto com ele (veja no final deste a classe e cria um include com o codigo).

 

Dai você da um Set objName = GetUpload() testando antes se o form foi submetido. Depois disso você acessa os campos da seguinte forma: objName("nomeDoCampo").

 

Quando conseguir isto da uma lida no artigo do professor Marcelo: http://www.imasters.com.br/artigo.php?cn=3662&cc=2.

 

Para mostrar a imagem na tela você da um response.binaryWrite("Valor em binario do banco") que o mesmo é escrito.

 

 

 

 

 

<%

 

' Limite do tamanho do upload

Dim UploadSizeLimit

 

'****************************************** GetUpload ****************************************

' Esta função lê todos os campos de formulário da entrada binária e retorna-a como um objeto

' dicionário. O objeto dicionário contém os campos do formulário. Cada campo é representado

' pelos seguintes valores:

' .Name = Nome do campo (<Input Name="..." Type="File,...">)

' .FileName = Nome do arquvo fonte de <input type=file>

' .FilePath = Caminho completo do arquivo fonte

' .ContentType = Content-Type de <input type=file>

' .Value = Conteúdo binário do campo fonte.

' .Length = Tamanho do campo de dado binário

Function GetUpload()

Dim Result

Set Result = Nothing

 

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then ' O método de Request deve ser "POST"

Dim CT, PosB, Boundary, Length, PosE

CT = Request.ServerVariables("HTTP_Content_Type") 'Lê a propriedade Content-Type do cabeçalho

If LCase(Left(CT, 19)) = "multipart/form-data" Then 'Content-Type deve ser "multipart/form-data"

 

' Busca o limite e o tamanho da propriedade Content-Type

PosB = InStr(LCase(CT), "boundary=") 'Encontra o limitador

If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separa o limitador

 

'****** Erro do IE 5.01 - duplica o cabeçalho HTTP

PosB = InStr(LCase(CT), "boundary=")

If PosB > 0 then 'Patch para o erro do IE

PosB = InStr(Boundary, ",")

If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)

end if

'****** Erro do IE 5.01 - duplica o cabeçalho HTTP

 

Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Lê a propriedade Content-Length do cabeçalho

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 'Há algum conteúdo disponível para upload?

Boundary = "--" & Boundary

Dim Head, Binary

Binary = Request.BinaryRead(Length) 'Lê os dados binários do cliente

 

'Recupera os campos de upload dos dados binários

Set Result = SeparateFields(Binary, Boundary)

Binary = Empty

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

'****************************************** GetUpload ****************************************

 

 

 

'************************************* SeparateFields ****************************************

' Esta função recupera os campos de upload dos dados binários e retorna os campos como um array.

'Binary é safearray ( VT_UI1 | VT_ARRAY )

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)

' Cabeçalho e arquivo/fonte do campo

Dim HeaderContent, bFieldContent

' Campos de cabeçalho

Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type

' Variáveis auxiliares

Dim TwoCharsAfterEndBoundary

' Busca o fim do cabeçalho

PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

 

' Separa os campos do cabeçalho

HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

 

' Separa o conteúdo do campo

bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

 

' Recupera os campos do cabeçalho

GetHeadFields BinaryToString(HeaderContent), FormFieldName, SourceFileName, Content_Disposition, Content_Type

 

' Cria um campo e atribui parâmetros

Dim FieldContent ' Conteúdo binário dos campos

Dim Field ' Todos os valores do campo

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 ' Esta é a primeira ocorrência de um nome do campo fonte.

Set Fields(FormFieldName) = Field

else ' Segunda ocorrência de um nome de campo fonte. Este é um multiselect ou algo similar.

if isarray(dField) then ' Há um array de valores no campo do dicionário debaixo desta chave. Adicione um novo valor no array.

ReDim Preserve dField(ubound(dField)+1)

Set dField(ubound(dField) - 1) = Field

else ' Há um valor no campo do dicionário debaixo desta chave. Criar um array do antigo e novo valor.

dField = Array(dField, Field)

end if

Fields(FormFieldName) = dField

end if

 

' É o último limitador?

TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))

isLastBoundary = TwoCharsAfterEndBoundary = "--"

 

If Not isLastBoundary Then ' Este não é o último limitador - vai para o próximo campo.

PosOpenBoundary = PosCloseBoundary

PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary)

End If

Loop

Set SeparateFields = Fields

End Function

'************************************* SeparateFields ****************************************

 

 

 

'*********************************** Utilitários Upload **************************************

' Separa os campos de cabeçalho do cabeçalho upload

Function GetHeadFields(ByVal Head, Name, FileName, Content_Disposition, Content_Type)

' Busca o nome do campo. Nome é separado por name= e ;

Name = (SeparateField(Head, "name=", ";"))

' Remove aspas (se o nome do campo está entre aspas)

If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)

 

' O mesmo para a propriedade filename

FileName = (SeparateField(Head, "filename=", ";"))

If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)

 

' Separa os campos de cabeçalho content-disposition e content-type

Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))

Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))

End Function

 

' Separa um campo entre sStart e 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

 

' Separa o nome do arquivo do caminho completo do arquivo

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

'******************************** Utilitários Upload ****************************************

 

 

 

'***************************** Funções de conversão de String *******************************

Function BinaryToString(Binary)

' Seleciona o melhor algoritmo para converter dado binário para String

Dim TempString

 

On Error Resume Next

TempString = RSBinaryToString(Binary)

If Len(TempString) <> LenB(Binary) then 'Erro na converção

' Deve ser usado a versão multibyte do BinaryToString

TempString = MBBinaryToString(Binary)

end if

BinaryToString = TempString

End Function

 

Function MBBinaryToString(Binary)

' Versão MultiByte da função BinaryToString

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

 

 

Function RSBinaryToString(xBinary)

' Esta função converte dado binário (VT_UI1 | VT_ARRAY or String MultiByte)

' para string (BSTR) usando ADO recordset.

' Use esta função ao invés de MBBinaryToString se você tem ADODB.Recordset instalado

' a fim de eliminar problemas de performance.

 

Dim Binary

' Dado MultiByte deve ser convertido para VT_UI1 | VT_ARRAY primeiro.

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)

' Esta função converte multibyte string para dado binário real (VT_UI1 | VT_ARRAY)

' usando 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

 

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 BinaryToStringSimple(Binary)

' Idéia de conversão Multibyte. Não utilizado.

Dim I, S

For I = 1 To LenB(Binary)

S = S & Chr(AscB(MidB(Binary, I, 1)))

Next

BinaryToStringSimple = S

End Function

'**************************** String conversion fuctions ************************************

 

 

 

' Esta função simula a gravação de dado binário usando conversão para uma string e filesystemobject

Function SaveBinaryData(FileName, ByteArray)

Dim FS : Set FS = CreateObject("Scripting.FileSystemObject")

Dim TextStream : Set TextStream = FS.CreateTextFile(FileName)

TextStream.Write BinaryToString(ByteArray)

TextStream.Close

End Function

 

 

 

'*************************************** ByteArray class *************************************

Class clByteArray

'bytearray armazenado

public ByteArray

 

Public Default Property Get ba

ba = ByteArray

End Property

 

public Property Get Length

Length = LenB(ByteArray)

End Property

 

public Property Get String

String = BinaryToString(ByteArray)

End Property

 

' Armazena o dado binário em um arquivo.

Public Function SaveAs(FileName)

SaveBinaryData FileName, ByteArray

End Function

End Class

 

Class clField

Public Name, ContentDisposition, FileName, FilePath, ContentType, Value, Length

Public Default Property Get n

n = Name

End Property

End Class

'************************************** ByteArray class **************************************

 

 

 

'*************************************** SaveUpload ******************************************

' Esta função salva no disco os arquivos especificados no formulário

Function SaveUpload(Fields, DestinationFolder)

If DestinationFolder = "" Then DestinationFolder = getPath("")

 

Dim FS

Dim OutFolder

Dim Field

Dim OutLine

 

Set FS = CreateObject("scripting.filesystemobject")

Set OutFolder = FS.GetFolder(DestinationFolder)

 

Dim SaveFileName

 

for each Field in Fields.Items

SaveFileName = empty

 

if IsObject(Field) then

if Field.FileName <> "" then 'Este campo é arquivo de upload

SaveFileName = Field.FileName

end if

end if

 

if not IsEmpty(SaveFileName) then

Field.Value.SaveAs OutFolder & "\" & SaveFileName 'Salva o conteúdo do campo no disco

end if

next

 

'Cria uma linha de mensagem para o cliente

OutLine = OutLine & "Os campos foram gravados na pasta <b>" & OutFolder & "</b>.<br>"

 

OutFolder = Empty 'Clear variables.

SaveUpload = OutLine

End Function

'*************************************** SaveUpload ******************************************

 

 

 

' Retorna o campo ou "-" se o campo for vazio

Function LogF(ByVal F)

If "" & F = "" Then F = "-" Else F = "" & F

F = replace(F, vbCrLf, "%13%10")

F = replace(F, ",", "%2C")

LogF = F

End Function

 

' Retorna o campo ou "-" seo campo for vazio

Function LogFn(ByVal F)

If "" & F = "" Then LogFn = "-" Else LogFn = formatnumber(F, 0)

End Function

 

%>

 

 

Depois de entender como funciona este tipo de form, da uma olhada no link abaixo que tem a forma de passar o arquivo imagem para binario.

 

http://forum.imasters.com.br/index.php?showtopic=145100&hl=