Carregar imagens para o banco de dados SQLSERVER sem componentes

Autor：Eve Cole Data da Última Atualização：2009-06-23 16:41:26

Acabei de tentar fazer upload de componentes sem componentes, então forneço o código para compartilhar com todos.

/* addemployee.asp */
<html>
<cabeça>
<title>Página inicial da equipe</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="../css/site_css.css" type="text/css">
</head>

<body bgcolor="#FFFFFF" text="#000000" leftmargin="1" topmargin="1">
<form name="form1" method="post" action="transact1.asp" enctype="multipart/form-data">
<table border="0" cellpacing="0" cellpadding="0">
<tr>
<td colspan="2" bgcolor="#006699" height="15"> </td>
</tr>
<tr>
<td class="textBlack">
<div align="right">Título:</div>
</td>
<td>
<input type="text" name="txtTitle" size="52" class="textarea">
</td>
</tr>
<tr>
<td class="textBlack">
<div align="right">Categoria:</div>
</td>
<td>
<input type="text" name="txtSort" size="35" class="textarea">
<input type="button" name="Submit2" class="buttonSkid" onclick="selectsort(txtSort);">
</td>
</tr>
<tr>
<td class="textBlack" valign="top">
<div align="right">Texto:</div>
</td>
<td>
<textarea name="txtContent" rows="15" cols="50" class="textarea"></textarea>
</td>
</tr>
<tr>
<td height="14" class="textBlack" valign="top">
<div align="right">Imagem:</div>
</td>
<td height="14" class="textBlack">
<div alinhar="esquerda">
<input type="arquivo" nome="arquivo" size="35" class="textarea">
</div>
</td>
</tr>
<tr>
<td height="42" class="textBlack" valign="top"> </td>
<td height="42" class="textBlack" valign="middle">
<p>1. Por favor, controle o tamanho das imagens que você envia dentro de <font color="#FF0000"><b>500K</b></font>, caso contrário o upload não será permitido<br>
2. A imagem enviada deve ter <font color="#FF0000"><b>150*130 pixels</b></font><br>
3. Faça upload da imagem enviada no formato JPG ou GIF</p>
</td>
</tr>
<tr>
<td height="39" class="textBlack"> </td>
<td height="39" valign="meio">
<div align="center"><img src="../images/save.gif" width="85" height="19" onClick="if(isOK(form1)){form1.submit()}" >
<img src="../images/close.gif" width="85" height="19" onClick="self.close();"
</td>
</tr>
</tabela>
</form>
</body>
</html>
************************************************** * ***********************

/* transact1.asp*/



<%
Se Request.ServerVariables("REQUEST_METHOD") = "POST" Então
Campos escuros
Dim strTitle,strSort,strContent
Escureça rs,sql
Dim iMaxid
Dim strMaxid
Estreito escuro

Definir campos = GetUpload()
strTitle=BinaryToString(Campos("txtTítulo").valor)
strSort=BinaryToString(Campos("txtSort").valor)
strContent=BinaryToString(Fields("txtContent").valor)
strSort=split(trim(strSort),"-")

se instr(1,lcase(Fields("file").FileName),".jpg")=0 e instr(1,lcase(Fields("file").FileName),".gif")=0 então
response.write "<script language='javascript'>alert('As imagens enviadas devem estar no formato gif ou jpg')</script>"
resposta.write "<script language='javascript'>window.location='addemployee.asp';</script>"
Resposta.fim
end if

if Campos("arquivo").Comprimento>500000 então
response.write "<script language='javascript'>alert('Apenas imagens com tamanho não superior a 500k podem ser carregadas');</script>"
resposta.write "<script language='javascript'>window.location='addemployee.asp';</script>"
resposta.fim
end if

'/*Salvar no banco de dados*/
if Campos("arquivo").NomeArquivo<>""então
Definir rs=Server.CreateObject("ADODB.Recordset")
sSql="selecione * do pedido do funcionário por id desc"
rs.open sSql,conn,2,2
se não rs.eof então
iMaxid=Clng(rs("id"))+1
strlen=4-len(cstr(iMaxid))
strMaxid=string(strlen,"0") & cstr(iMaxid)
outro
strMaxid="0001"
terminar se
rs.addnew
rs("id")=strMaxid
rs("título")=strTítulo
rs("classificar")=strClassificar(0)
rs("img").AppendChunk Fields("arquivo").Valor
rs("conteúdo")=quoteChg(strConteúdo)
rs("todata")=data()
rs.atualização
rs.fechar
response.write "<script language='javascript'>alert('Adicionar registro com sucesso')</script>"
terminar se
terminar se
%>

************************************************ **********************
/*fupload.inc*/

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Dim UploadSizeLimit

'********************************** GetUpload ************ **********************
'.Nome nome do campo do formulário (<Input Name="..." Type="File,...">)
'.ContentDisposition = Disposição do conteúdo do campo do formulário
'.FileName = Nome do arquivo de origem para <input type=file>
'.ContentType = Tipo de conteúdo para <tipo de entrada = arquivo>
'.Value = Valor binário do campo de origem.
'.Length = Len do campo de dados binários
Função GetUpload()
Resultado escuro
Definir resultado = nada
Se Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'O método de solicitação deve ser "POST"
Dim CT, PosB, Limite, Comprimento, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'lê o cabeçalho Content-Type
'resposta.write CT
'aplicativo/x-www-form-urlencoded
Se LCase(Left(CT, 19)) = "multipart/form-data" Então 'O cabeçalho Content-Type deve ser "multipart/form-data"
'Este é um pedido de upload.
'Obtém o limite e o comprimento do cabeçalho Content-Type
PosB = InStr(LCase(CT), "boundary=") 'Encontra o limite
Se PosB > 0 Então Limite = Mid(CT, PosB + 9) 'Separa o limite
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Obter cabeçalho Content-Length
se "" & UploadSizeLimit<>"" então
UploadSizeLimit = clng(UploadSizeLimit)
se Comprimento > UploadSizeLimit então
'em caso de erro retome próximo 'Limpa o buffer de entrada
'response.AddHeader "Conexão", "Fechar"
'em caso de erro, vá para 0
Solicitação.BinaryRead(Comprimento)
Err.Raise 2, "GetUpload", "Tamanho do upload " & FormatNumber(Length,0) & "B excede o limite de " & FormatNumber(UploadSizeLimit,0) & "B"
função de saída
terminar se
end if

If Length > 0 And Boundary <> "" Then 'Existem informações necessárias sobre upload?
Limite = "--" & Limite
Dim Head, Binário
Binary = Request.BinaryRead(Length) 'Lê dados binários do cliente

'Recupera os campos de upload de dados binários
Definir resultado = SeparateFields (binário, limite)
Binário = Vazio 'Limpar variáveis
Outro
Err.Raise 10, "GetUpload", "Solicitação de comprimento zero."
Terminar se
Outro
Err.Raise 11, "GetUpload", "Nenhum arquivo enviado."
Terminar se
Outro
Err.Raise 1, "GetUpload", "Método de solicitação incorreto."
Terminar se
Definir GetUpload = Resultado
Função final

'********************************** SeparateFields ************ **********************
'Esta função recupera os campos de upload de dados binários e retorna os campos como array
'Binário é um array seguro de todos os dados binários brutos da entrada.
Função SeparateFields (binário, limite)
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Campos escuros
Limite = StringToBinary(Limite)

PosOpenBoundary = InstrB(Binário, Limite)
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 dados do campo de arquivo/fonte
Dim HeaderContent, FieldContent
'Campos de cabeçalho
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Variáveis de ajuda
Campo escuro, TwoCharsAfterEndBoundary
'Obtém o fim do cabeçalho
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Separa o cabeçalho do campo
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Separa o conteúdo do campo
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Separa campos de cabeçalho do cabeçalho
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Cria um campo e atribui parâmetros
Definir campo = CreateUploadField()
Campo.Nome = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Campo.Valor = FieldContent
Field.Length = LenB(FieldContent)

Fields.Add FormFieldName, Field

'Este é o limite final?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Limite), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary Then 'Este não é o limite final - vá para o próximo campo do formulário.
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Limite), Binário, Limite)
Terminar se
Laço
Definir SeparateFields = Campos
Função final

'********************************** Utilitários ********** **********************
Função BinaryToString(str)
strto = ""
para i=1 para lenb(str)
se AscB(MidB(str, i, 1)) > 127 então
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
eu = eu + 1
outro
strto = strto & Chr(AscB(MidB(str, i, 1)))
terminar se
próximo
BinaryToString=strto

Função Final

Função StringToBinary(String)
Dim I,B
Para I=1 para len(String)
B = B e ChrB(Asc(Mid(String,I,1)))
Próximo
StringToBinário = B
End Function

'Separa campos de cabeçalho do cabeçalho de upload
Função GetHeadFields (ByVal Head, Content_Disposition, Nome, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "disposição de conteúdo:", ";"))
Nome = (SeparateField(Head, "nome=", ";")) 'ltrim
Se Esquerda(Nome, 1) = """" Então Nome = Mid(Nome, 2, Len(Nome) - 2)
NomeArquivo = (SeparateField(Head, "nomedoarquivo=", ";")) 'ltrim
If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "tipo de conteúdo:", ";"))
End Function

'Separa um campo entre sStart e sEnd
Função SeparateField(From, ByVal sStart, ByVal sEnd)
Dim PosB, PosE, sFrom
sDe = LCase(De)
PosB = InStr(sFrom, sStart)
Se PosB > 0 Então
PosB = PosB + Len(sInício)
PosE = InStr(PosB, sFrom, enviar)
Se PosE = 0 Então PosE = InStr(PosB, sFrom, vbCrLf)
Se PosE = 0 Então PosE = Len(sFrom) + 1
SeparateField = Mid(De, PosB, PosE - PosB)
Outro
CampoSeparado = Vazio
Terminar se
End Function

'Separa o nome do arquivo do caminho completo do arquivo
Função GetFileName(FullPath)
Dim Pos, PosF
PosF = 0
Para Pos = Len(FullPath) Para 1 Etapa -1
Selecione Caso Médio (FullPath, Pos, 1)
Caso "/", "": PosF = Pos + 1: Pos = 0
Finalizar seleção
Próximo
Se PosF = 0 Então PosF = 1
GetFileName = Mid(FullPath, PosF)
Função final
</SCRIPT>
<SCRIPT RUNAT=LÍNGUA DO SERVIDOR=JSCRIPT>
//A função cria o objeto Field.
função CreateUploadField(){ retornar novo uf_Init() }
função uf_Init(){
este.Nome = nulo
this.ContentDisposition = nulo
this.NomeArquivo = null
this.FilePath = null
this.ContentType = nulo
este.Valor = nulo
este.Comprimento = nulo
}
</SCRIPT>